XProfan

 $H WINDOWS.PH
 $H MESSAGES.PH
Struct lpdis = CtlType&, CtlID&, itemID&, itemAction&, itemState&, hwndItem&, hDC&, Rect#(16), itemData#(4)
Struct lpmis = CtlType&, CtlID&, itemID&, itemWidth&, itemHeight&, itemData&
Struct  point = X&,Y&
Struct  rect  = Left&,Top&,Right&,Bottom&
Struct  MENUINFO = cbSize&,fMask&,dwStyle&,cyMax&,hbrBack&,dwContextHelpID&,dwMenuData&
Declare lpmis#
Dim lpmis#,lpmis
Declare lpdis#
Dim lpdis#,lpdis
Declare IsTrack&
Var Indent& = 20
Var PopFlag& = 0
Var ID& = 0
Var PopID& = 0
Var S_TrackBkColor& = $FDFDE1
Var S_MenuBkColor& = $ADFDE1
Var TrackBkColor& = $FBFABC
Var MenuBkColor& = $1BFABC
Var S_BkColor& = 0
Var BkColor& = 0
################################
Var Ende& = 0
cls
Fenstermenu()
Var Edit& = Create(ChoiceBox,%hwnd,3,10,10,120,24)
SubClass Edit&,1     Für die Anzeige des neuen Kontext-Menüs
SubClass %hWnd,1     Für die Menübotschaften
Decimals 0

Whilenot Ende&

    Waitinput

    If MenuItem(1001)

        Popflag& = 1
        PopMenu()
        Popflag& = 0

        select %Menuitem

            CaseOf 100,101,102,103

            SetText Edit&,Eintrag +str$(%menuitem-99)

        Endselect

    Elseif Menuitem(203)

        Ende& = 1

    Endif

EndWhile

Dispose lpdis#
Dispose lpmis#
End
################################

SubClassProc

    If SubClassMessage(Edit&, ~WM_CONTEXTMENU)

        SetMenuItem 1001
        Set(WinProc, 0)

    ElseIf SubClassMessage(%hwnd, ~WM_DRAWITEM)

        DrawProc(&slparam)
        Set(WinProc, 0)

    ElseIf SubClassMessage(%hwnd, ~WM_MEASUREITEM)

        MeasureProc(&slparam)
        Set(WinProc, 0)

    ElseIf SubClassMessage(%hwnd, ~WM_ENTERIDLE)

        Hier wird das Problem von 2 verwschiedenen Ownerdrawmenüs behandelt
        Hat das Fenster nämlich auch ein Menü, haut das nicht mehr hin !
        Also muss das erste Menü erst wieder verschwinden !

        If &sWparam = ~MSGF_MENU

            If popflag&

                Declare p#
                Dim p#,point
                ~GetCursorPos(p#)
                id& = ~WindowFromPoint(p#.X&,p#.Y&)

                If id&=%hwnd

                    popflag&=0
                    popid&=&slParam
                    ~DestroyWindow(popid&)

                EndIf

            EndIf

            Set(WinProc, 0)

        Endif

    ElseIf SubClassMessage(%hwnd, ~WM_INITMENU)

        If ~GetMenu(%hwnd) = &hMenu

            BKColor& = MenuBkColor&
            S_BKColor& = S_MenuBkColor&

        Else

            BKColor& = TrackBkColor&
            S_BKColor& = S_TrackBkColor&

        Endif

        Set(WinProc, 0)

    Elseif SubClassMessage(%hwnd,~WM_EXITMENULOOP)

        Set(WinProc, 0)

    EndIf

EndProc

Proc Fenstermenu

    PopUp &Datei
    AppendMenu 200,Laden
    AppendMenu 201,Speichern
    AppendMenu 202,Speichern als
    AppendMenu 203,Ende
    ~ModifyMenu(&hMenu,200,~MF_BYCOMMAND | ~MF_OWNERDRAW,200,0)
    ~ModifyMenu(&hMenu,201,~MF_BYCOMMAND | ~MF_OWNERDRAW,201,0)
    ~ModifyMenu(&hMenu,202,~MF_BYCOMMAND | ~MF_OWNERDRAW,202,0)
    ~ModifyMenu(&hMenu,203,~MF_BYCOMMAND | ~MF_OWNERDRAW,203,0)
    ~ModifyMenu(&hMenu,1040,~MF_BYCOMMAND | ~MF_OWNERDRAW,1040,0)
    Declare m#
    Dim m#,MENUINFO
    M#.cbSize&=SizeOf(m#)
    M#.hbrBack&=~CreateSolidBrush(365255)
    M#.fMask&=~MIM_BACKGROUND | ~MIM_STYLE
    M#.dwStyle&=~MNS_AUTODISMISS | ~MNS_MODELESS
    ~SetMenuInfo(&hMenu,M#)
    ~DrawMenubar(%hwnd)
    Dispose m#

EndProc

Proc GetMenuIDName

    Parameters Menu&,ItemID&
    Declare mii#,dwTypeData#,ItemName$
    Dim dwTypeData#,1024
    Dim mii#,44
    Long mii#,0 = 44
    Long mii#,4 = ~MIIM_STRING
    Long mii#,36 = dwTypeData#
    Long mii#,40 = 1024

    If ~GetMenuItemInfo(Menu&,itemID&,0,mii#)

        ItemName$ = Trim$(String$(dwTypeData#,0))

    EndIf

    Dispose mii#
    Dispose dwTypeData#
    Return ItemName$

EndProc

Proc MeasureProc

    Parameters par&
    Declare Point#,Itemtext$
    Dim Point#,point
    lpmis# = Par&
    Itemtext$ = GetMenuIDName(&hMenu,lpmis#.itemid&)
    ~GetTextExtentPoint32(%hdc,Addr(Itemtext$),Len(Itemtext$),Point#)
    lpmis#.itemwidth&  = Point#.X&+indent&
    lpmis#.itemheight& = Point#.Y&
    Dispose Point#

EndProc

Proc DrawProc

    Parameters Par&
    Declare Itemtext$
    Declare Rect#
    Dim Rect#,rect
    lpdis# = Par&
    Long Rect#,0= Long(lpdis#,28),Long(lpdis#,32),Long(lpdis#,36),Long(lpdis#,40)
    Itemtext$ = GetMenuIDName(&hMenu,lpdis#.itemid&)

    If lpdis#.itemstate& & ~ODS_SELECTED

        ~SetBkColor(lpdis#.hdc&,S_BKColor&)
        ~SetTextColor(lpdis#.hdc&,$000000)

    Else

        ~SetBkColor(lpdis#.hdc&,BKColor&)
        ~SetTextColor(lpdis#.hdc&,$000000)

    EndIf

    Var Brush& = ~CreatesolidBrush(rgb(255,0,0))
    ~Fillrect(lpdis#.hdc&,rect#,Brush&)
    Long Rect#,0= Long(lpdis#,28)+indent&,Long(lpdis#,32),Long(lpdis#,36),Long(lpdis#,40)
    ~ExtTextOut(lpdis#.hdc&,rect#.left&,Rect#.top&,~ETO_OPAQUE,Rect#,Addr(Itemtext$) ,len(itemtext$),0)
    Dispose Rect#
    ~DeleteObject(Brush&)

EndProc

Proc CreatePopup

    CreateMenu
    AppendMenu 100,Eintrag 1
    AppendMenu 101,Eintrag 2
    AppendMenu 102,Eintrag 3
    AppendMenu 103,Eintrag 4
    menupunkte auf ownwerdraw setzen
    ~ModifyMenu(&hMenu,100,~MF_BYCOMMAND | ~MF_OWNERDRAW,100,0)
    ~ModifyMenu(&hMenu,101,~MF_BYCOMMAND | ~MF_OWNERDRAW,101,0)
    ~ModifyMenu(&hMenu,102,~MF_BYCOMMAND | ~MF_OWNERDRAW,102,0)
    ~ModifyMenu(&hMenu,103,~MF_BYCOMMAND | ~MF_OWNERDRAW,103,0)
    Return GetMenuHeight(&hMenu)

EndProc

Proc PopMenu

    Declare X&,Y&
    CreatePopup()
    Declare Rect#
    Dim Rect#,Rect
    ~GetWindowRect(Edit&,Rect#)
    ~SetCursorpos(rect#.left&+width(Edit&)+16,rect#.top&+8)
    ~MapWindowPoints(0,Edit&,Rect#,2)
    Trackmenu Rect#.Right&+

 $H windows.ph
 $H messages.ph
Struct CI = cbSize&,rcItem#(16),rcButton#(16),stateButton&,hwndCombo&,hwndItem&,hwndList&
Def &False 0
Def &True 1
Declare hWin&, hCombo&, Quit&
CLS
hCombo& = @Create(ChoiceBox, %hwnd, 3, 10, 10, 280, 150)

WhileLoop 1, 10, 1

    AddChoice(hCombo&, Test  + @Str$(&Loop))

EndWhile

Quit& = &False
Declare ci#
Dim ci#,CI
ci#.cbSize& = SizeOf(ci#)
~GetComboBoxInfo(hCombo&,ci#)
Var edit& = ci#.hwndItem&
Set(SubClassMode, 1)
SubClass Edit&,1
SubClass %hwnd,1

Repeat

    WaitInput

    If %Key = 2

        Quit& = &True

    EndIf

Until Quit& = &True

End

Proc PopMenu

    CreateMenu
    AppendMenu 100,Eintrag 1
    AppendMenu 101,Eintrag 2
    AppendMenu 102,Eintrag 3
    AppendMenu 103,Eintrag 4
    Return TrackMenu()

ENDPROC

SubClassProc

    If SubClassMessage(Edit&, ~WM_CONTEXTMENU)

        select PopMenu()

            CaseOf 100

            SetText Edit&,Eintrag 1

            CaseOf 101

            SetText Edit&,Eintrag 2

            CaseOf 102

            SetText Edit&,Eintrag 3

            CaseOf 103

            SetText Edit&,Eintrag 4

        Endselect

        Set(WinProc, 0)

    ElseIf SubClassMessage(%hWnd, ~WM_DRAWITEM)

        Print Draw
        Set(WinProc, 0)

    ElseIf SubClassMessage(%hWnd, ~WM_MEASUREITEM)

        Print Measure
        Set(WinProc, 0)

    EndProc