PureBasic

Est-ce que quelqu'un aurait une procédure pour trier les élément d'un TreeGadget() comme dans l'explorateur de WinDaube, c'est à dire les dossiers en haut, et les fichiers en dessous?

J'ai essayé de voir avec le SDK de Microsoft, mais j'arrive à rien.

Code : Tout sélectionner

#ImgFile = 1
#ImgFold = 2

Global Tree_0

Fnt=LoadFont(0, "system",11)
hIcone = 16 : wIcone = 32

;{- Images du TreeGadget
If CreateImage(#ImgFile, wIcone, hIcone)
  StartDrawing(ImageOutput(#ImgFile))
  DrawingFont(Fnt)
  Box(0, 0, wIcone, hIcone, $FFFFFF)
  DrawText(3,0,"File", $0000FF)
  StopDrawing()
EndIf

If CreateImage(#ImgFold, wIcone, hIcone)
  StartDrawing(ImageOutput(#ImgFold))
  DrawingFont(Fnt)
  Box(0, 0, wIcone, hIcone, $FFFFFF)
  DrawText(3,0,"Fold", $FF0000)
  StopDrawing()
EndIf
;}-

;-Procédures
Procedure ListeFichiers(NumDir.l, NameDir.s, Ext.s)
  File.s : NameDir = Trim(NameDir)
  
  ; Vérification de la chaine
  If Right(NameDir,1) = "." : NameDir = Left(NameDir, Len(NameDir)-1) : EndIf
  If Right(NameDir,1)<> "\" : NameDir+"\":EndIf
  
  ; Vérification de l'extension
  If Right(Ext, 1) = "*" Or Ext = ""
    NoExt = #True
  Else
    If FindString(Ext, ".", 1)
      Ext = GetExtensionPart(Ext) : NoExt = #False
    Else
      Ext = Ext : NoExt = #False
    EndIf
  EndIf
  
  If ExamineDirectory(NumDir, NameDir, "*.*")
    While NextDirectoryEntry(NumDir)
      File = DirectoryEntryName(NumDir)
      
      Select DirectoryEntryType(NumDir)
        Case #PB_DirectoryEntry_File
          
          Select NoExt
            Case #True
              ; ********** Avec extension *********
              AddGadgetItem(Tree_0, -1, File, ImageID(#ImgFile), NumDir)
              ; ***********************************
              
            Case #False
              ;*********** Sans Extension *********
              If GetExtensionPart(File) = Ext
                AddGadgetItem(Tree_0, -1, File, ImageID(#ImgFile), NumDir)
                
              EndIf
              ; ***********************************
          EndSelect
          
        Case #PB_DirectoryEntry_Directory
          If DirectoryEntryName(NumDir) <> "." And DirectoryEntryName(NumDir) <> ".."
            ; ***********************************
            AddGadgetItem(Tree_0, -1, DirectoryEntryName(NumDir), ImageID(#ImgFold), NumDir)
            ; ***********************************
            
            ListeFichiers(NumDir +1, NameDir + File, Ext)
          EndIf
          
      EndSelect
    Wend
    
    FinishDirectory(NumDir)
  EndIf
EndProcedure

 
If OpenWindow(0, 5, 5, 400, 543, "Tree",  #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
  If CreateGadgetList(WindowID(0))
    Tree_0 = TreeGadget(#PB_Any, 5, 5, 390, 535)
  EndIf
EndIf

Chem$ = "D:\PureBasic4\"
ListeFichiers(0, Chem$, "*.*")

Repeat
  Event  = WaitWindowEvent()
Until Event = #PB_Event_CloseWindow
End

Bon, j'ai trouvé une astuce en passant par deux listes chainées.
Je passe tout ce qui vient de la procédure qui liste les fichiers dans la première liste, et je fais le tri en passant les éléments de la première à la deuxième.
Ca marche à peu près, sauf que l'affichage dans le TreeGadget() est inversé. Les fichiers sont au dessus, et les dossiers en dessous.
Sinon, la hiérachie est respecté, et c'est déjà pas mal.
L'inconvénient dans tout ça, c'est qu'en plus du fait que les éléments soient inversés, le tri prends un peu de temps.

J'ai viré ce code qui, en fait, ne fonctionne pas correctement.

Les résultats au début de la liste sont corrects, mais vers la fin, c'est n'importe quoi.

Salut Chris,

voici la version avec le tri Windows, c'est encore long si on a beaucoup d'éléments. J'espère que la manière de faire est la bonne

C'est le même principe que le tri d'une listicon, dans la Procedure de tri j'ai fait des essais de comparaison de chaine avec le signe > et j'ai utilisé la fonction CompareMemoryString() que j'ai gardé mais pas vraiment vu de différence de temps.

J'ai utilisé SetGadgetItemData pour pourvoir déterminer rapidement le type de l'élément dans la procedure de tri.

Le message #WM_SETREDRAW permet de bloquer l'affiche qui prend beaucoup de temps, car sinon on sera encore à attendre devant l'écran demain

Sur mon disque C complet, ça prend pas mal de temps (plus de 144000 éléments à trier)

Code : Tout sélectionner

#ImgFile = 1
#ImgFold = 2

Structure TVSORTCB
   hParent.l
   lpfnCompare.l
   lParam.l
EndStructure
Global Tree_0, Dossier.s

Fnt = LoadFont(0, "system", 11)
hIcone = 16 : wIcone = 32


Procedure Tri(lParam1.l, lParam2.l, lParamSort.l)
   
   Dossier1 = GetGadgetItemData(Tree_0, lParam1)
   
   Dossier2 = GetGadgetItemData(Tree_0, lParam2)
   
   ; Debug Dossier1
   ; Voici ce que dit la doc MS
   
   ; La procédure doit retourner une valeur négative si le 1er élément doit être affiché
   ; avant le second. Si l'élément 1 doit être affiché après le 2, la procédure doit
   ; retourner une valeur positive, si les 2 éléments sont identiques, la procédure
   ; doit retourner 0.
   
   ; 4 cas possibles
   
   ; Cas 1
   ; ;------
   ; les 2 éléments sont des dossiers, on compare les chaînes.
   ; Si l'élément 1 doit être affiché avant le 2, on retourne une valeur négative (-1)
   ; Si l'élément 2 doit être affiché avant le 1, on retourne une valeur positive (1)
   ; Si les 2 chaines sont identiques, on retourne 0
   
   ; Cas 2
   ; ;------
   ; les 2 éléments sont des fichiers, on compare les chaînes
   
   ; Cas 3
   ; ;------
   ; l'élément 1 est un dosssier et pas le 2ème
   ; On retourne -1 car l'élément 1 doit être positionné avant l'élément 2
   
   ; Cas 4
   ; ;------
   ; l'élément 2 est un dosssier et pas le 1er
   ; On retourne 1 car l'élément 2 doit être positionné avant l'élément
   
   Select Dossier1
      Case #PB_DirectoryEntry_Directory ; Dossier1 est un dossier
         Select Dossier2
            Case #PB_DirectoryEntry_Directory ; Dossier2 est un dossier
               ; Cas 1
               Chaine1.s = GetGadgetItemText(Tree_0, lParam1, 0)
               Chaine2.s = GetGadgetItemText(Tree_0, lParam2, 0)
               ProcedureReturn CompareMemoryString( @Chaine1, @Chaine2, 1)
               
            Default ; Dossier2 est un fichier
               ; Cas 3
               ProcedureReturn - 1
         EndSelect
         
         
      Default ; Dossier1 est un fichier
         Select Dossier2
            Case #PB_DirectoryEntry_Directory ; Dossier2 est un dossier
               ; Cas 4
               ProcedureReturn 1
               
            Default ; Dossier2 est un fichier
               ; Cas 2
               Chaine1.s = GetGadgetItemText(Tree_0, lParam1, 0)
               Chaine2.s = GetGadgetItemText(Tree_0, lParam2, 0)
               ProcedureReturn CompareMemoryString( @Chaine1, @Chaine2, 1)
               
         EndSelect
   EndSelect
EndProcedure


;{- Images du TreeGadget
If CreateImage(#ImgFile, wIcone, hIcone)
   StartDrawing(ImageOutput(#ImgFile))
      DrawingFont(Fnt)
      Box(0, 0, wIcone, hIcone, $FFFFFF)
      DrawText(3, 0, "File", $0000FF)
   StopDrawing()
EndIf

If CreateImage(#ImgFold, wIcone, hIcone)
   StartDrawing(ImageOutput(#ImgFold))
      DrawingFont(Fnt)
      Box(0, 0, wIcone, hIcone, $FFFFFF)
      DrawText(3, 0, "Fold", $FF0000)
   StopDrawing()
EndIf
;} -


;- Procédures
Procedure ListeFichiers(NumDir.l, NameDir.s, Ext.s)
   Protected File.s, var.TVSORTCB, itemID.l
   
   NameDir = Trim(NameDir)
   
   With var
      \lpfnCompare = @Tri()
      \lParam = 0 ; paramètre non utilisé pour l'exemple
   EndWith
   
   
   ; Vérification de la chaine
   If Right(NameDir, 1) = "." : NameDir = Left(NameDir, Len(NameDir) - 1) : EndIf
   If Right(NameDir, 1) <> "\" : NameDir + "\" : EndIf
   
   ; Vérification de l'extension
   If Right(Ext, 1) = "*" Or Ext = ""
      NoExt = #True
   Else
      If FindString(Ext, ".", 1)
         Ext = GetExtensionPart(Ext) : NoExt = #False
      Else
         Ext = Ext : NoExt = #False
      EndIf
   EndIf
   
   If ExamineDirectory(NumDir, NameDir, "*.*")
      While NextDirectoryEntry(NumDir)
         File = DirectoryEntryName(NumDir)
         Select DirectoryEntryType(NumDir)
            Case #PB_DirectoryEntry_File
               
               Select NoExt
                  Case #True
                     ; ********** Avec extension *********
                     itemID = AddGadgetItem(Tree_0, -1, File, ImageID(#ImgFile), NumDir)
                     SetGadgetItemData(Tree_0, CountGadgetItems(Tree_0) - 1, #PB_DirectoryEntry_File)
                     ; ***********************************
                     
                  Case #False
                     ; *********** Sans Extension *********
                     If GetExtensionPart(File) = Ext
                        itemID = AddGadgetItem(Tree_0, -1, File, ImageID(#ImgFile), NumDir)
                        SetGadgetItemData(Tree_0, CountGadgetItems(Tree_0) - 1, #PB_DirectoryEntry_File)
                     EndIf
                     ; ***********************************
               EndSelect
               
               
            Case #PB_DirectoryEntry_Directory
               If DirectoryEntryName(NumDir) <> "." And DirectoryEntryName(NumDir) <> ".."
                  ; ***********************************
                  itemID = AddGadgetItem(Tree_0, -1, DirectoryEntryName(NumDir), ImageID(#ImgFold), NumDir)
                  ; ***********************************
                  SetGadgetItemData(Tree_0, CountGadgetItems(Tree_0) - 1, #PB_DirectoryEntry_Directory)
                  ListeFichiers(NumDir + 1, NameDir + File, Ext)
               EndIf
               
         EndSelect
         
         ; on attribue l'identifiant système de l'élément et on appelle la procedure de tri
         ; avec le sendmessage, c'est le système qui va comparer les éléments nécessaires
         ; pour obtenir le tri
         With var
            \hParent = itemID
         EndWith
         SendMessage_(GadgetID(Tree_0), #TVM_SORTCHILDRENCB, 0, @var)
         
      Wend
      
      FinishDirectory(NumDir)
   EndIf
EndProcedure


If OpenWindow(0, 5, 5, 400, 543, "Tree", #PB_Window_SystemMenu | #PB_Window_SizeGadget | #PB_Window_TitleBar )
   If CreateGadgetList(WindowID(0))
      Tree_0 = TreeGadget(#PB_Any, 5, 5, 390, 535)
      UpdateWindow_(GadgetID(Tree_0))
   EndIf
   
   
   Chem$ = "D:\PureBasic4"
   
   SendMessage_(GadgetID(Tree_0), #WM_SETREDRAW, #False, 0)
   ListeFichiers(0, Chem$, "*.*")
   SendMessage_(GadgetID(Tree_0), #WM_SETREDRAW, #True, 0)
   
   
   Repeat
      Event = WaitWindowEvent()
   Until Event = #PB_Event_CloseWindow
EndIf
End

A priori, ça marche nickel.

Je vais étudier un peu ce code. merci Denis.

PureBasic

Tri d'un TreeGadget()

Tri d'un TreeGadget()