XProfan

Windowstyle 31
Windowtitle "Menüs mit Grafiken"
Window 0,0-640,440
Declare PIC#,PIC$,PicHandle&,Menuhandle&,Dimen#
DEF @LoadPic(6) !"user32","LoadImageA"
DEF @SetMenuItemBitmaps(5) !"USER32","SetMenuItemBitmaps"
DEF @DeleteObject(1) !"GDI32","DeleteObject"
DEF @GetMenu(1) !"USER32","GetMenu"
DEF @GetSystemMetrics(1) !"USER32","GetSystemMetrics"
DEF @GetMenuCheckMarkDimensions(0) !"USER32","GetMenuCheckMarkDimensions"
popup "Datei"
appendmenu 1,"Neuer Eintrag"
appendmenu 2,"Eintrag löschen"
appendmenu 4,"Eigenschaften"
popup "Hilfe"
appendmenu 13,"Kontexthilfe"
appendmenu 14,"Hilfedatei"
appendmenu 15,"Info über..."
dim Pic#,50
DIM DIMEN#,4

IF @right$(@getdir$("@"),1)<>""

    let Pic$=@add$(@getdir$("@"),"Logo2.bmp")

else

    let Pic$=@add$(@getdir$("@"),"Logo2.bmp")

endif

string Pic#,0=Pic$
Long Dimen#,0=@GetMenuCheckMarkDimensions()
PRINT @Word(Dimen#,0),@Word(Dimen#,2)
Print @GetSystemMetrics(71),@GetSystemMetrics(72)
let PicHandle&=@LoadPic(0,Pic#,0,@Word(Dimen#,0),@Word(Dimen#,2),$10)
LET Menuhandle&=@GetMenu(%HWND)
@SetMenuItemBitmaps(Menuhandle&,1,0,Pichandle&,Pichandle&)
Waitinput
Dispose pic#
Dispose Dimen#
@DeleteObject(PicHandle&)
END

 {$crq}
DEF LoadPic(6) !"user32","LoadImageA"
DEF SetMenuItemBitmaps(5) !"USER32","SetMenuItemBitmaps"
DEF GetMenu(1) !"USER32","GetMenu"
DEF GetSystemMetrics(1) !"USER32","GetSystemMetrics"

proc setmenupicture

    parameters h&,pic$
    SetMenuItemBitmaps(GetMenu(%HWND),h&,0,LoadPic(0,addr(pic$),0,GetSystemMetrics(71),GetSystemMetrics(72),$10),0)

endproc

cls
popup "&Programm"
appendmenu 1000,"&Beenden	Alt+F4"
popup "&Optionen"
appendmenu 1001,"&Einstellungen	Strg+E"
popup "&?"
appendmenu 1002,"&About"
setmenupicture 1000,"1.bmp"
setmenupicture 1001,"2.bmp"
setmenupicture 1002,"3.bmp"
usermessages 16

whilenot %umessage==16

    getmessage

wend

end