XProfan

 $H windows.ph
 $H messages.ph
 $I XFrameDll.Inc
Struct TBBUTTON = iBitmap&,idCommand&,fsState#(1),fsStyle#(1),bReserved#(2),dwData&,iString&
Struct Rect = left&,top&,right&,bottom&
Declare Ende&,Dll&
Declare TB_Buttonstrings$,TB&,TBS&
Declare Rebar&,RebarBandInfo#
Dll& = UseDll("XFrame.dll")
Windowstyle 20
windowtitle "OwnerDraw-Frame"
cls $FFFFD7
Usermessages ~wm_close
UseIcon "Eis"
Ende& = 0
#################
DLL vorbereiten
#################
SetButtonIndent(2)
SetTextIndent(4)
SetProgIcon(0)
SetOnTop(%hwnd,1)
SetButtons(0,0)
AdjustWindow(80,12,18,$FFFF)
SetOnlycaption(0)
SetAddImage(0)
Var T$ = "durchsichtiges Menü mit Rebarcontrol"
SetAddText(Addr(T$),Create("FONT","ARIAL",24,0,1,0,0),$FFFF,~DT_RIGHT)
SetButtonImages(Create("hPic",-1,GetDir$("@")+"\Pics\Allbuttons6.bmp"))
SetBackGroundImage(Create("hPic",-1,GetDir$("@")+"\Pics\BackGround3.bmp"))
SetLogoImage(Create("hPic",-1,GetDir$("@")+"\Pics\xprofande.bmp"),~DT_LEFT)
#################
#################
Dll initialisieren
#################
Init(%hwnd)
UpdateFrame(%hwnd)
#################
Menu aus Toolbar
#################
TB_ButtonStrings$ = "DateizBerarbeitenzHilfezz"
TB& = Create("Toolbar",%hwnd,-1,-1,-1,-1,1)
Var MenuFont& = Create("FONT","Arial",18,0,0,0,0)
SendMessage(TB&,~WM_SETFONT,MenuFont&,1)
SendMessage(tb&,$400+28,0,Addr(TB_ButtonStrings$))
tbs& = SendMessage(tb&,$400+57,0,0)Style holen
tbs& = tbs& | $1000 | $800 | $100 | $10  Style ändern
SendMessage(TB&,($400+56),0,tbs&)Style setzen
SendMessage(TB&,($400+32),0,Makelong(0,0))Icon-Grösse = 0,0
Buttonstil setzen, kein Icon,Stil
Declare TBB#
Dim TBB#,TBBUTTON
TBB#.iBitmap& = -1
Byte TBB#,8 = 4 , $800 | $40 | $10
Button 1 , CommandID , Text-Index
TBB#.idCommand& = -3000
TBB#.iString& = 0
SendMessage(tb&,($400+21),-1,TBB#)
Button 2 , CommandID , Text-Index
TBB#.idCommand& = -3001
TBB#.iString& = 1
SendMessage(tb&,($400+21),-1,TBB#)
Button 3 , CommandID , Text-Index
TBB#.idCommand& = -3002
TBB#.iString& = 2
SendMessage(tb&,($400+21),-1,TBB#)
Dispose TBB#
#################
########################
ReBar-Control anlegen
########################
ReBar& = Control("ReBarWindow32","",$50000040,0,0,0,0,%Hwnd,2000,%hinstance)
Set("Errorlevel",-1)
External("UxTheme.dll","SetWindowTheme",ReBar&,0)
Set("Errorlevel",0)
Dim RebarBandInfo#,80
Long RebarBandInfo#,0=80       UINT        cbSize
Long RebarBandInfo#,4=$000008B3UINT        fMask;
Long RebarBandInfo#,8=$00000100UINT        fStyle;
Long RebarBandInfo#,32=TB&     HWND        hwndChild;
Var rr# = New(Rect)
Sendmessage(TB&,$041D,1,rr#)Buttonhöhe holen
Var h% = rr#.Bottom&Buttonhoehe
Dispose rr#
Long RebarBandInfo#,40=h%      UINT        cyMinChild;
Var BackPic& = Create("hPic",-1,GetDir$("@")+"\Pics\BackGround3.bmp")
Long RebarBandInfo#,48=BackPic&hBitmap     hbmBack
sendmessage(TB&,$0438,0,$5000896D)Toolbarstyle setzen
Sendmessage (ReBar&,$0401,-1,RebarBandInfo#)Toolbar in ReBar
SetWindowPos ReBar& = 0,0- width(%hwnd),0
########################
SetToolbarAutosize(TB&)
Set("MenuBackCol",$FFFFFF)
Set("MenuBorderCol",$FFFFFF)
SubClass %HWnd, 1
Var r1# = New(Rect)

whilenot ende&

    Waitinput

    If %Umessage = ~wm_close

        exit()
        Dispose r1#
        DeleteObject BackPic&
        DeleteObject MenuFont&
        FreeDll Dll&
        Ende& = 1

    Endif

    If MenuItem(3000)

        CreateMenu
        AppendMenu 100,"&Laden",0
        AppendMenu 101,"&Speichern",0
        AppendMenu 102,"Speichern &als",0
        Rechteck des Buttons holen
        SendMessage(tb&,$400+29,0,r1#)
        TrackMenu r1#.left&,Height(TB&)

    Elseif Menuitem(3001)

        CreateMenu
        AppendMenu 100,"&Kopieren",0
        AppendMenu 101,"&Ausschneiden",0
        AppendMenu 102,"&Einfügen",0
        SendMessage(tb&,$400+29,1,r1#)
        TrackMenu r1#.left&,Height(TB&)

    Elseif Menuitem(3002)

        CreateMenu
        AppendMenu 100,"&Hilfe",0
        SendMessage(tb&,$400+29,2,r1#)
        TrackMenu r1#.left&,Height(TB&)
        Case MenuItem(100) : Messagebox("Hilfe gibt es hier nicht","...",0)

    Endif

EndWhile

SubClassProc

    If SubClassMessage(%hWnd, ~wm_size)

        SetWindowPos ReBar& = 0,0- width(%hwnd),0
        Set("WinProc", 0)

    EndIf

EndProc