XProfan

Source wurde am 15.07.2007 aus der MMJ-Quellcodesammlung (Dietmar Horn) in die Babyklappe auf XProfan.Com abgelegt:
Bitmap neben dem Trackmenü anzeigen
Lauffähig ab Profan-Version 5.0
Ein TrackMenu mit Bild auf der linken Seite anzeigen
(c) Rolf Koch - Rokosoft - Koblenz 2003
über einen Vermerk in der Hilfe oder Aboutbox würde ich mich freuen ;)
Hinweis: Es muss ein Bitmap erstellt werden und dann die Y Position angepasst werden!
Achtung: Funktioniert nur, wenn Standartfonts des Systems genutzt werden!!!
Ragt Menü über %Maxx wird Bild verborgen.
Ragt Menü über %Maxy wird Bild angepasst.
SetErrorLevel 0 Wichtig, wegen negativer Fenstergröße
DEF LoadImage(6) ! USER32,LoadImageA
Def SysColor(1) !USER32,GetSysColor
def @GetCursorPos(1) !USER32,GetCursorPos
declare MENUPIC&,pos#,anzeige&

PROC CHILDMENU

    Parameters mausx%,mausy%,breitobj&,hochobj&,fenster&,bild$,count%
    declare b#,h&,menubild&,menustatic&,winsich&
    winsich&=GetStyle(%hwnd) auskommentieren falls ältere Profanversion
    WINDOWSTYLE 80
    let Menubild&=CreateWindow(fenster&,,mausx%,mausy%,breitobj&,hochobj&)
    Dim b#,Add(Len(bild$),1)
    String b#,0=bild$
    Let h&=LoadImage(%hinstance,b#,0,breitobj&,hochobj&,$50)
    Let MENUSTATIC&=@Control(STATIC,,$05000010E,0,0,breitobj&,hochobj&,Menubild&,$7918,%hinstance)
    SendMessage(Menustatic&,$172,0,h&)

    if lt(add(mausy%,hochobj&),%maxy)

        SetWindowPos Menubild&=mausx%,mausy%-breitobj&,hochobj&;-1

    Else

        SetWindowPos Menubild&=mausx%,sub(mausy%,mul(count%,18))-breitobj&,hochobj&;-1

    endif

    dispose b#
    Return Menubild&
    WindowStyle winsich& auskommentieren falls ältere Profanversion

ENDPROC

PROC POPMENU

    CreateMenu
    AppendMenu 100,Eintrag 1
    AppendMenu 101,Eintrag 2
    AppendMenu 102,Eintrag 3
    AppendMenu 103,Eintrag 4
    AppendMenu 104,Eintrag 5
    AppendMenu 105,Eintrag 6
    dim Pos#,8
    @GetCursorPos(Pos#)
    CHILDMENU sub(long(Pos#,0),20),long(Pos#,4),20,107,%hwnd,add$(getdir$(@),Menu1.bmp),6
    Dispose Pos#
    Parameter: X,Y,Breite Bild,Höhe Bild (lieber Bild etwas größer anlegen!),Handle,Bild,Anzahl-Einträge
    let Menupic&=@&(0)
    TrackMenu %mousex,%mousey
    destroywindow(Menupic&)

ENDPROC

WINDOWSTYLE 63
Settruecolor 1
WindowTitle Menü mit Leftbitmap (c) by Rolf Koch 2003
Cls SysColor(15)
SetDialogFont 1
UseFont MS Sans Serif,13,0,0,0,0
Let Anzeige&=CreateText(%hwnd,Rechte Maustaste bitte...,10,10,150,20)

while 1

    WaitInput

    If equ(%mousekey,2)

        POPMENU
        case equ(%menuitem,100):SetText anzeige&,Eintrag 1
        case equ(%menuitem,101):SetText anzeige&,Eintrag 2
        case equ(%menuitem,102):SetText anzeige&,Eintrag 3
        case equ(%menuitem,103):SetText anzeige&,Eintrag 4
        case equ(%menuitem,104):SetText anzeige&,Eintrag 5
        case equ(%menuitem,105):SetText anzeige&,Eintrag 6

    endif

Wend