XProfan

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

SubClassProc

    Déclarer   i%,o%, rect#, tabrect#, xPressed&, tabPressed&
    Faible rect#, S_RECT
    Faible tabrect#, S_RECT

    Si SubClassMessage(Tabcontrol&, ~WM_LBUTTONDOWN) OU SubClassMessage(Tabcontrol&, ~WM_LBUTTONUP)

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

        WhileLoop 0, _MaxTab%

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

            Si &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&))

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

                    sendmessage(Tabcontrol&,~TCM_DELETEITEM,&loop,0)
                    Décembre _MaxTab%
                    SendMessage(TabControl&,~TCM_SETCURSEL,si(&loop - 1 > 0, &loop-1, 0),0)' aktiviert Tab
                    Pause

                EndIf

                Si tabPressed& AND not(xPressed&)

                    Si SubClassMessage(Tabcontrol&, ~WM_LBUTTONDOWN)

                        draggedTab& = &loop

                    D'autre

                        draggedTab& = -1

                    EndIf

                EndIf

            EndIf

        Endwhile

    EndIf

    Dispose rect#, tabrect#

ENDPROC'SUBCLASSPROC

'Hauptprogramm:
Cls
hFont% = Créer("Font","segoe ui",16,0,0,0,0)
SetDialogFont  hFont%
Utilisateur Messages $10
Tabcontrol&=Créer("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

    Déclarer deskImg&, tabImg&, tabImgList&, mouse2#, rect#, tabrect#, temp$, tabPressed&, min&, max&, droppedTab&
    Déclarer BorderWidth&, BorderHeight&, TitleHeight&, MenuBarHeight&, ClientRect#,WindowRect#
    Faible WindowRect#,S_RECT
    Faible ClientRect#,S_RECT
    Faible mouse2#, S_MOUSE
    Faible rect#, S_RECT
    Faible 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)

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

        Retour

    EndIf

    'c'est komplex, quand même wohl qui de Windows vorgesehene Weg: on schnippelt sich cela Tab-Bild selbst aus einem Screenshot aus et baut ensuite une 1-Bild Imagelist
    'C++ hat dans qui afxcmn.h une Funktion CreateDragImage, qui letztendlich mais aussi seulement den Weg sur qui Imagelist allez
    SendMessage(Tabcontrol&,~TCM_GETITEMRECT,draggedTab&,rect#)
    deskImg&   = Créer(«PCSI»,0,"&SCRBMP")'&DSKBMP était einfacher de qui Koordinatenberechnung her, funktionierte mais seulement sur dem Hauptbildschirm
    tabImg&    = Créer("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)

    Tandis que ~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

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

            'Tabs aufrücken, je après que si à gauche ou bien à droite gedropped wurde
            'ici devrait près de dem Tab-Text naturellement aussi qui Tabinhalt ausgetauscht volonté

            Si droppedTab& >  draggedTab&

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

                WhileLoop draggedTab&, droppedTab& - 1

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

                Endwhile

                SetText Tabcontrol&,droppedTab&,temp$

            D'autre

                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)' aktiviert Tab

        EndIf

    Endwhile

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

ENDPROC

Tandis que _ende%=0

    Cas draggedTab& = -1 : WaitInput'quelque chose unelegant, peut-être findet quelqu'un qui richtige Message, notfalls mousemove

    Si draggedTab& <> -1

        DragTab()

    EndIf

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

        Tandis que iskey(27)

            Sleep 25

        Endwhile

        _ende%=1

    EndIf

Endwhile

SubClass Tabcontrol&,0
Utilisateur Messages 0
Fin