Posted: Sun Sep 04, 2005 7:49 pm
Office style menus are ugly anyways. 
Here it is again, updated for v4.30:Code: Select all
; --> get default menu check-mark bitmap size
Global menuImageWidth = GetSystemMetrics_(#SM_CXMENUCHECK)
Global menuImageHeight = GetSystemMetrics_(#SM_CYMENUCHECK)
Procedure menuImage(subMenu, iID, ico)
; --> Extract an icon
ExtractIconEx_("shell32.dll", ico, 0, @smIcons, 1)
; --> Draw the icon onto a 16 x 16 blank image
im=CreateImage(#PB_Any, 16, 16)
himg = StartDrawing(ImageOutput(im))
; --> White background to match menu background
Box(0, 0, 16, 16, RGB(255, 255, 255))
; --> Draw the icon
DrawImage(smIcons, 0, 0, 16, 16)
StopDrawing()
; --> Resize to fit the menu
itemImage = ResizeImage(im, menuImageWidth, menuImageHeight)
; --> Add the image to myMENUITEMINFO structure
SetMenuItemBitmaps_(subMenu,iID,#MF_BYPOSITION,itemImage,0)
; --> Clean up
DestroyIcon_(smIcons)
EndProcedure
If OpenWindow(0, 200, 200, 400, 110, "Set Menu Item Images", #PB_Window_SystemMenu)
hMenu = CreateMenu(0, WindowID(0))
MenuTitle("Title 1")
MenuItem(0, "Testing 1")
MenuItem(1, "Testing 2")
OpenSubMenu("Submenu")
MenuItem(2, "Testing 3")
MenuTitle("Title 2")
MenuItem(3, "Testing 4")
MenuItem(4, "Testing 5")
MenuItem(5, "Testing 6")
hsMenu0 = GetSubMenu_(hMenu, 0)
menuImage(hsMenu0, 0, 4)
menuImage(hsMenu0, 1, 130)
menuImage(hsMenu0, 2, 194)
hsMenu1=GetSubMenu_(hsMenu0,2)
menuImage(hsMenu1,0,4)
hsMenu2 = GetSubMenu_(hMenu, 1)
menuImage(hsMenu2, 0, 43)
menuImage(hsMenu2, 1, 10)
menuImage(hsMenu2, 2, 90)
Repeat
event = WaitWindowEvent()
Until event = #PB_Event_CloseWindow
EndIf