Code: Select all
#include "windows.bi"
#Ifdef __Fb_64bit__
#Inclib "gdiplus"
#Include Once "win\gdiplus-c.bi"
#Else
#Include Once "win\gdiplus.bi"
Using Gdiplus
#Endif
Dim Shared gdipToken As ULONG_PTR
Dim Shared GDIp As GdiplusStartupInput
Function _GDIPlus_Startup() As Bool
GDIp.GdiplusVersion = 1
If GdiplusStartup(@gdipToken, @GDIp, NULL) <> 0 Then
'Error 1
Return False
Endif
Return True
End Function
Sub _GDIPlus_Shutdown()
GdiplusShutdown(gdipToken)
End Sub
Function _GDIPlus_BitmapCreateFromMemory3(aBinImage As Ubyte Ptr, iLen As Ulong, bBitmap_GDI As Bool = False, iCol_GDI As Ulong = &hFF000000) As Any Ptr
Dim As LPSTREAM hStream
Dim As Any Ptr hImage_Stream, hMemory = GlobalAlloc(GMEM_MOVEABLE, iLen), lpMemory = GlobalLock(hMemory)
RtlCopyMemory(lpMemory, @aBinImage[0], iLen)
GlobalUnlock(hMemory)
CreateStreamOnHGlobal(hMemory, 0, @hStream)
GdipCreateBitmapFromStream(hStream, @hImage_Stream)
IUnknown_Release(hStream)
If bBitmap_GDI = True Then
Dim hImage_GDI As HBITMAP
GdipCreateHBITMAPFromBitmap(hImage_Stream, @hImage_GDI, iCol_GDI)
GdipDisposeImage(hImage_Stream)
Return hImage_GDI
Endif
Return hImage_Stream
End Function
Function Base64Decode(sString As String, Byref iBase64Len As Uinteger) As Ubyte Ptr
#Define P0(p) InStr(B64, Chr(sString[n + p])) - 1
Dim As String*64 B64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim As String sDecoded
Dim As Long nChars = Len(sString) - 1
If nChars < 0 Then Return 0
For n As Long = 0 To nChars Step 4
Var b = P0(1), c = P0(2), d = P0(3)
If b >-1 Then
Var a = P0(0)
sDecoded += Chr((a Shl 2 + b Shr 4))
End If
If c > -1 Then sDecoded += Chr((b Shl 4 + c Shr 2))
If d > -1 Then sDecoded += Chr((c Shl 6 + d ))
Next
iBase64Len = Len(sDecoded)
'workaround for multiple embedded file other crash will occure
Static As Ubyte aReturn(0 To iBase64Len - 1)
Redim aReturn(0 To iBase64Len - 1) As Ubyte
For i As ULong = 0 to Len(sDecoded) - 1 'convert result string to ascii code values
aReturn(i) = Asc(sDecoded, i + 1)
Next
Return @aReturn(0) 'return pointer to the array
End Function
Function DecompressImage(sLabel As String, iDecoder As Ubyte = 0, bGDI As BOOL = False) As Any Ptr
Dim As Ulong iLines, bCompressed, iFileSize, iCompressedSize
Dim As String sBaseType, sBase, aB(1)
Select Case sLabel
Case "Label0"
Restore __Label0:
End Select
Read iLines
Read bCompressed
Read iFileSize
Read iCompressedSize
Read sBaseType
For i As Ushort = 0 To iLines - 1
Read aB(0)
sBase &= aB(0)
Next
Dim As Uinteger iLen
Static As Ubyte Ptr aBinary
Select Case iDecoder
Case 0
aBinary = Base64Decode(sBase, iLen)
End Select
Dim As Any Ptr hBitmap = _GDIPlus_BitmapCreateFromMemory3(aBinary, iLen, bGDI)
aBinary = 0
sBase = ""
Return hBitmap
End Function
Const id_Exit = 5200
Dim As HANDLE hConsole = GetConsoleWindow(), hSysMenu
_GDIPlus_Startup()
Dim As HBITMAP hBitmap = DecompressImage("Label0", 0, True) 'GDI bitmap
? "hBitmap = " & hBitmap
hSysMenu = GetSystemMenu(hConsole, False)
? "hSysMenu = " & hSysMenu
AppendMenuW(hSysMenu, MF_STRING Or MF_BYCOMMAND, id_Exit, "&Exit")
? "SetMenuItemBitmaps = " & SetMenuItemBitmaps(hSysMenu, id_Exit, MF_BITMAP Or MF_BYCOMMAND, hBitmap, hBitmap) 'replace hBitmap with 8 to see default x icon
? "Error: " & GetLastError()
Dim As MENUITEMINFO tMenuItem
With tMenuItem
.cbsize = Sizeof(tMenuItem)
.fMask = MIIM_BITMAP
.hbmpItem = hBitmap 'set .hbmpItem = 8 to display default x icon
End With
'? "SetMenuItemInfo = " & SetMenuItemInfo(hSysMenu, id_Exit, False, @tMenuItem)
'? "Error: " & GetLastError()
Sleep
DeleteMenu(hSysMenu, id_Exit, MF_BYCOMMAND)
DeleteObject(hBitmap)
_GDIPlus_Shutdown()
'Code below was generated by: FB File2Bas Code Generator v1.05 build 2020-09-23 beta
'Users-Exit-icon.png
__Label0:
Data 1,0,230,0,"Base64"
Data "iVBORw0KGgoAAAANSUhEUgAAABAAAAAQCAYAAAAf8/9hAAAArUlEQVR42mNkQIB2IC4CYjYG/OAXEPcBcSWIwwgVlAHiR0CcDsS3CBigBsQzgVgOiJ/ADFAH4htALAHELwkYIA7EL4BYA4hvkmIAExD/I9cABSA+CMS+QHwJiOuAeCUpBsDkPwFxKBDvgkngMiAYiLuR5FmBWBrK/g3EWUA8B58B5UDcgScg/zNAor2GZgZQ7AWKAxEdyAPxIUqiEQQoSkjIAKsBFGcmBgYyszMAGXhKE/Kk0b4AAAAASUVORK5CYII="