Ma contribution pour Windows.
Fonctionne en x86 - x64 unicode ou non.
J'ai détourné le code posté par Falsam qui à l'origine vient de sverson.
J'ai uniquement affiché l'explorertreegadget dans un splitter pour avoir les barres de défilement qui disparaissent lorsque l'on ajoute les checkbox à l'explorer.
J'ai donné le "look" explorer au treegadget (theme).
J'ai fait en sorte que lorsque l'on clique sur un noeud, la sélection ne change pas d'élément (pas la checkbox, la sélection).
J'ai détourné un code du soldat pour retrouver simplement et uniquement les lettres des lecteurs.
2 options gadgets :
Dossier complet : dans ce mode je ne conserve que la racine qui est sélectionnée, par exemple si j'ai coché
C:\essai\ et C:\essai\denis\ je ne vais ajouter dans la liste que C:\essai \ car C:\essai\denis\ est un sous-élément et sera donc considéré comme faisant partie de la liste. Cela permet des énumérations complètes (récursives ou autres).
l'autre mode Dossier sans sous-dossier ne considère pas les sous-dossiers et liste tout ce qui est sélectionné, à vous de faire comme bon vous semble.
Je suis preneur de simplification sur les 2 modes mais je ne suis pas intéressé par les expressions régulières (les arbres binaires m'iraient bien).
J'ai peut-être fait des erreurs mais bon c'est cadeau
Encore un truc bizarre, la font n'a pas de nom et une taille de 0 mais c'est affiché en gros
Dommage que ce gadget manque de plein de commandes et ne permet pas facilement d'intercepter les événements (rien dans la doc à ce sujet)
Code : Tout sélectionner
Define .i
EnableExplicit
Global NewList MultiPathPathRequesterAdvancedFolderList.s()
#Fenetre = 0
#ExplorerMultiPathRequester = 0
#SplitterGadget = 2
#Bouton_invisible = 3
Procedure.i GetDrive(List MultiDrivePathRequester.s())
;// http://www.purebasic.fr/french/viewtopic.php?f=4&t=12902&hilit=lecteurs
;// Auteur : Le Soldat Inconnu
;// Version de PB : 4.6
;// Explication du programme :
;// Récupérer la lettre et le type (disquette, disque dur, etc...) de tous les lecteurs présents sur l'ordinateur.
;// Modifié par Denis, retourne uniquement les lettres des lecteurs présents
;// PB 5.11 X86 et x64
;// retourne le nombre de lecteurs listés, sinon retourne -1 en cas d'erreur
;// la liste chainée contient la liste des lecteurs format 'C:\' par exemple
Protected DriveString_Length, DriveString.s, CharSize
Protected i, j
;// Vide la liste
ClearList(MultiDrivePathRequester())
;// Taille des caractères en byte
CharSize = StringByteLength(" ")
;// Récupère la liste des lecteurs
DriveString_Length = GetLogicalDriveStrings_(0, 0)
If DriveString_Length = 0
ProcedureReturn -1
EndIf
DriveString = Space(DriveString_Length)
DriveString_Length * CharSize
If GetLogicalDriveStrings_(DriveString_Length, @DriveString) = 0
ProcedureReturn -1
EndIf
DriveString_Length -1
j= -1
For i = 0 To DriveString_Length Step SizeOf(Character)
If PeekC(@DriveString + i) = 0
PokeC(@DriveString + i, ',')
j+1
EndIf
Next
For i = 1 To j
If AddElement(MultiDrivePathRequester()) = 0
ClearList(MultiDrivePathRequester())
ProcedureReturn -1
EndIf
MultiDrivePathRequester() = StringField(DriveString, i, Chr(','))
Next
ProcedureReturn ListSize(MultiDrivePathRequester())
EndProcedure
Procedure.i CustomTreeCallback(hwnd, Msg, WParam, LParam)
;// English forum: http://www.purebasic.fr/english/viewtopic.php?p=158360
;// Author: sverson
;// Date: 21. August 2006
;// OS: Windows
;// Demo: Yes
;// Use ExplorerListGadget Checkboxes to select directories
;// and display the result in a ListIconGadget
;// Thanks to srod, breeze4me AND freak!
;// See also remi_meier's "Simple Wrapper For TreeGadget-Macros by MSDN"
;// http://www.purebasic.fr/english/viewtopic.php?p=104420
;// Modifié par Denis
;// PB 5.11 X86 et x64
;// élément pour retrouver l'élément clicqué
Protected HitTest.TV_HITTESTINFO
;// adresse de la procedure callback d'origine
Protected oldproc
;// chaine identifiant Prop
Protected Prop.s= "PIM_ExplorerMultiPathRequester_" + Str(hwnd)
;// mémorise si le chemin est dans la liste
Protected AddPath2List
oldproc = GetProp_(hwnd, Prop)
Select Msg
Case #WM_NCDESTROY
RemoveProp_(hwnd, Prop)
Case #WM_LBUTTONDOWN, #WM_LBUTTONDBLCLK
HitTest\pt\x = LParam & $FFFF
HitTest\pt\y = (LParam >> 16) & $FFFF
If SendMessage_(hwnd, #TVM_HITTEST, 0, HitTest)
If HitTest\flags = #TVHT_ONITEMSTATEICON
;// Force la sélection de l'élément de l'explorertree
If SendMessage_(GadgetID(#ExplorerMultiPathRequester),#TVM_SELECTITEM, #TVGN_CARET, HitTest\hItem)
Select ((SendMessage_(GadgetID(#ExplorerMultiPathRequester), #TV_FIRST + 39, HitTest\hItem, #TVIS_STATEIMAGEMASK)>>12) - 1)
Case 0 ;// checkbox sélectionnée
AddPath2List = #True
ForEach(MultiPathPathRequesterAdvancedFolderList())
If GetGadgetText(#ExplorerMultiPathRequester) = MultiPathPathRequesterAdvancedFolderList()
AddPath2List = #False
Break
EndIf
Next
If AddPath2List = #True
;// le chemin n'existe pas dans la liste, on ajoute
If AddElement(MultiPathPathRequesterAdvancedFolderList())
MultiPathPathRequesterAdvancedFolderList() = GetGadgetText(#ExplorerMultiPathRequester)
EndIf
EndIf
Default ;// checkbox non sélectionnée
;// supprime l'élément de la liste s'il existe dans la liste
ForEach(MultiPathPathRequesterAdvancedFolderList())
If GetGadgetText(#ExplorerMultiPathRequester) = MultiPathPathRequesterAdvancedFolderList()
;// le chemin existe dans la liste, la liste est positionnée sur l'élément à supprimer
DeleteElement(MultiPathPathRequesterAdvancedFolderList())
Break
EndIf
Next
EndSelect
EndIf
EndIf
EndIf
EndSelect
ProcedureReturn CallWindowProc_(oldproc, hwnd, Msg, WParam, LParam)
EndProcedure
Procedure MultiPathRequester(Title.s, InitialPath.s)
Protected Text_FolderPath, Text_SelectedFiles, Bouton_OK, Bouton_Annuler, Option_DossierComplet, Option_DossierUniquement
Protected font, OriginProc, Position, i, Root$ = ""
;// mémorise si le chemin est dans la liste
Protected AddRoot2List
Protected NewList MultiRootPathPathRequester.s()
font = LoadFont(#PB_Any, "", 0)
If OpenWindow(#Fenetre, 0, 0, 636, 479,Title, #PB_Window_SystemMenu |#PB_Window_TitleBar|#PB_Window_ScreenCentered)
ExplorerTreeGadget(#ExplorerMultiPathRequester, 0, 0, WindowWidth(#Fenetre)-20, 386, InitialPath, #PB_Explorer_NoDriveRequester|#PB_Explorer_AutoSort|#PB_Explorer_NoFiles|#PB_Explorer_AlwaysShowSelection|#PB_Explorer_NoMyDocuments)
ButtonGadget(#Bouton_invisible,0,0,0,0,"")
#style = #TVS_HASBUTTONS |#TVS_HASLINES | #TVS_CHECKBOXES | #TVS_SHOWSELALWAYS |#WS_VISIBLE | #WS_CHILDWINDOW | #WS_CHILD| #WS_VSCROLL
SetWindowLongPtr_(GadgetID(#ExplorerMultiPathRequester),#GWL_STYLE, #style)
SplitterGadget(#SplitterGadget,10,35, WindowWidth(#Fenetre)-20,386, #ExplorerMultiPathRequester, #Bouton_invisible, #PB_Splitter_Vertical|#PB_Splitter_FirstFixed)
SetGadgetAttribute(#SplitterGadget, #PB_Splitter_FirstMinimumSize, GadgetWidth(#SplitterGadget))
SetGadgetState(#SplitterGadget, WindowWidth(#Fenetre)-20)
Text_FolderPath=TextGadget(#PB_Any, 12, 15, 162, 20, "Dossiers")
Text_SelectedFiles=TextGadget(#PB_Any, 223, 17, 177, 20, "")
Bouton_OK = ButtonGadget(#PB_Any, 470, 440, 70, 30, "OK")
Bouton_Annuler = ButtonGadget(#PB_Any, 555, 440, 70, 30, "Annuler")
Option_DossierComplet = OptionGadget(#PB_Any, 10, 440, 150, 30, "Dossier Complet")
Option_DossierUniquement = OptionGadget(#PB_Any, 200, 440, 250, 30, "Dossier sans sous-dossier")
If IsGadget(#ExplorerMultiPathRequester) And IsGadget(#Bouton_invisible) And Text_FolderPath And Text_SelectedFiles And
IsFont(font) And Bouton_OK And Bouton_Annuler And Option_DossierComplet And Option_DossierUniquement
HideGadget(#Bouton_invisible,1)
SetGadgetFont(#ExplorerMultiPathRequester, FontID(font))
OriginProc = SetWindowLongPtr_(GadgetID(#ExplorerMultiPathRequester), #GWL_WNDPROC, @CustomTreeCallback())
SetProp_(GadgetID(#ExplorerMultiPathRequester), "PIM_ExplorerMultiPathRequester_"+Str(GadgetID(#ExplorerMultiPathRequester)), OriginProc)
SetWindowTheme_(GadgetID(#ExplorerMultiPathRequester), @"explorer", #Null)
SetGadgetFont(Text_FolderPath, FontID(font))
SetGadgetFont(Text_SelectedFiles, FontID(font))
SetGadgetFont(Bouton_OK, FontID(font))
SetGadgetFont(Bouton_Annuler, FontID(font))
SetGadgetFont(Option_DossierComplet, FontID(font))
SetGadgetFont(Option_DossierUniquement, FontID(font))
SetGadgetState(Option_DossierComplet, 1)
SetActiveGadget(#ExplorerMultiPathRequester)
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
Case Bouton_OK
ClearDebugOutput()
ClearList(MultiRootPathPathRequester())
SortList(MultiPathPathRequesterAdvancedFolderList(), #PB_Sort_Ascending|#PB_Sort_NoCase)
;// affichage du résultat
Select GetGadgetState(Option_DossierUniquement)
Case 1 ;// dossier sans sous-dossier
;// affichage des dossiers sans sous-dossier à afficher
ForEach MultiPathPathRequesterAdvancedFolderList()
If Len(MultiPathPathRequesterAdvancedFolderList())
Debug MultiPathPathRequesterAdvancedFolderList()
Else
MessageRequester("Erreur", "Pas de sélection dans ce mode (dossier sans sous-dossier)", 16)
EndIf
Next
Default ;// dossier et sous-dossier
;// création d'une liste avec les dossiers racine pour énumération
i = 0
ForEach MultiPathPathRequesterAdvancedFolderList()
SelectElement(MultiPathPathRequesterAdvancedFolderList(), i)
Root$ = MultiPathPathRequesterAdvancedFolderList()
AddRoot2List = #True
If ListSize(MultiRootPathPathRequester())
ForEach MultiRootPathPathRequester()
If Len(MultiRootPathPathRequester()) > Len(Root$)
If Left(MultiRootPathPathRequester(), Len(Root$)) = Root$
AddRoot2List = #False
Break
EndIf
ElseIf Len(MultiRootPathPathRequester()) < Len(Root$)
If Left(Root$, Len(MultiRootPathPathRequester())) = MultiRootPathPathRequester()
AddRoot2List = #False
Break
EndIf
Else
If MultiRootPathPathRequester() = Root$
AddRoot2List = #False
Break
EndIf
EndIf
Next
EndIf
If AddRoot2List
If AddElement(MultiRootPathPathRequester())
MultiRootPathPathRequester() = Root$
EndIf
EndIf
i+1
Next
;// affichage des racines à utiliser
SortList(MultiRootPathPathRequester(), #PB_Sort_Ascending|#PB_Sort_NoCase)
If ListSize(MultiRootPathPathRequester()) = 1 And Len(MultiRootPathPathRequester()) = 0
If GetDrive(MultiRootPathPathRequester()) = -1
MessageRequester("Erreur", "Impossible de lister les lecteurs", 16)
Else
ForEach MultiRootPathPathRequester()
Debug MultiRootPathPathRequester()
Next
EndIf
Else
ForEach MultiRootPathPathRequester()
Debug MultiRootPathPathRequester()
Next
EndIf
EndSelect
Case Bouton_Annuler
PostEvent(#PB_Event_CloseWindow, #Fenetre, 0)
EndSelect
Case #PB_Event_CloseWindow
CloseWindow(#Fenetre)
FreeFont(font)
Break
EndSelect
ForEver
EndIf
EndIf
EndProcedure
;// appel de la fonction
MultiPathRequester("MultiPath Requester", "")
End
