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
