Italia
Fonte/ Codesnippets

Tabs per Drag&Drop verschieben in einem TabControl

 

Sven
Bader
Bisher habe mich davor gescheut, da die Umsetzung recht unhandlich ist, per "XProfed SE" wollte ich das Feature aber unbedingt haben.

Der Code ist kompatibel mit XProfan 11 (ggf. erst 11.2) wegen SubClassProc, hPicCopy(), Destop-Screenshot per &SCRBMP und GetText$ / SetText auf Tabs.

Es ist zusätzlich noch der Code von Jens-Arne drin zum Schließen per "x" auf dem Tab, da dies recht ähnlich gelöst ist.

Man fängt einen Klick auf das Tabcontrol ab, muss sich selber ausrechnen, wohin geklickt wurde und letztendlich mit den gleichen Positionen auch einen Screenshot des Tabs erstellen, eine 1-Bild-ImageList erstellen und dann mit ImageList_BeginDrag / ImageList_DragEnter / ImageList_DragMove / ImageList_EndDrag das Bild am Mauszeiger Mostra und wiederum erkennen wo es abgesetzt wurde.

Danach muss man alle Tabs neu sortieren (zumindest ab der Stelle, wo eingefügt wurde).


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

                EndIf

                If tabPressed& AND not(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%
UserMessages $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

    'Es ist komplex, trotzdem wohl der von Windows vorgesehene Weg: man schnippelt sich das Tab-Bild selbst aus einem Screenshot aus und baut dann eine 1-Bild Imagelist
    'C++ hat in der afxcmn.h eine Funktion CreateDragImage, die letztendlich aber auch nur den Weg circa die Imagelist geht
    Sendmessage(Tabcontrol&,~TCM_GETITEMRECT,draggedTab&,rect#)
    deskImg&   = Create("hPic",0,"&SCRBMP")'&DSKBMP war einfacher von der Koordinatenberechnung her, funktionierte aber nur auf dem 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, je nachdem ob nach links oder nach rechts gedropped wurde
            'Hier müsste neben dem Tab-Text naturalmente auch der Tabinhalt ausgetauscht werden

            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)' aktiviert 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'etwas unelegant, vielleicht findet jemand die richtige Message, notfalls 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
UserMessages 0
End

179 kB
Hochgeladen:03.04.2023
Downloadcounter62
Download
 
03.04.2023  
 



Zum Quelltext


Topictitle, max. 100 characters.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Posting  Font  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Topic-Options

947 Views

Untitledvor 0 min.
Axel Berse08.11.2023
Thomas Zielinski28.06.2023
Paul Glatz22.06.2023
E.T.12.06.2023
Di più...

Themeninformationen

Dieses Thema hat 1 subscriber:

Sven Bader (1x)


Admins  |  AGB  |  Applications  |  Autori  |  Chat  |  Informativa sulla privacy  |  Download  |  Entrance  |  Aiuto  |  Merchantportal  |  Impronta  |  Mart  |  Interfaces  |  SDK  |  Services  |  Giochi  |  Cerca  |  Support

Ein Projekt aller XProfaner, die es gibt!


Il mio XProfan
Private Notizie
Eigenes Ablageforum
Argomenti-Merkliste
Eigene Beiträge
Eigene Argomenti
Zwischenablage
Annullare
 Deutsch English Français Español Italia
Traduzioni

Informativa sulla privacy


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Ich möchte keinen Cookie