XProfan

 $H windows.ph
 $H messages.ph
STRUCT RECT = Left&,Righ&,Top&,Bottom&
Declare area#,be#,objekt#,erg&,erg2&,x&,y&,left1&,supra1&,left2&,supra2&
Dim be#,8
Dim area#,1024
Dim objekt#,16
' determined the lever under the Cursor

Proc MPos

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

ENDPROC

' shift The Toolbar

Proc MoveIt

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

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

        ~Capture Release()
        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#)
    left1&=Long(objekt#,0)
    supra1&=Long(objekt#,4)
    Clear objekt#
    ~GetWindowRect(STB2&,objekt#)
    ~ScreenToClient(%HWND,objekt#)
    left2&=Long(objekt#,0)
    supra2&=Long(objekt#,4)

ENDPROC

' report

Proc UpdateToolbar

    Parameters TB%,handle&
    PosInWnd

    if TB%=1

        if left1&<5

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

        elseif left1&>width(STB1&)

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

        else

            if left2&=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 left2&<5

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

        elseif left2&>width(STB2&)

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

        else

            if left1&=0

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

            else

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

            endif

        endif

    endif

ENDPROC

' Mainwindow
Window Style 24
Window Title "Abreißbare Toolbar"
Window %maxX/2-320,(%maxY/2-240)-640,480
Cls ~GetSysColor(16)
USEP 0,1,~GetSysColor(15)
UseBrush 1,~GetSysColor(15)
Rectangle 0,0-%maxX,36
USEP 0,1,~GetSysColor(15)
Line 0,0-%maxX,0
USEP 0,1,RGB(255,255,255)
Line 0,1-%maxX,1
USEP 0,1,0
Line 0,34-%maxX,34
USEP 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&=left1&,supra1&-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&=left2&,supra2&-width(STB2&),height(STB2&);0
        ~EnumChildWindows(%hwnd,ProcAddr("MoveIt",2),MakeLong(%mousex,%mousey))
        Case GetCheck(CB&)=1:UpdateToolbar 2,STB2&

    endif

EndWhile

'end
Dispose hdr#
Dispose R#
Dispose area#
Dispose objekt#
end