How to set icon

Windows specific questions.
Post Reply
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

How to set icon

Post by UEZ »

Any idea how to set the icon for the menu entry "Exit" from the console system menu?

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="
Compile the code as -s console and click to the icon on the left upper corner to see the menu entry Exit.
Last edited by UEZ on May 23, 2021 10:57, edited 1 time in total.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: How to set icon

Post by jj2007 »

Something like this:

Code: Select all

AppendMenuW(hSysMenu, MF_STRING Or MF_BYCOMMAND, id_Exit, "&Exit")
SetMenuItemBitmaps(hSysMenu, id_Exit, MF_BYCOMMAND, LoadImage(...), LoadImage(...))
I doubt, though, that you can change the icon of the console window.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: How to set icon

Post by UEZ »

jj2007 wrote:Something like this:

Code: Select all

AppendMenuW(hSysMenu, MF_STRING Or MF_BYCOMMAND, id_Exit, "&Exit")
SetMenuItemBitmaps(hSysMenu, id_Exit, MF_BYCOMMAND, LoadImage(...), LoadImage(...))
I doubt, though, that you can change the icon of the console window.
I tried it also with SetMenuItemBitmaps but same result -> no icon.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: How to set icon

Post by jj2007 »

Console windows are very special, you don't have the same access rights as for your own windows. Which error messages do you get? GetLastError() reports what, "access denied"?
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: How to set icon

Post by UEZ »

jj2007 wrote:Which error messages do you get?
For which function call?

For SetMenuItemBitmaps and SetMenuItemInfo GetLastError is 0. For both the return value is 1.
jj2007
Posts: 2326
Joined: Oct 23, 2016 15:28
Location: Roma, Italia
Contact:

Re: How to set icon

Post by jj2007 »

UEZ wrote:For SetMenuItemBitmaps and SetMenuItemInfo GetLastError is 0. For both the return value is 1.
I meant SetMenuItemBitmaps (SetMenuItemInfo is not needed). So no error - interesting, but it confirms my suspicion that the console window doesn't let you do what you want.
UEZ
Posts: 972
Joined: May 05, 2017 19:59
Location: Germany

Re: How to set icon

Post by UEZ »

jj2007 wrote:
UEZ wrote:For SetMenuItemBitmaps and SetMenuItemInfo GetLastError is 0. For both the return value is 1.
I meant SetMenuItemBitmaps (SetMenuItemInfo is not needed). So no error - interesting, but it confirms my suspicion that the console window doesn't let you do what you want.
The odd thing is that I can remove / add menu entries but I cannot set an icon of my choice.
Post Reply