DragNDrop sur TreeGadget

Ulix

Bonjour a tous,

Je m'essaie au DragNDrop sur un TreeGadget.
J'arrive a déplacer les items (suppression/insertion).

Mais quel a été ma surprise de voir que DragNDrop ne gérer pas le scrolling !
Si je déplace un item au-dessus ou au-dessous de la partie visible de la liste,
pas de déplacement !
Sur le coup, j'ai pensé qu'une subtilité m'avais écharpé. Mais apparemment non !
C'est bien le DragNDrop qui ne gère pas le scrolling (ou le gadget !)

Je n'ai pas trouvé d'exemples qui gère les ascenseurs en fonction du déplacement du curseur.
Je suppose qui faille utilisé les APIs, ou/et une callback. :twisted:

Le développe sous linux, si quelqu'un a du code qui fonctionne, merci a lui d'avance !
Je poste mon code de test, enfin mon code de développement (épurer au maximum),
pour illustrer le problème (si problème il y a, car j'ai parfaitement pu m'y prendre comme un pied) :oops:

Merci d'avance pour tous vos essais, et vos commentaires !

Code:

;   Utilisation d'un TreeGadget des liste de contacts
;   Utilisation du DragNDrop pour déplace les contacts
;   Le  DragNDrop ne gére pas le scrolling (déplacement) des items ???
;   En dehors de la partie visible ???


EnableExplicit


Enumeration Fenetre
;{  
#f1
EndEnumeration
;}
Enumeration Gadget
;{
#Tree
EndEnumeration
;}
;{
Enumeration Divers
#PrivateType = 10      ;   variable pour #PB_Drop_Private
;}
EndEnumeration

;   Les structures

;   Les variables

Global f1Quitter            ;   Variable boucle principale
Global aa.b               ;   Variable boucle de test

Global PositionDepart.l        ;   Variable position item de départ du DragNDrop
Global PositionArriver.l       ;   Variable position item d'Arriver du DragNDrop
;Global *PositionRelatif

Global PDItem$            ;   Variable temporaire PositionDépartItem
Global PAItem$            ;   Variable temporaire PositionArrivertItem

; ##################################################
;                        Les Procédures 
; ################################################## 

Procedure.b CreationFenetre() 
If OpenWindow(#f1, 100, 100, 300, 400, "Test Drag-Drop", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
      
      ;      Menu, raccourci et menu popup
      
      ;      Gadget
      TreeGadget(#Tree,0,0,300,400,#PB_Tree_NoLines | #PB_Tree_NoButtons | #PB_Tree_AlwaysShowSelection)
      
      
      ;   rempli la liste
      For aa = 0 To 50
                AddGadgetItem(#Tree, -1, "Item" + Str(aa), 0, 0)
      Next aa
      
      
      

      ProcedureReturn 1
Else    
      ProcedureReturn 0
EndIf
EndProcedure
   
 
; ##################################################
;                      Début programme 
; ################################################## 

 
 ;   Lecture fichier initialisation
 ;   Chargement des images
 ;   Lecture fichier données 
  
 CreationFenetre() 
  
  
 ;   1er cas OK
 ;EnableGadgetDrop(#Tree,   #PB_Drop_Text,      #PB_Drag_Move)
 ;   2ème cas  OK
EnableGadgetDrop(#Tree,   #PB_Drop_Private,      #PB_Drag_Move,   #PrivateType)


;   
SetGadgetState(#Tree, 25)   ;   positionnement au millieu de la liste

; ##################################################
;             Boucle des evenements de la Fenétre principale
; ##################################################
Repeat
Select WaitWindowEvent()

   
         
Case #PB_Event_Menu
         Select EventMenu() 
         
         EndSelect
 
Case #PB_Event_Gadget
         Select EventGadget()
         Case #Tree
                  Select EventType()
                  Case #PB_EventType_LeftClick              ;   Clic gauche
                  Case #PB_EventType_RightClick            ;   Clic droit, ouvre menu popup.
                      Case #PB_EventType_LeftDoubleClick     ;   Double-clic gauche
                  Case #PB_EventType_RightDoubleClick    ;   Double-Clic droit sur un élément.
                  Case #PB_EventType_Change                 ;   L'élément courant a changé
                  Case #PB_EventType_DragStart              ;   Début d'un Drag-Drop (Glisser & Déposer).
                                                   PositionDepart      =   GetGadgetState(#Tree)   
                                                   ;Niveau         =   GetGadgetItemAttribute(#Tree, PositionDepart,  #PB_Tree_SubLevel)
                                                   PDItem$         =   GetGadgetItemText(#Tree, PositionDepart)
                                                   Debug "Position Départ = "+Str(PositionDepart);+"  "+ "Niveau = "+Str(Niveau)
                                                   
                                                   ;   1er cas  avec #PB_Drop_Text, ça marche ??  OK
                                                   ;    Transfert du texte (départ : Dragtexte, arriver : EventDropText)
                                                   ;DragText(PDItem$, #PB_Drag_Move)
                                                   ;RemoveGadgetItem(#Tree, PositionDepart)
                                                          
                                                          ;   2ème cas avec #PrivateType, ça marche 
                                                          ;   Lance une opération de 'Drag & Drop' limitée à l'appicaton elle-même. 
                                                          ;   Apparement dans ce cas on ne transfert pas le texte, on utilise les variable globales !
                                                          ;   ne pas effacer l'item de départ
                                                          DragPrivate(#PrivateType, #PB_Drag_Move)            
                                                                
                                                          ;EndIf
                  EndSelect
         EndSelect
         
Case #PB_Event_GadgetDrop       ;    Fin de l'opération Drag-Drop  sur un gadget 
        
               Select EventGadget()
               Case #Tree
                           Select EventDropType()         ;   Receptions des données
                           Case #PB_Drop_Private
                                       Select EventDropPrivate()
                                       Case #PrivateType   ;   Drop' limitée à l'appicaton elle-même. 
                                                         ;   Pas de texte a récuperer, utilisés les variables globales : PositionDepart et PositionArriver 
                                                         PositionArriver      =   GetGadgetState(#Tree)   
                                                         PDItem$         =   GetGadgetItemText(#Tree, PositionDepart)
                                                         RemoveGadgetItem(#Tree, PositionDepart)         ;   Supprime l'item de départ
                                                         Debug "Position Arriver = "+Str(PositionArriver)
                                                         AddGadgetItem(#Tree, PositionArriver, PDItem$)      ;   Insérer l'item (A faire après la sélection)
                                       EndSelect
                              ;Case #PB_Drop_Image  
                              ;Case #PB_Drop_Files         
                           Case #PB_Drop_Text             ;   Ici Drop' limitée à l'appicaton elle-même, ça marche aussi ? 
                                                      ;   Ici du texte a récupérer                       
;                                                       PositionArriver      =   GetGadgetState(#Tree)   
;                                                       PAItem$         =   EventDropText()
;                                                       Debug "Position Arriver = "+Str(PositionArriver);+"  "+ "Niveau = "+Str(Niveau)
;                                              ;   Insertion est autorisé au même niveau (a la place de l'item)
;                                                       AddGadgetItem(#Tree, PositionArriver, PAItem$); , 0,1); ImageID(#ImagePersonne), 1)
                           EndSelect
               EndSelect
         
Case #PB_Event_WindowDrop      ;   : Une opération DragNDrop s'est terminée sur une fenêtre        
Case #PB_Event_CloseWindow
                  ;FichierPreferencesEcriture() 
                  f1Quitter = 1
               
Default

EndSelect
Until f1Quitter = 1
CloseWindow(#f1)
End

falsam

Je pense effectivement que tu vas devoir utiliser des API pour y parvenir. C'est la même chose sous Windows.

Ollivier

T'as trouvê ce que tu voulais?

Mesa · **Inscription:** Mer 14/Sep/2011 16:59 **Messages:** 932

Ça marche comme ça ?

Code:

 ;   Utilisation d'un TreeGadget des liste de contacts
;   Utilisation du DragNDrop pour déplace les contacts
;   Le  DragNDrop ne gére pas le scrolling (déplacement) des items ???
;   En dehors de la partie visible ???


;EnableExplicit


Enumeration Fenetre
;{ 
#f1
EndEnumeration
;}
Enumeration Gadget
;{
#Tree
EndEnumeration
;}
;{
Enumeration Divers
#PrivateType = 10      ;   variable pour #PB_Drop_Private
;}
EndEnumeration

;   Les structures

;   Les variables

Global f1Quitter            ;   Variable boucle principale
Global aa.b               ;   Variable boucle de test

Global PositionDepart.l        ;   Variable position item de départ du DragNDrop
Global PositionArriver.l       ;   Variable position item d'Arriver du DragNDrop
;Global *PositionRelatif

Global PDItem$            ;   Variable temporaire PositionDépartItem
Global PAItem$            ;   Variable temporaire PositionArrivertItem

; ##################################################
;                        Les Procédures
; ##################################################

Procedure.b CreationFenetre()
If OpenWindow(#f1, 100, 100, 300, 400, "Test Drag-Drop", #PB_Window_SystemMenu | #PB_Window_MinimizeGadget)
      
      ;      Menu, raccourci et menu popup
      
      ;      Gadget
      TreeGadget(#Tree,0,0,300,400,#PB_Tree_NoLines | #PB_Tree_NoButtons | #PB_Tree_AlwaysShowSelection)
      
      
      ;   rempli la liste
      For aa = 0 To 50
                AddGadgetItem(#Tree, -1, "Item" + Str(aa), 0, 0)
      Next aa
      
      
      

      ProcedureReturn 1
Else    
      ProcedureReturn 0
EndIf
EndProcedure
   

; ##################################################
;                      Début programme
; ##################################################


;   Lecture fichier initialisation
;   Chargement des images
;   Lecture fichier données
 
CreationFenetre()
 
Procedure DragCallback(action)
  ;Debug WindowMouseY(#f1)
  y=WindowMouseY(#f1)
  #TVM_GETITEMHEIGHT = (#TV_FIRST + 28) 
  If y<GadgetY(#Tree)+SendMessage_(GadgetID(#Tree),#TVM_GETITEMHEIGHT,0, 0) 
    Debug "ok"
    ;     #TVM_SETSCROLLTIME=#TV_FIRST + 33
    ;      SendMessage_(GadgetID(#Tree),#TVM_SETSCROLLTIME,1000,0)
    SendMessage_(GadgetID(#Tree),#WM_VSCROLL,#SB_LINEUP,0);#SB_THUMBTRACK
  EndIf
  If y>(GadgetY(#Tree)+GadgetHeight(#Tree)-SendMessage_(GadgetID(#Tree),#TVM_GETITEMHEIGHT,0, 0))
    Debug "ok"
    ;     #TVM_SETSCROLLTIME=#TV_FIRST + 33
    ;      SendMessage_(GadgetID(#Tree),#TVM_SETSCROLLTIME,1000,0)
    SendMessage_(GadgetID(#Tree),#WM_VSCROLL,#SB_LINEDOWN,0);#SB_THUMBTRACK
  EndIf
  ProcedureReturn #True
  
EndProcedure

;   1er cas OK
;EnableGadgetDrop(#Tree,   #PB_Drop_Text,      #PB_Drag_Move)
;   2ème cas  OK
EnableGadgetDrop(#Tree,   #PB_Drop_Private,      #PB_Drag_Move,   #PrivateType)
SetDragCallback(@DragCallback())


;   
SetGadgetState(#Tree, 25)   ;   positionnement au millieu de la liste

; ##################################################
;             Boucle des evenements de la Fenétre principale
; ##################################################
Repeat
Select WaitWindowEvent()

   
         
Case #PB_Event_Menu
         Select EventMenu()
         
         EndSelect

Case #PB_Event_Gadget
         Select EventGadget()
         Case #Tree
                  Select EventType()
                  Case #PB_EventType_LeftClick              ;   Clic gauche
                  Case #PB_EventType_RightClick            ;   Clic droit, ouvre menu popup.
                      Case #PB_EventType_LeftDoubleClick     ;   Double-clic gauche
                  Case #PB_EventType_RightDoubleClick    ;   Double-Clic droit sur un élément.
                  Case #PB_EventType_Change              ;   L'élément courant a changé
                    Debug "ok"
                    Debug GetGadgetState(#Tree)
                    
                  Case #PB_EventType_DragStart              ;   Début d'un Drag-Drop (Glisser & Déposer).
                                                   PositionDepart      =   GetGadgetState(#Tree)   
                                                   ;Niveau         =   GetGadgetItemAttribute(#Tree, PositionDepart,  #PB_Tree_SubLevel)
                                                   PDItem$         =   GetGadgetItemText(#Tree, PositionDepart)
                                                   Debug "Position Départ = "+Str(PositionDepart);+"  "+ "Niveau = "+Str(Niveau)
                                                   
                                                   ;   1er cas  avec #PB_Drop_Text, ça marche ??  OK
                                                   ;    Transfert du texte (départ : Dragtexte, arriver : EventDropText)
                                                   ;DragText(PDItem$, #PB_Drag_Move)
                                                   ;RemoveGadgetItem(#Tree, PositionDepart)
                                                          
                                                          ;   2ème cas avec #PrivateType, ça marche
                                                          ;   Lance une opération de 'Drag & Drop' limitée à l'appicaton elle-même.
                                                          ;   Apparement dans ce cas on ne transfert pas le texte, on utilise les variable globales !
                                                          ;   ne pas effacer l'item de départ
                                                          DragPrivate(#PrivateType, #PB_Drag_Move)            
                                                                
                                                          ;EndIf
                  EndSelect
         EndSelect
         
Case #PB_Event_GadgetDrop       ;    Fin de l'opération Drag-Drop  sur un gadget
       
               Select EventGadget()
               Case #Tree
                           Select EventDropType()         ;   Receptions des données
                           Case #PB_Drop_Private
                                       Select EventDropPrivate()
                                       Case #PrivateType   ;   Drop' limitée à l'appicaton elle-même.
                                                         ;   Pas de texte a récuperer, utilisés les variables globales : PositionDepart et PositionArriver
                                                         PositionArriver      =   GetGadgetState(#Tree)   
                                                         PDItem$         =   GetGadgetItemText(#Tree, PositionDepart)
                                                         RemoveGadgetItem(#Tree, PositionDepart)         ;   Supprime l'item de départ
                                                         Debug "Position Arriver = "+Str(PositionArriver)
                                                         AddGadgetItem(#Tree, PositionArriver, PDItem$)      ;   Insérer l'item (A faire après la sélection)
                                       EndSelect
                              ;Case #PB_Drop_Image 
                              ;Case #PB_Drop_Files         
                           Case #PB_Drop_Text             ;   Ici Drop' limitée à l'appicaton elle-même, ça marche aussi ?
                                                      ;   Ici du texte a récupérer                       
;                                                       PositionArriver      =   GetGadgetState(#Tree)   
;                                                       PAItem$         =   EventDropText()
;                                                       Debug "Position Arriver = "+Str(PositionArriver);+"  "+ "Niveau = "+Str(Niveau)
;                                              ;   Insertion est autorisé au même niveau (a la place de l'item)
;                                                       AddGadgetItem(#Tree, PositionArriver, PAItem$); , 0,1); ImageID(#ImagePersonne), 1)
                           EndSelect
               EndSelect
         
Case #PB_Event_WindowDrop      ;   : Une opération DragNDrop s'est terminée sur une fenêtre       
Case #PB_Event_CloseWindow
                  ;FichierPreferencesEcriture()
                  f1Quitter = 1
               
Default

EndSelect
Until f1Quitter = 1
CloseWindow(#f1)
End

Mesa.

Ulix

Merci pour vos réponses !

@Ollivier
Non, mais je bosse sur la fonction :SetDropCallback(@DropCallback()) fourni avec la librairie DragNDrop.

Apparemment, la Callback de la librairie "DropCallback(Handle, Etat, Format, Action, x, y) " renvoie
la position en X et Y en pixels a position de la souris. Il me reste a gérer la partie visible, enfin je cherche, je teste.
J'ai bon espoir car j'ai tester depuis la Callback un setgadgetstate(#Tree, position) et cela permet
de déplacé vers le haut ou le bas la partie visible des items.
De plus cette solution est toute en natif !

@Mesa
Merci pour cette callBack ! Hélas c'est pour du Windows, je suis sous linux !

Ollivier

De 2 choses, l'une :

1) sous Linux (inspiré par Progi1984 https://developer.gnome.org/gtk3/stable/GtkScrollable.html )

il y une structure à créer:

Code:

Structure GtkAdjustement
Value.I
Lower.I
Upper.I
Step_Increment.I
Page_Increment.I
Page_Size.I
EndStructure

Define *Adj.GtkAdjustement = AllocateMemory(SizeOf(GtkAdjustement) )

C'est "valeur" qu'il faudra modifier entre les extrema "Lower" et "Upper" avec un pas de "Step_Increment"

Code:

;Descendre le scroll
With *Adj
\Valeur + \Step_Increment
If \Valeur > \Lower
\Valeur = \Lower
EndIf
EndWith

Code:

;Monter le scroll
With *Adj
\Valeur - \Step_Increment
If \Valeur < \Upper
\Valeur = \Upper
EndIf
EndWith

Code:

; Récupérer la structure
GID = GadgetID(#myTree)
gtk_scrollable_get_vadjustment(GID, *Adj)

; monter ou descendre comme expliqué plus haut

; Renvoyer la structure modifiée
gtk_scrollable_set_vadjustment(GID, *Adj) 

Woilà pour le "puzzle" ! En espérant ne pas me gaméler!

2) "Plan B" (A suivre...)

[Edit] j'ai inversé les signes < et >. Aussi vérifier au préalable avec Debug laquelle des deux valeurs "Lower" et "Upper" est la plus grande numériquement. J'ai considéré que "Lower" était la plus grande. Si j'ai tort, il faut alors interchanger "Lower" et "Upper" dans les deux routines "Monter" et "Descendre".

[Edit2] (décidément...) remplacé les "hadjustement" par des "vadjustement" (sinon ça ne sera pas les bons ascenseurs !)

Ulix

Merci Ollivier !

Je regarde ça cette après-midi !

Je vais essayer de mettre en pratique, mais les api GTK (et windows aussi) c'est
pas mon fort !

Pour le :

Citation:

2) "Plan B" (A suivre...)

N'hésite pas, toute les idées sont bonne a prendre !

Merci encore. :lol:

Ollivier

Attends, parce que le plan B, ça sera ce que tu veux, mais ça ne sera pas ton fort non plus, à mon humble avis.

Insistons sur les APIs Linux, il se pourrait que ça ne soit pas du temps perdu.

Considérons l'ignorance comme une coupure nocturne de courant : la première chose à faire c'est de retrouver le moindre éclat de lumière.

Exemple : avec une allumette.

Qu'est-ce que te donne ceci :

Code:

Debug SizeOf( GtkAdjustement)

Une valeur nulle?
Une valeur non nulle? Si oui, laquelle?
Une erreur? Si oui, laquelle?

Ulix

Dans ma callback j'ai mis :

Code:

; Récupérer la structure
GID = GadgetID(#Tree)
gtk_scrollable_get_vadjustment(GID, *Adj)

Debug "======="
Debug SizeOf( GtkAdjustement)
Debug *Adj\Value.I
Debug *Adj\Lower.I
Debug *Adj\Upper.I
Debug *Adj\Step_Increment.I

Le debugeur me retourne :
=======
48
0
0
0
0

Mais je ne suis pas sur de la façon de déclare les fonctions.
J'ai mis en début de prog :

Code:

ImportC "-gtk"
   gtk_scrollable_get_vadjustment(GID.l, *Adj)       ;   <== Si non j'ai message d'erreur
   gtk_scrollable_set_vadjustment(GID.l, *Adj)       ;  J'espéres que c'est bien comme ça !!!
EndImport

Structure GtkAdjustement
Value.I
Lower.I
Upper.I
Step_Increment.I
Page_Increment.I
Page_Size.I
EndStructure

Global *Adj.GtkAdjustement = AllocateMemory(SizeOf(GtkAdjustement) )    ;  En global pour avoir accès depuis la cllback

Es-ce que cela d'aide ?

Merci d'avance !

Ollivier

Je pense que, par principe, il faut commencer à tester sans callback.

Juste :
- une fenêtre
- un tree
- cinquante items pour qu'un ascenseur apparaisse
- une boucle repeat:until wait...() (comme les ex de l'aide)

Quelquechose m'étonne et ta réponse ne m'a pas aidé:

Code:

Debug SizeOf(gtkAdjustement)

Sans rien, même pas la structure définie en en-tête, juste cette ligne, qu'est-ce que ça donne? (valeur? Erreur?)

Ollivier

Par déduction, je pense que cette ligne seule devrait te donner une erreur, puisque tu as testé la déclaration de structure du même nom.

48 ça suppose que tu es en 64 bits. Mais je ne sais pas si la structure telle que "voulue" par les fonctions gtk est en 32 ou en 64 bits. Ce n'est pas bien grave.

J'insiste pour que tu fasses des tests sans callback d'abord.

Ce qui est plus important que la callback, c'est que ton Tree contienne 50 items pour être sûr que l'ascenseur soit présent et affiché.

Si ce test donne "48.0.0.0.0"

Je pense qu'en mettant " gtk2 " en sous-système, et en retestant, tu auras une réponse plus "parlante" (mais pas exacte) que le simple "48; 0; 0; 0; 0".

Ollivier

En passant, je viens de voir ce sujet anglais:
http://www.purebasic.fr/english/viewtopic.php?f=13&t=63714
C'est le 2nd code à tester sur EditorGadget.
Il n'utilise pas la fonction gtk "scrollable". (Je me suis ptêt gamellé sur la mauvaise fonction)

Ulix

Ok Ollivier,

(Je t'avais répondu et donnés le retours du débugeur et du compilo,
mais je vois que le post n'est pas passé ?
Nos posts ont du croisé...)

Je regarde cela, je verrai si je peux en tiré quelque chose, si non ...

(Je trouve que Fred et son équipe ont beaucoup de travail a faire pour comblé
toutes ces lacunes, puisque des solutions existes(Api et Gtk), pourquoi ne pas développé
les fonctions supplémentaire, même s'ils ne sont pas en NATIF ?)
fin de ma réflexion interne, Ho mince !!! vous avez entendu :mrgreen:

A+

Ollivier

T'inquiète chez moi ça marche sans API je poste ça ce soir, mais j'aurais souhaité un retour API Linux...

Ollivier

Code:

 ; En attendant d'avoir le temps, voici un tree qui drag et drop ses items. 
;************************************************************************************************************************************************* 
 
Structure TreeItem
        *ElementAddress
        *Parent
        Index.I
        Text.S
        bExpanded.I
        SubExist.I
        List *Sub.TreeItem()
        ChildBuildingIndex.I
        bForbidden.I
EndStructure

Structure ExpandBox
        Left.I
        Top.I
        Right.I
        Bottom.I
        *Boolean
EndStructure

Structure ItemInfo
        Left.I
        Top.I
        Right.I
        Bottom.I
        *Item
EndStructure

Structure Tree
        *TreeMark
        ChildBuildingIndex.I
        GadgetNum.I
        *Items.TreeItem
        List *ExpandBox.ExpandBox()
        List *ItemInfo.ItemInfo()
        *ItemSource
        *ItemTarget
        ItemTargetParented.I
EndStructure

ExamineDesktops()
w0 = DesktopWidth(0)
h0 = DesktopHeight(0)
d0 = DesktopDepth(0)

b1 = 128

Win1 = OpenWindow(#PB_Any, b1, b1, w0 - (2 * b1), h0 - (2 * b1), "", #PB_Window_SystemMenu | #PB_Window_SizeGadget)

w1 = WindowWidth(Win1)
h1 = WindowHeight(Win1)

Gdt2 = CanvasGadget(#PB_Any, 0, 0, 512, h1, #PB_Canvas_Keyboard)
SetActiveGadget(Gdt2)

Procedure CreateItem(*Parent.TreeItem, Text.S, bExpanded = 0)
        Define *Sub.TreeItem
        If *Parent\SubExist = 0
                InitializeStructure(*Parent, TreeItem)
                *Parent\SubExist = 1
        EndIf
        Temp = AddElement(*Parent\Sub() )
        *Parent\Sub() = AllocateMemory(SizeOf(TreeItem) )
        *Parent\ChildBuildingIndex + 1
        *Sub = *Parent\Sub()
        *Sub\ElementAddress = Temp
        *Sub\Index = *Parent\ChildBuildingIndex
        *Sub\Text = Text
        *Sub\bExpanded = bExpanded
        *Sub\Parent = *Parent
        ProcedureReturn *Sub
EndProcedure

Procedure InsertItem(*Parent.TreeItem, Text.S, bExpanded = 0)
        Define *Sub.TreeItem
        If *Parent\SubExist = 0
                InitializeStructure(*Parent, TreeItem)
                *Parent\SubExist = 1
        EndIf
        Temp = InsertElement(*Parent\Sub() )
        *Parent\Sub() = AllocateMemory(SizeOf(TreeItem) )
        *Parent\ChildBuildingIndex + 1
        *Sub = *Parent\Sub()
        *Sub\ElementAddress = Temp
        *Sub\Index = *Parent\ChildBuildingIndex
        *Sub\Text = Text
        *Sub\bExpanded = bExpanded
        *Sub\Parent = *Parent
        ProcedureReturn *Sub
EndProcedure

Define *Tree0.TreeItem = AllocateMemory(SizeOf(TreeItem) )

Define *Tree.Tree = AllocateMemory(SizeOf(Tree) )
InitializeStructure(*Tree, Tree)
*Tree\GadgetNum = Gdt2
*Tree\Items = *Tree0

For I = 0 To 3
        N + 1
        Define *X0.TreeItem = CreateItem(*Tree0, "Text " + Str(N), 1)
        For J = 0 To 3
                N + 1
                Define *X1.TreeItem = CreateItem(*X0, "Text " + Str(N), 1)
                For K = 0 To 3
                        N + 1
                        CreateItem(*X1, "Text " + Str(N), 0)
                Next
        Next
Next

Global C1 = RGB(0, 0, 0)
Global C0 = RGB(255, 255, 255)
Global ItemX = 0
Global ItemY = 0
Global ItemW
Global ItemH
Global ItemNum = 0
Global ItemCaseW
Global ItemStart = 0
Global Size = 12
Global FaultFont.S = "courier new"
LoadFont(0, FaultFont, Size)
Global DragStart.I
Global WinPhant.I
Global ImgPhant.I
Global GdtPhant.I
Global WinDnD.I
Global ImgDnD.I
Global ImgDnDW.I
Global ImgDnDH.I
Global GdtDnD.I
Global PhantW = 256
Global ScrollBorder = 64
Global Delta
Global ForceEvent

Procedure DrawExpandBox(*X0.TreeItem, *Tree.Tree, X, Y, W, H)
        
        Define *P0.ExpandBox = AllocateMemory(SizeOf(ExpandBox) )
        
        AddElement(*Tree\ExpandBox() )
        
        *Tree\ExpandBox() = *P0
        
        *P0\Left = X
        *P0\Top = Y
        *P0\Right = X + (W - 1)
        *P0\Bottom = Y + (H - 1)
        *P0\Boolean = @*X0\bExpanded
        
        Box(X, Y, W, H, C1)
        Box(X + 2, Y + 2, W - 4, H - 4, C0)
        If (*X0\bExpanded & 1) = 0
                W_2 = W / 2
                H_2 = H / 2
                W_4 = W / 4
                H_4 = H / 4
                Box(X + W_2 - 1, Y + H_4, 2, H_2, C1)
                Box(X + W_4, Y + H_2 - 1, W_2, 2, C1)
        EndIf
EndProcedure

Procedure DrawItem(*X0.TreeItem, *Tree.Tree, X, Y, W, H)
        Define *P0.ItemInfo = AllocateMemory(SizeOf(ItemInfo) )
        AddElement(*Tree\ItemInfo() )
        *Tree\ItemInfo() = *P0
        *P0\Left = X
        *P0\Top = Y
        *P0\Right = X + (W - 1)
        *P0\Bottom = Y + (H - 1)
        *P0\Item = *X0
        DrawText(X, Y, *X0\Text, C1, C0)
EndProcedure

Procedure DisplayItem(*Tree0.TreeItem, *Tree.Tree)
        Define *X0.TreeItem
        ItemX + ItemCaseW
        ForEach(*Tree0\Sub() )
                *X0 = *Tree0\Sub()
                If ItemNum => ItemStart
                        ItemW = TextWidth(*X0\Text)
                        ItemH = TextHeight("A")
                        Box(0, ItemY, OutputWidth(), ItemH, C0)
                        If *X0\SubExist
                                DrawExpandBox(*X0, *Tree, ItemX - ItemH + 2, ItemY + 2, ItemH - 4, ItemH - 4)
                        EndIf
                        DrawItem(*X0, *Tree, ItemX, ItemY, ItemW, ItemH)
                        ItemY + ItemH
                EndIf
                ItemNum + 1
                If *X0\SubExist
                        If *X0\bExpanded
                                DisplayItem(*X0, *Tree)
                        EndIf
                EndIf
        Next
        ItemX - ItemCaseW
EndProcedure

Procedure DisplayItems(*Tree.Tree)
        Define *Tree0.TreeItem = *Tree\Items
        If StartDrawing(CanvasOutput(*Tree\GadgetNum) )
                DrawingFont(FontID(0) )
                ItemX = 0
                ItemY = 0
                ItemNum = 0
                ItemCaseW = TextHeight("A")
                
                ForEach(*Tree\ExpandBox() )
                        FreeMemory(*Tree\ExpandBox() )
                Next
                ClearList(*Tree\ExpandBox() )
                
                ForEach(*Tree\ItemInfo() )
                        FreeMemory(*Tree\ItemInfo() )
                Next
                ClearList(*Tree\ItemInfo() )
                
                DisplayItem(*Tree0, *Tree)
                If ItemY < OutputHeight()
                        Box(0, ItemY, OutputWidth(), OutputHeight() - ItemY, C0)
                EndIf
                StopDrawing()
        EndIf
EndProcedure

Procedure CheckExpandBox(*Tree.Tree, MouseX, MouseY)
        Define *P0.ExpandBox
        Define *P1.INTEGER
        ForEach(*Tree\ExpandBox() )
                *P0 = *Tree\ExpandBox()
                If MouseX => *P0\Left
                        If MouseX <= *P0\Right
                                If MouseY => *P0\Top
                                        If MouseY <= *P0\Bottom
                                                *P1 = *P0\Boolean
                                                *P1\I ! 1
                                                DisplayItems(*Tree)
                                                ProcedureReturn 1
                                        EndIf
                                EndIf
                        EndIf
                EndIf
        Next
EndProcedure

Procedure CheckItem(*Tree.Tree, MouseX, MouseY)
        Define *P0.ItemInfo
        Define *X0.TreeItem
        ForEach(*Tree\ItemInfo() )
                *P0 = *Tree\ItemInfo()
                If (MouseX => *P0\Left) Or DragStart
                        If (MouseX <= *P0\Right) Or DragStart
                                If MouseY => *P0\Top
                                        If MouseY <= *P0\Bottom
                                                If DragStart = 0
                                                        *X0 = *P0\Item
                                                        *Tree\Itemsource = *X0
                                                        DragStart = 1
                                                        SetGadgetAttribute(*Tree\GadgetNum, #PB_Canvas_Clip, 1)
                                                        PhantW = GadgetWidth(*Tree\GadgetNum) - (*P0\Right - *P0\Left)
                                                        WinPhant = OpenWindow(#PB_Any, 0, 0, PhantW, 1, "", #PB_Window_BorderLess | #PB_Window_NoActivate)
                                                        ImgPhant = CreateImage(#PB_Any, PhantW, 4, 32, RGB(0, 0, 255) )
                                                        StartDrawing(ImageOutput(ImgPhant) )
                                                                DrawingFont(FontID(0) )
                                                                ImgDnDW = TextWidth(*X0\Text)
                                                                ImgDnDH = TextHeight(*X0\Text)
                                                        StopDrawing()
                                                        GdtPhant = ImageGadget(#PB_Any, 0, 0, PhantW, 4, ImageID(ImgPhant) )
                                                        
                                                        WinDnD = OpenWindow(#PB_Any, 0, 0, ImgDnDW, ImgDnDH, "", #PB_Window_BorderLess | #PB_Window_NoActivate)
                                                        ImgDnD = CreateImage(#PB_Any, ImgDnDW, ImgDnDH, 32, C0)
                                                        StartDrawing(ImageOutput(ImgDnD) )
                                                                DrawingFont(FontID(0) )
                                                                DrawText(0, 0, *X0\Text, C1, C0)
                                                        StopDrawing()
                                                        GdtDnD = ImageGadget(#PB_Any, 0, 0, 128, 4, ImageID(ImgDnD) )
                                                Else
                                                        *X0 = *P0\Item
                                                        If *X0\SubExist
                                                                H1_2 = (Abs(*P0\Top - *P0\Bottom) / 2.0) + 1
                                                        Else
                                                                H1_3 = (Abs(*P0\Top - *P0\Bottom) / 3.0) + 1
                                                                Choice = Int((MouseY - *P0\Top) / H1_3)
                                                                If Choice = 2
                                                                        Define *Parent.TreeItem
                                                                        *Parent = *X0\Parent
                                                                        If *X0\Index < ListSize(*Parent\Sub() )
                                                                                Choice = 1
                                                                        EndIf
                                                                EndIf
                                                        EndIf
                                                        GdtScrX = GadgetX(*Tree\GadgetNum, #PB_Gadget_ScreenCoordinate)
                                                        GdtScrY = GadgetY(*Tree\GadgetNum, #PB_Gadget_ScreenCoordinate)
                                                        X = GdtScrX + *P0\Left
                                                        If Choice = 1
                                                                X = GdtScrX + *P0\Right
                                                                Y = (GdtScrY + *P0\Top) + ((*P0\Bottom - *P0\Top) / 2)
                                                        EndIf
                                                        *Tree\ItemTargetParented = Choice
                                                        ResizeWindow(WinPhant, X, Y, GdtScrX + PhantW - X, #PB_Ignore)
                                                        ResizeWindow(WinDnD, GdtScrX + PhantW, GdtScrY + MouseY - (ImgDnDH / 2), #PB_Ignore, #PB_Ignore)
                                                        
                                                EndIf
                                                ProcedureReturn *X0
                                        EndIf
                                EndIf
                        EndIf
                EndIf
        Next
EndProcedure

Procedure TreeCopyItem(*Tree.Tree, Parented, *SourceOption = 0, *TargetOption = 0)
        Define *Parent.TreeItem
        Define *Source.TreeItem
        Define *Source2.TreeItem
        Define *InitialTarget.TreeItem
        Define *Target.TreeItem
        Define *New.TreeItem
        Define *New2.TreeItem
        Define bForbidden
        If *SourceOption = 0
                *Source = *Tree\ItemSource
                bForbidden = 1
        Else
                *Source = *SourceOption
                bForbidden = 0
                
        EndIf
        If *TargetOption = 0
                *Target = *Tree\ItemTarget
        Else
                *Target = *TargetOption
        EndIf
        If Parented = 1
                *Target\bForbidden | bForbidden
                *New = CreateItem(*Target, *Source\Text, *Source\bExpanded)
                If *Source\SubExist And (Not *Source\bForbidden)
                        ForEach(*Source\Sub() )
                                TreeCopyItem(*Tree, 1, *Source\Sub(), *New)
                        Next
                EndIf
                *Target\bForbidden & (~1)
        EndIf
EndProcedure

;- Principe

DisplayItems(*Tree)

Repeat
        Ev = WaitWindowEvent()
        If Ev = #PB_Event_Gadget
                Evt = EventType()
                MouseX = GetGadgetAttribute(Gdt2, #PB_Canvas_MouseX)
                MouseY = GetGadgetAttribute(Gdt2, #PB_Canvas_MouseY)
                If Evt = #PB_EventType_LeftButtonDown
                        If CheckExpandBox(*Tree, MouseX, MouseY) = 0
                                CheckItem(*Tree, MouseX, MouseY)
                        EndIf
                EndIf
                If DragStart
                        If (GetGadgetAttribute(Gdt2, #PB_Canvas_Buttons) = #PB_Canvas_LeftButton)
                                Result = CheckItem(*Tree, MouseX, MouseY)
                                If Result
                                        *Tree\ItemTarget = Result
                                EndIf
                        Else
                                FreeGadget(GdtPhant)
                                FreeImage(ImgPhant)
                                CloseWindow(WinPhant)
                                FreeGadget(GdtDnD)
                                FreeImage(ImgDnD)
                                CloseWindow(WinDnD)
                                DragStart = 0
                                SetGadgetAttribute(*Tree\GadgetNum, #PB_Canvas_Clip, 0)
                                TreeCopyItem(*Tree, *Tree\ItemTargetParented)  
                                DisplayItems(*Tree)
                        EndIf
                EndIf
                Control = Bool(GetGadgetAttribute(Gdt2, #PB_Canvas_Modifiers) = #PB_Canvas_Shift)
                Delta = GetGadgetAttribute(Gdt2, #PB_Canvas_WheelDelta)
                ForceEvent = 0
                        If DragStart                                
                                If MouseY < ScrollBorder
                                        Delta = 1                                        
                                EndIf        
                                If MouseY > (GadgetHeight(Gdt2) - ScrollBorder)
                                        Delta = -1
                                EndIf        
                        EndIf
                If Delta
                        If Control
                                Size + Delta
                                If Size < 12
                                        Size = 12
                                EndIf
                                FreeFont(0)
                                LoadFont(0, FaultFont, Size)
                        Else   
                                ItemStart - Delta
                                If ItemStart < 0
                                        ItemStart = 0
                                EndIf
                        EndIf
                        DisplayItems(*Tree)
                EndIf
        EndIf
Until Ev = #PB_Event_CloseWindow

PureBasic

DragNDrop sur TreeGadget

Qui est en ligne