XProfan

English

Sven
Bader

yet have me before it gescheut, since the Umsetzung right unhandlich is, for "XProfed SE" wished I the feature but absolutely having.

The code is compatible with XProfan 11 (ggf. first 11.2) because of SubClassProc, hPicCopy(), Destop-Screenshot by &SCRBMP and GetText$ / SetText on Tabs.

its additional yet the Code Jens-Arne drin to that Closing by "x" on the tab, there this right similar resolved is.

one catches a Click the TabControl ex, must itself yourself calculate, where clicked watts and letztendlich with the equal positions too a Screenshot the Tabs create, a 1-Image-ImageList create and then with ImageList_BeginDrag / ImageList_DragEnter / ImageList_DragMove / ImageList_EndDrag the image on the Cursor Show and against discern where it discontinued watts.

thereafter must one any Tabs new sort (at least ex the place, where eingefügt watts).

Compile Mark Separation

 $H windows.ph
 $H messages.ph
 $H commctrl.ph
Struct S_RECT      = left&,top&,right&,bottom&
Struct S_MOUSE     = mx&,my&
Declare tabcontrol&,_hIL%,_ende%,_MaxTab%,hFont%,AktTab%
Declare draggedTab&
draggedTab& = -1
Declare mouse#
Dim mouse#, S_MOUSE

SubClassProc

    Declare   i%,o%, rect#, tabrect#, xPressed&, tabPressed&
    Dim rect#, S_RECT
    Dim tabrect#, S_RECT

    If SubClassMessage(Tabcontrol&, ~WM_LBUTTONDOWN) OR SubClassMessage(Tabcontrol&, ~WM_LBUTTONUP)

        ~GetCursorPos(mouse#)
        ~GetWindowRect(Tabcontrol&,tabrect#)

        WhileLoop 0, _MaxTab%

            sendmessage(Tabcontrol&,~TCM_GETITEMRECT,&loop,rect#)

            If &loop < _MaxTab%

                xPressed&   = (mouse#.mx& >= rect#.right&-16-2+tabrect#.left&) AND (mouse#.mx&<=rect#.right&+tabrect#.left&) AND (mouse#.my&>=rect#.top&+tabrect#.top&) AND (mouse#.my&<=rect#.top&+16+tabrect#.top&)
                tabPressed& = (mouse#.mx& >= (rect#.left&+tabrect#.left&)) AND (mouse#.mx& <= (rect#.right&+tabrect#.left&)) AND (mouse#.my& >= (rect#.top&+tabrect#.top&))  AND (mouse#.my& <= (rect#.bottom&+tabrect#.top&))

                If xPressed& AND SubClassMessage(Tabcontrol&, ~WM_LBUTTONUP)

                    sendmessage(Tabcontrol&,~TCM_DELETEITEM,&loop,0)
                    Dec _MaxTab%
                    SendMessage(TabControl&,~TCM_SETCURSEL,if(&loop - 1 > 0, &loop-1, 0),0)' activate tab
                    Break

                EndIf

                If tabPressed& AND hardship(xPressed&)

                    If SubClassMessage(Tabcontrol&, ~WM_LBUTTONDOWN)

                        draggedTab& = &loop

                    Else

                        draggedTab& = -1

                    EndIf

                EndIf

            EndIf

        EndWhile

    EndIf

    Dispose rect#, tabrect#

ENDPROC'SUBCLASSPROC

'Hauptprogramm:
Cls
hFont% = Create("Font","segoe ui",16,0,0,0,0)
SetDialogFont  hFont%
User Messages $10
Tabcontrol&=Create("TABCTRL",%HWnd,_hIL%,0,32,width(%HWnd),24)
SubClass Tabcontrol&,1
set("FASTMODE",1)
inserttab(Tabcontrol&,0,"Tab 1  × ")
inserttab(Tabcontrol&,1,"Tab 2  × ")
inserttab(Tabcontrol&,2,"Tab 3  × ")
inserttab(Tabcontrol&,3,"Tab 4  × ")
inserttab(Tabcontrol&,4,"Tab 5  × ")
set("FASTMODE",0)
_MaxTab% = 5

Proc DragTab

    Declare deskImg&, tabImg&, tabImgList&, mouse2#, rect#, tabrect#, temp$, tabPressed&, min&, max&, droppedTab&
    Declare BorderWidth&, BorderHeight&, TitleHeight&, MenuBarHeight&, ClientRect#,WindowRect#
    Dim WindowRect#,S_RECT
    Dim ClientRect#,S_RECT
    Dim mouse2#, S_MOUSE
    Dim rect#, S_RECT
    Dim tabrect#, S_RECT
    ~GetCursorPos(mouse2#)
    ~GetWindowRect(Tabcontrol&,tabrect#)
    ~GetWindowRect(%hwnd,WindowRect#)
    ~GetClientRect(%hwnd,ClientRect#)
    BorderWidth&   = (WindowRect#.right& - WindowRect#.left& - ClientRect#.right&) / 2
    BorderHeight&  = (WindowRect#.bottom& - WindowRect#.top& - ClientRect#.bottom& - BorderWidth&)
    'TitleHeight&   = ~GetSystemMetrics(~SM_CYCAPTION)
    'MenuBarHeight& = ~GetSystemMetrics(~SM_CYMENU)

    If (mouse2#.mx& = mouse#.mx&) AND  (mouse#.my& = mouse2#.my&)

        Return

    EndIf

    'its komplex, nevertheless well the Windows vorgesehene lane: one schnippelt itself the tab-Image self a Screenshot from and building then a 1-Image Imagelist
    'C++ has in the afxcmn.h a function CreateDragImage, The letztendlich but too only whom lane over The Imagelist goes
    Sendmessage(Tabcontrol&,~TCM_GETITEMRECT,draggedTab&,rect#)
    deskImg&   = Create("HPIC",0,"&SCRBMP")'&DSKBMP was plainer from the Koordinatenberechnung since, funktionierte but only on the Hauptbildschirm
    tabImg&    = Create("hPicCopy", deskImg&, \
    tabrect#.left&+rect#.left& - (WindowRect#.left&  + BorderWidth&),\
    tabrect#.top&+rect#.top&   - (WindowRect#.top&  + BorderHeight&),\
    rect#.right&-rect#.left&,\
    rect#.bottom& - rect#.top&)
    tabImgList& = create("ImageList",  rect#.right&-rect#.left&, rect#.bottom&-rect#.top&, tabImg&,-1)
    DeLeteObject tabImg&, deskImg&
    ~ImageList_BeginDrag(tabImgList&,0,%winleft,%wintop)
    ~ImageList_DragEnter(%hwnd,0,0)

    While ~GetAsyncKeyState(1)

        ~GetCursorPos(mouse2#)
        ~ImageList_DragMove(mouse2#.mx&,mouse2#.my&)

    EndWhile

    WhileLoop 0, _maxtab%

        SendMessage(Tabcontrol&,~TCM_GETITEMRECT,&loop,rect#)
        tabPressed& = (mouse2#.mx& >= (rect#.left&+tabrect#.left&)) AND (mouse2#.mx& <= (rect#.right&+tabrect#.left&)) AND (mouse2#.my& >= (rect#.top&+tabrect#.top&))  AND (mouse2#.my& <= (rect#.bottom&+tabrect#.top&))
        droppedTab& = &loop

        If tabPressed& AND  (droppedTab& <> draggedTab&)

            'Tabs aufrücken, depending on whether to left or to right gedropped watts
            'here should next to the tab-Text naturally too the Tabinhalt ausgetauscht go

            If droppedTab& >  draggedTab&

                temp$ = GetText$(tabcontrol&,draggedTab&)

                WhileLoop draggedTab&, droppedTab& - 1

                    SetText Tabcontrol&,&loop,GetText$(tabcontrol&,&loop + 1)

                EndWhile

                SetText Tabcontrol&,droppedTab&,temp$

            Else

                temp$ = GetText$(tabcontrol&,draggedTab&)

                WhileLoop draggedTab&, droppedTab& + 1, -1

                    SetText Tabcontrol&,&loop,GetText$(tabcontrol&,&loop -1)

                EndWhile

                SetText Tabcontrol&,droppedTab&,temp$

            EndIf

            AktTab% = droppedTab&
            SendMessage(TabControl&,~TCM_SETCURSEL,AktTab%,0)' activate tab

        EndIf

    EndWhile

    ~ImageList_EndDrag()
    DeLeteObject  tabImgList&
    draggedTab& = -1
    Repaint 1
    Dispose mouse2#, rect#, tabrect#, ClientRect#, WindowRect#

ENDPROC

While _ende%=0

    Case draggedTab& = -1 : WaitInput'something unelegant, Perhaps finds someone The right Message, if need be mousemove

    If draggedTab& <> -1

        DragTab()

    EndIf

    If (%uMessage=$10) or ((~GetForegroundWindow()=%HWnd) and iskey(27))

        While iskey(27)

            Sleep 25

        EndWhile

        _ende%=1

    EndIf

EndWhile

SubClass Tabcontrol&,0
User Messages 0
End