XProfan

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

SubClassProc

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

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

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

        WhileLoop 0, _MaxTab%

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

            If &bucle < _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,&bucle,0)
                    Dec _MaxTab%
                    SendMessage(TabControl&,~TCM_SETCURSEL,if(&bucle - 1 > 0, &bucle-1, 0),0)' aktiviert Tab
                    Romper

                EndIf

                If tabPressed& AND not(xPressed&)

                    If SubClassMessage(Tabcontrol&, ~WM_LBUTTONDOWN)

                        draggedTab& = &bucle

                    Más

                        draggedTab& = -1

                    EndIf

                EndIf

            EndIf

        EndWhile

    EndIf

    Disponer rect#, tabrect#

ENDPROC'SUBCLASSPROC

'Hauptprogramm:
Cls
hFont% = Crear("Font","segoe ui",16,0,0,0,0)
SetDialogFont  hFont%
Mensajes del usuario $10
Tabcontrol&=Crear("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

    Declarar deskImg&, tabImg&, tabImgList&, mouse2#, rect#, tabrect#, temp$, tabPressed&, min&, max&, droppedTab&
    Declarar 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&)

        Volver

    EndIf

    'Es komplex, trotzdem wohl el de Windows vorgesehene Weg: uno schnippelt se el Tab-Bild incluso de una Screenshot de y baut entonces una 1-Bild Imagelist
    'C++ ha en el afxcmn.h una Función CreateDragImage, el letztendlich aber auch sólo el Weg en Imagelist va
    SendMessage(Tabcontrol&,~TCM_GETITEMRECT,draggedTab&,rect#)
    deskImg&   = Crear("HPIC",0,"&SCRBMP")'&DSKBMP war einfacher de el Koordinatenberechnung her, funktionierte aber sólo en el Hauptbildschirm
    tabImg&    = Crear("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)

    Mientras que ~GetAsyncKeyState(1)

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

    EndWhile

    WhileLoop 0, _maxtab%

        SendMessage(Tabcontrol&,~TCM_GETITEMRECT,&bucle,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& = &bucle

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

            'Tabs aufrücken, je después de si después de links oder después de rechts gedropped wurde
            'Hier debería neben el Tab-Texto natürlich auch el Tabinhalt ausgetauscht voluntad

            If droppedTab& >  draggedTab&

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

                WhileLoop draggedTab&, droppedTab& - 1

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

                EndWhile

                SetText Tabcontrol&,droppedTab&,temp$

            Más

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

                WhileLoop draggedTab&, droppedTab& + 1, -1

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

                EndWhile

                SetText Tabcontrol&,droppedTab&,temp$

            EndIf

            AktTab% = droppedTab&
            SendMessage(TabControl&,~TCM_SETCURSEL,AktTab%,0)' aktiviert Tab

        EndIf

    EndWhile

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

ENDPROC

Mientras que _ende%=0

    Case draggedTab& = -1 : WaitInput'algo unelegant, tal vez findet alguien el richtige Message, notfalls mousemove

    If draggedTab& <> -1

        DragTab()

    EndIf

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

        Mientras que iskey(27)

            Sleep 25

        EndWhile

        _ende%=1

    EndIf

EndWhile

SubClass Tabcontrol&,0
Mensajes del usuario 0
End