XProfan

 $H windows.ph
 $H messages.ph
STRUCT RECT = Left&,Righ&,Top&,Bottom&
Declare bereich#,be#,objekt#,erg&,erg2&,x&,y&,links1&,oben1&,links2&,oben2&
Dim be#,8
Dim bereich#,1024
Dim objekt#,16
' Ermittelt das Handle unter dem Mauszeiger

Proc MPos

    ~GetCursorPos(be#)
    x&=Long(be#,0)
    y&=Long(be#,4)
    erg&=~WindowFromPoint(x&,y&)

EndProc

' Verschiebt die Toolbar

Proc MoveIt

    Parameters wnd&,lParam&
    ~GetClientRect(wnd&,R#)
    ~MapWindowPoints(wnd&,%hwnd,R#,2)

    If ~PtInRect(R#,LoWord(lParam&),HiWord(lParam&))

        ~ReleaseCapture()
        UseCursor 5
        SendMessage(wnd&,~WM_SYSCOMMAND,~SC_MOVE+1,0)
        UseCursor 0
        Return 0

    endif

    Return 1

EndProc

Proc PosInWnd

    Clear objekt#
    ~GetWindowRect(STB1&,objekt#)
    ~ScreenToClient(%HWND,objekt#)
    links1&=Long(objekt#,0)
    oben1&=Long(objekt#,4)
    Clear objekt#
    ~GetWindowRect(STB2&,objekt#)
    ~ScreenToClient(%HWND,objekt#)
    links2&=Long(objekt#,0)
    oben2&=Long(objekt#,4)

EndProc

' Ausrichten

Proc UpdateToolbar

    Parameters TB%,handle&
    PosInWnd

    if TB%=1

        if links1&<5

            SetWindowpos STB1&=0,2-width(STB1&),32;0
            SetWindowpos STB2&=width(STB1&),2-width(STB2&),32;0

        elseif links1&>width(STB1&)

            SetWindowpos STB2&=0,2-width(STB2&),32;0
            SetWindowpos STB1&=width(STB2&),2-width(STB1&),32;0

        else

            if links2&=0

                SetWindowpos STB1&=width(STB2&),2-width(STB1&),32;0

            else

                SetWindowpos STB1&=0,2-width(STB1&),32;0

            endif

        endif

    elseif TB%=2

        if links2&<5

            SetWindowpos STB2&=0,2-width(STB2&),32;0
            SetWindowpos STB1&=width(STB2&),2-width(STB1&),32;0

        elseif links2&>width(STB2&)

            SetWindowpos STB2&=width(STB1&),2-width(STB2&),32;0
            SetWindowpos STB1&=0,2-width(STB1&),32;0

        else

            if links1&=0

                SetWindowpos STB2&=width(STB1&),2-width(STB2&),32;0

            else

                SetWindowpos STB2&=0,2-width(STB2&),32;0

            endif

        endif

    endif

EndProc

' Hauptfenster
WindowStyle 24
WindowTitle "Abreißbare Toolbar"
Window %maxX/2-320,(%maxY/2-240)-640,480
Cls ~GetSysColor(16)
UsePen 0,1,~GetSysColor(15)
UseBrush 1,~GetSysColor(15)
Rectangle 0,0-%maxX,36
UsePen 0,1,~GetSysColor(15)
Line 0,0-%maxX,0
UsePen 0,1,RGB(255,255,255)
Line 0,1-%maxX,1
UsePen 0,1,0
Line 0,34-%maxX,34
UsePen 0,1,RGB(255,255,255)
Line 0,35-%maxX,35
var CB&=Create("CheckBox",%hwnd,"Ausrichten",530,420,90,20)
SetCheck CB&,1
var STB1&=Control("DIALOG","",$54000000,0,2,105,32,%hwnd,0,%hinstance)
var SB1&=Create("Button",STB1&,"",4,2,4,28)
EnableWindow SB1&,0
var STB2&=Control("DIALOG","",$54000000,105,2,136,32,%hwnd,0,%hinstance)
var SB2&=Create("Button",STB2&,"",4,2,4,28)
EnableWindow SB2&,0
var TB1&=Control("DIALOG","",$54000000,10,0,95,32,STB1&,0,%hinstance)
var TB2&=Control("DIALOG","",$54000000,10,0,126,32,STB2&,0,%hinstance)
var long hBild = create("hPic", -1, $ProgDir+"test24.bmp")' <-------------- ggf. ANPASSEN !!!
var long hBildliste = create("ImageList", 24, 24, hBild, rgb(192,192,192))
var long hToolbar1 = create("Toolbar", TB1&, hBildliste,0,0,2000,1)
var long hToolbar2 = create("Toolbar", TB2&, hBildliste,0,0,2000,1)
deleteobject hBild
Toolbar("AddButton", hToolbar1, 0, 100, "Neue Datei")
Toolbar("AddButton", hToolbar1, 1, 101, "Datei öffnen")
Toolbar("AddButton", hToolbar1, 2, 102, "Datei speichern")
Toolbar("AddButton", hToolbar2, 5, 200, "Ausschneiden")
Toolbar("AddButton", hToolbar2, 6, 201, "Kopieren")
Toolbar("AddButton", hToolbar2, 7, 202, "Einfügen")
Toolbar("AddButton", hToolbar2, 8, 203, "Löschen")
Var R# = New(RECT)
' Hauptprogrammschleife

WhileNot %Umessage = ~wm_close

    WaitInput
    MPos
    PosInWnd

    if erg&=STB1&

        SetWindowpos STB1&=links1&,oben1&-width(STB1&),height(STB1&);0
        ~EnumChildWindows(%hwnd,ProcAddr("MoveIt",2),MakeLong(%mousex,%mousey))
        Case GetCheck(CB&)=1:UpdateToolbar 1,STB1&

    endif

    if erg&=STB2&

        SetWindowpos STB2&=links2&,oben2&-width(STB2&),height(STB2&);0
        ~EnumChildWindows(%hwnd,ProcAddr("MoveIt",2),MakeLong(%mousex,%mousey))
        Case GetCheck(CB&)=1:UpdateToolbar 2,STB2&

    endif

EndWhile

'Ende
Dispose hdr#
Dispose R#
Dispose bereich#
Dispose objekt#
end