Essais sur l' "ExplorerTreeGadget"

Sujets variés concernant le développement en PureBasic
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Essais sur l' "ExplorerTreeGadget"

Message par Chris »

Salut :)

Je viens de faire quelques tests sur l'ExplorerTreeGadget, parce que trois fonctions, ça me parait un peu... juste. :lol:

Alors voilà, j'arrive, grace à l'Api, et à SendMessage(), à retrouver pas mal de trucs, mais par contre, je n'arrive pas à récupérer l'index d'un élément sélectionné. (Je parle de l'index, pas du handle... 1,2,3,etc..)

J'ai eu beau regarder dans le SDK, rien à faire, je n'ai rien trouvé, et je me vois mal re-parcourir la totalité de l'arborescence à chaque clic, en incrémentant une variable. Dans le cas d'un gros disque, bien chargé, imaginez le temps que ça doit prendre. :roll:

Alors si quelqu'un à une idée lumineuse, (ou bien sait quelle fonction de l'Api je dois employer), je vous met le code en dessous.

Code : Tout sélectionner

;- Window Constants
Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
Enumeration
  #Btn_Exit
  #ExplorerTree_3
EndEnumeration
#TVS_CHECKBOXES = $0100

Global hTree.l

Procedure Open_Window_0()
  If OpenWindow(#Window_0, 388, 120, 450, 260,  #PB_Window_SystemMenu |#PB_Window_ScreenCentered| #PB_Window_TitleBar , "Test sur ''ExplorerTreeGadget''")
    HndWin = WindowID(#Window_0)
    If CreateGadgetList(WindowID())
      ButtonGadget(#Btn_Exit, 10, 235, 100, 20, "Quitter", #PB_Button_Default)
      hTree = ExplorerTreeGadget(#ExplorerTree_3, 0, 0, 225, 205, "", #PB_Explorer_AlwaysShowSelection | #PB_Explorer_NoDriveRequester | #PB_Explorer_NoFiles)
      TextGadget(100,235,10,200,25,"Racine = ")
      TextGadget(101,235,35,200,25,"Courant = ")
      TextGadget(102,235,60,200,25,"Suivant = ")
      TextGadget(103,235,85,200,25,"Précédent = ")
      TextGadget(104,235,110,200,25,"Enfant = ")
      TextGadget(105,235,135,200,25,"Parent = ")
      TextGadget(106,235,160,200,25,"Check = ")
      TextGadget(107,235,185,200,25,"Texte = ") 
      TextGadget(108,235,210,200,25,"Enfants = ")
    EndIf
    ;- Ajout de CheckBox à l' ExplorerTreeGadget
    OldStyle = GetWindowLong_(GadgetID(#ExplorerTree_3),#GWL_STYLE)
    NewStyle = OldStyle | #TVS_CHECKBOXES
    SetWindowLong_(GadgetID(#ExplorerTree_3),#GWL_STYLE,NewStyle)
  EndIf
  ProcedureReturn HndWin
EndProcedure

hwnd = Open_Window_0()

Repeat
  Select WaitWindowEvent()
    Case  #PB_EventGadget
      Select EventGadgetID()
        Case  #Btn_Exit : quit = 1
          
        Case  #ExplorerTree_3
          
          ;- Textes des StringGadgets 
          ;100=Hnd_Racine ,101=Hnd_Courant ,102=Hnd_Suivant ,103=Hnd_Précédent ,
          ;104=Hnd_Enfant ,105=Hnd_Parent ,106=Check (oui/non) ,107=Texte ; 108=Enfants (oui/non)
          
          RootItem = SendMessage_(hTree,#TVM_GETNEXTITEM,#TVGN_ROOT,0)
          CurItem = SendMessage_(hTree,#TVM_GETNEXTITEM, #TVGN_CARET,#NULL)
          NextItem = SendMessage_(hTree,#TVM_GETNEXTITEM,#TVGN_NEXT,CurItem)
          PrevItem = SendMessage_(hTree,#TVM_GETNEXTITEM,#TVGN_PREVIOUS,CurItem)
          ChildItem = SendMessage_(hTree,#TVM_GETNEXTITEM,#TVGN_CHILD,CurItem)
          ParItem = SendMessage_(hTree,#TVM_GETNEXTITEM,#TVGN_PARENT,CurItem)
          
          text.s = Space(999)
          pitem.TV_ITEM
          
          pitem\mask = #TVIF_TEXT|#TVIF_STATE|#TVIF_CHILDREN
          pitem\hItem = CurItem
          pitem\pszText = @text
          pitem\cchTextMax = 999
          
          lResult = SendMessage_(hTree,#TVM_GETITEM,0, @pitem)
          
          SetGadgetText(100,"Racine = "+Str(RootItem))
          SetGadgetText(101,"Courant = "+Str(CurItem))
          SetGadgetText(102,"Suivant = "+Str(NextItem))
          SetGadgetText(103,"Précédent = "+Str(PrevItem))
          SetGadgetText(104,"Enfant = "+Str(ChildItem))
          SetGadgetText(105,"Parent = "+Str(ParItem))
          SetGadgetText(106,"Check = "+Str(pitem\state >>13))
          text.s = PeekS(pitem\pszText)
          SetGadgetText(107,"Texte = "+text)
          SetGadgetText(108,"Enfants = "+Str(pitem\cChildren))
      EndSelect
    Case #PB_EventCloseWindow
      quit = 1
  EndSelect
Until quit = 1
End
Pendant qu'on y est, pour la valeur 1 ou 0 qui dit que la case est cochée ou pas, j'ai fait ça : pitem\state >>13
Ca marche, mais à mon avis, il doit y avoir une autre méthode. (C'est le 13, qui me paraît bizarre. :roll: ). Peut être un "& quelque_chose", mais je ne sais pas! :oops:

Chris :)
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

mais par contre, je n'arrive pas à récupérer l'index d'un élément sélectionné. (Je parle de l'index, pas du handle... 1,2,3,etc..)
Tu est sur ?

Tu le récupère cet index avec cette ligne de ton code

Code : Tout sélectionner

CurItem = SendMessage_(hTree,#TVM_GETNEXTITEM, #TVGN_CARET,#NULL) 
TVGN_CARET : Retrieves the currently selected item.

Sinon, ton code pour la sélection de la boite à cocher doit être bon, mais voici exactement le code donné par microsoft qui l'appelle d'ailleurs :

The proper method for setting and retrieving the state image index

Voilà le code de MS et je met l'exemple en PB (c'est pratiquement le tien)

Code : Tout sélectionner

BOOL TreeView_GetCheckState(HWND hwndTreeView, HTREEITEM hItem)
{
    TVITEM tvItem;

    // Prepare to receive the desired information.
    tvItem.mask = TVIF_HANDLE | TVIF_STATE;
    tvItem.hItem = hItem;
    tvItem.stateMask = TVIS_STATEIMAGEMASK;

    // Request the information.
    TreeView_GetItem(hwndTreeView, &tvItem);

    // Return zero if it's not checked, or nonzero otherwise.
    return ((BOOL)(tvItem.state >> 12) -1);
}
MS met stateMask à TVIS_STATEIMAGEMASK pour éviter de retrouver les autre valeurs possible (pour infos, toutes les valeurs supplémentaires sont : TVIS_BOLD, TVIS_CUT, TVIS_DROPHILITED, TVIS_EXPANDED, TVIS_EXPANDEDONCE, TVIS_EXPANDPARTIAL, TVIS_SELECTED, TVIS_OVERLAYMASK, TVIS_USERMASK)

Le membre state a les Bits 0 à 7 of qui indiquent l'état de sélection de l'élément, les bit 8 à 11 qui indiquent l'index de l'image (base 1) overlay, et les Bits 12 à 15 l'index de l'image de la list Image (image qui représente l'état) donc ici c'est notre cas.
C'est un peu lourd et celà ne fonctionne que si l'élément est sélectionné à la souris (un click sur l'élément).

Code : Tout sélectionner

;- Window Constants 
Enumeration 
  #Window_0 
EndEnumeration 

;- Gadget Constants 
Enumeration 
  #Btn_Exit 
  #ExplorerTree_3 
EndEnumeration 

#TVS_CHECKBOXES = $0100

Global hTree.l 


Procedure Open_Window_0() 
  If OpenWindow(#Window_0, 388, 120, 450, 260,  #PB_Window_SystemMenu |#PB_Window_ScreenCentered| #PB_Window_TitleBar , "Test sur ''ExplorerTreeGadget''") 
    HndWin = WindowID(#Window_0) 
    If CreateGadgetList(WindowID()) 
      ButtonGadget(#Btn_Exit, 10, 235, 100, 20, "Quitter", #PB_Button_Default) 
      hTree = ExplorerTreeGadget(#ExplorerTree_3, 0, 0, 225, 205, "", #PB_Explorer_AlwaysShowSelection | #PB_Explorer_NoDriveRequester | #PB_Explorer_NoFiles) 
      TextGadget(100,235,10,200,25,"Racine = ") 
      TextGadget(101,235,35,200,25,"Courant = ") 
      TextGadget(102,235,60,200,25,"Suivant = ") 
      TextGadget(103,235,85,200,25,"Précédent = ") 
      TextGadget(104,235,110,200,25,"Enfant = ") 
      TextGadget(105,235,135,200,25,"Parent = ") 
      TextGadget(106,235,160,200,25,"Check = ") 
      TextGadget(107,235,185,200,25,"Texte = ") 
      TextGadget(108,235,210,200,25,"Enfants = ") 
    EndIf 
    ;- Ajout de CheckBox à l' ExplorerTreeGadget 
    OldStyle = GetWindowLong_(GadgetID(#ExplorerTree_3),#GWL_STYLE) 
    NewStyle = OldStyle | #TVS_CHECKBOXES 
    SetWindowLong_(GadgetID(#ExplorerTree_3),#GWL_STYLE,NewStyle) 
  EndIf 
  ProcedureReturn HndWin 
EndProcedure 


hwnd = Open_Window_0() 


Repeat 
  Select WaitWindowEvent() 
    Case  #PB_EventGadget 
      Select EventGadgetID() 
        Case  #Btn_Exit : quit = 1 
          
        Case  #ExplorerTree_3 
          
          ;- Textes des StringGadgets 
          ;100=Hnd_Racine ,101=Hnd_Courant ,102=Hnd_Suivant ,103=Hnd_Précédent , 
          ;104=Hnd_Enfant ,105=Hnd_Parent ,106=Check (oui/non) ,107=Texte ; 108=Enfants (oui/non) 
          
          RootItem = SendMessage_(hTree,#TVM_GETNEXTITEM,#TVGN_ROOT,0) 
          CurItem = SendMessage_(hTree,#TVM_GETNEXTITEM, #TVGN_CARET,#NULL) 
          NextItem = SendMessage_(hTree,#TVM_GETNEXTITEM,#TVGN_NEXT,CurItem) 
          PrevItem = SendMessage_(hTree,#TVM_GETNEXTITEM,#TVGN_PREVIOUS,CurItem) 
          ChildItem = SendMessage_(hTree,#TVM_GETNEXTITEM,#TVGN_CHILD,CurItem) 
          ParItem = SendMessage_(hTree,#TVM_GETNEXTITEM,#TVGN_PARENT,CurItem) 
          
          text.s = Space(999) 
          pitem.TV_ITEM 
          
          pitem\mask = #TVIF_TEXT|#TVIF_STATE|#TVIF_CHILDREN
          pitem\hItem = CurItem 
          pitem\pszText = @text 
          pitem\cchTextMax = 999
          pitem\stateMask = #TVIS_STATEIMAGEMASK       ; <--  ce que j'ai ajouté

        
          lResult = SendMessage_(hTree,#TVM_GETITEM,0, @pitem) 

          SetGadgetText(100,"Racine = "+Str(RootItem)) 
          SetGadgetText(101,"Courant = "+Str(CurItem)) 
          SetGadgetText(102,"Suivant = "+Str(NextItem)) 
          SetGadgetText(103,"Précédent = "+Str(PrevItem)) 
          SetGadgetText(104,"Enfant = "+Str(ChildItem)) 
          SetGadgetText(105,"Parent = "+Str(ParItem)) 
          SetGadgetText(106,"Check = "+Str((pitem\state >> 12) -1))  ; <--  ce que j'ai modifié
          text.s = PeekS(pitem\pszText) 
          SetGadgetText(107,"Texte = "+text) 
          SetGadgetText(108,"Enfants = "+Str(Selection)) 
          
      EndSelect 
    Case #PB_EventCloseWindow 
      quit = 1 
  EndSelect 
Until quit = 1 
End 
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Message par Chris »

Citation:
mais par contre, je n'arrive pas à récupérer l'index d'un élément sélectionné. (Je parle de l'index, pas du handle... 1,2,3,etc..)

Tu est sur ?

Tu le récupère cet index avec cette ligne de ton code
Ben oui, je récupère un handle (ex: 1411632), mais pas un index

Exemple, si je cliques sur le poste de travail:

Racine = 1411048
Courant = 1411048

Pour un index, je devrais avoir 0, à cet endroit, normalement. (Je crois...)

Sinon, pour le reste, ça va! Je me suis pas trop planté, mais va quand même falloir que je me remette à l'anglais, puisque Billou veut pas faire son SDK en Français :lol:

Merci ;)

Chris :)
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

Tu as raison Chris,
c'est bien un handle, il ne semble pas y avoir d'index.
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Petit début de librairie : Code Source

Message par Chris »

Petit début de librairie pour l'EditorTreeGadget

Le prog de test

Code : Tout sélectionner

;/*******************************************************************
;/*       Librairie pour EditorTreeGadget  : Fichier de test        *
;/*                                                                 *
;/*           Auteur : Chris : http://forum.purebasic.fr            *
;/*           Merci à Denis  : http://forum.purebasic.fr            *
;/*******************************************************************

IncludeFile "EditTreeLib.pb"

;- Window Constants
Enumeration
  #Window_0
EndEnumeration

;- Gadget Constants
Enumeration
  #Btn_Exit
  #ExplorerTree_3
EndEnumeration
#TVS_CHECKBOXES = $0100

Global hTree.l

Procedure Open_Window_0()
  If OpenWindow(#Window_0, 388, 120, 450, 260,  #PB_Window_SystemMenu |#PB_Window_ScreenCentered| #PB_Window_TitleBar , "Test sur ''ExplorerTreeGadget''")
    HndWin = WindowID(#Window_0)
    If CreateGadgetList(WindowID())
      ButtonGadget(#Btn_Exit, 10, 235, 100, 20, "Quitter", #PB_Button_Default)
      hTree = ExplorerTreeGadget(#ExplorerTree_3, 0, 0, 225, 205, "", #PB_Explorer_AlwaysShowSelection | #PB_Explorer_NoDriveRequester | #PB_Explorer_NoFiles)
      TextGadget(100,235,10,200,25,"Racine = ")
      TextGadget(101,235,35,200,25,"Courant = ")
      TextGadget(102,235,60,200,25,"Suivant = ")
      TextGadget(103,235,85,200,25,"Précédent = ")
      TextGadget(104,235,110,200,25,"Enfant = ")
      TextGadget(105,235,135,200,25,"Parent = ")
      TextGadget(106,235,160,200,25,"Check = ")
      TextGadget(107,235,185,200,25,"Texte = ") 
      TextGadget(108,235,210,200,25,"à des Enfants = ")
    EndIf
    ;- Ajout de CheckBox à l' ExplorerTreeGadget
    OldStyle = GetWindowLong_(GadgetID(#ExplorerTree_3),#GWL_STYLE)
    NewStyle = OldStyle | #TVS_CHECKBOXES
    SetWindowLong_(GadgetID(#ExplorerTree_3),#GWL_STYLE,NewStyle)
  EndIf
  ProcedureReturn HndWin
EndProcedure

hwnd = Open_Window_0()

Repeat
  Select WaitWindowEvent()
    Case  #PB_EventGadget
      Select EventGadgetID()
        Case  #Btn_Exit : quit = 1
          
        Case  #ExplorerTree_3
          SetGadgetText(100,"Racine = "+Str(PeekL(ETG_Root(hTree))))
          SetGadgetText(101,"Courant = "+Str(PeekL(ETG_CurItem(hTree))))
          SetGadgetText(102,"Suivant = "+Str(PeekL(ETG_NextItem(hTree))))
          SetGadgetText(103,"Précédent = "+Str(PeekL(ETG_PreviousItem(hTree))))
          SetGadgetText(104,"Enfant = "+Str(PeekL(ETG_ChildItem(hTree))))
          SetGadgetText(105,"Parent = "+Str(PeekL(ETG_ParentItem(hTree))))
          SetGadgetText(106,"Check = "+Str(PeekL(ETG_IsCheck(hTree))))
          SetGadgetText(107,"Texte = "+ ETG_GetText(hTree))
          Child = PeekL(ETG_HaveChild())
          If Child = 1 : C$ = "Oui" : Else : C$ = "Non" : EndIf
          SetGadgetText(108,"à des Enfants = "+C$)
          
      EndSelect
    Case #PB_EventCloseWindow
      quit = 1
  EndSelect
Until quit = 1
End
Et le fichier de procédures.

Code : Tout sélectionner

;/*******************************************************************
;/*                 Librairie pour EditorTreeGadget                 *
;/*                                                                 *
;/*           Auteur : Chris : http://forum.purebasic.fr            *
;/*           Merci à Denis  : http://forum.purebasic.fr            *
;/*******************************************************************

Global pitem.TV_ITEM , text.s

text.s = Space(999) 
pitem\mask = #TVIF_TEXT|#TVIF_STATE|#TVIF_CHILDREN 
pitem\pszText = @text 
pitem\cchTextMax = 999 
pitem\stateMask = #TVIS_STATEIMAGEMASK       ; <--  ce que j'ai ajouté 

Procedure.s ETG_GetText(HndETG)
  CurItem = SendMessage_(HndETG,#TVM_GETNEXTITEM, #TVGN_CARET,#NULL)
  pitem\hItem = CurItem
  lResult = SendMessage_(HndETG,#TVM_GETITEM,0, @pitem)
  text = PeekS(pitem\pszText)
  ProcedureReturn text
EndProcedure

Procedure ETG_Root(HndETG)
  RootItem = SendMessage_(HndETG,#TVM_GETNEXTITEM,#TVGN_ROOT,0)
  ProcedureReturn @RootItem
EndProcedure

Procedure ETG_CurItem(HndETG)
  CurItem = SendMessage_(HndETG,#TVM_GETNEXTITEM, #TVGN_CARET,#NULL)
  ProcedureReturn @CurItem
EndProcedure

Procedure ETG_NextItem(HndETG)
  CurItem = SendMessage_(HndETG,#TVM_GETNEXTITEM, #TVGN_CARET,#NULL)
  NextItem = SendMessage_(HndETG,#TVM_GETNEXTITEM,#TVGN_NEXT,CurItem)
  ProcedureReturn @NextItem
EndProcedure

Procedure ETG_PreviousItem(HndETG)
  CurItem = SendMessage_(HndETG,#TVM_GETNEXTITEM, #TVGN_CARET,#NULL)
  PrevItem = SendMessage_(HndETG,#TVM_GETNEXTITEM,#TVGN_PREVIOUS,CurItem)
  ProcedureReturn @PrevItem
EndProcedure

Procedure ETG_ChildItem(HndETG)
  CurItem = SendMessage_(HndETG,#TVM_GETNEXTITEM, #TVGN_CARET,#NULL)
  Child = SendMessage_(HndETG,#TVM_GETNEXTITEM,#TVGN_CHILD,CurItem)
  ProcedureReturn @Child
EndProcedure

Procedure ETG_ParentItem(HndETG)
  CurItem = SendMessage_(HndETG,#TVM_GETNEXTITEM, #TVGN_CARET,#NULL)
  ParItem = SendMessage_(HndETG,#TVM_GETNEXTITEM,#TVGN_PARENT,CurItem)
  ProcedureReturn @ParItem
EndProcedure

Procedure ETG_IsCheck(HndETG)
  CurItem = SendMessage_(HndETG,#TVM_GETNEXTITEM, #TVGN_CARET,#NULL)
  pitem\hItem = CurItem 
  lResult = SendMessage_(HndETG,#TVM_GETITEM,0, @pitem) 
  Check = (pitem\state >> 12) -1
  ProcedureReturn @Check
EndProcedure

Procedure ETG_HaveChild()
  HaveChild= pitem\cChildren
  ProcedureReturn @HaveChild
EndProcedure
C'est qu'un début, il y a encore des trucs à revoir ;)

Chris :)
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

Sur le site de Freak, il y a plusieurs procédures qu'il a écrit pour les TreeGadget, en PB, prêtes à être insérées dans une lib Tailbite.
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Message par Chris »

Merci, je vais aller voir ça :)

Chris :)
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Message par Chris »

Je viens de faire une petite lib avec TAILBITE en utilisant ce fichier.

Je l'a testée sous XP, quelqu'un peut-t'il la tester sous 98, et 2000. :roll:

A récupérer ici : 4 ko seulement

Il y a le fichier de test et une petite aide dans l'archive

Merci ;)

Chris :)
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

Je teste ça cet après-midi

Sinon tu peux écrire une commande pour afficher les checkbox et d'après la doc de MS, il n'est pas possible de les supprimer sauf à détruire l'exploreur et à le reconstruire.

ProcedureDll ETG_SetCheckBoxes(Gadget.l)
; OldStyle = GetWindowLong_(GadgetIDGadget),#GWL_STYLE)
; NewStyle = OldStyle | #TVS_CHECKBOXES
SetWindowLong_(GadgetIDGadget), #GWL_STYLE, GetWindowLong_(GadgetIDGadget),#GWL_STYLE) | #TVS_CHECKBOXES)
Endprocedure

J'ai écrit une procédure pour la couleur, je poste ça cet après-midi. Il y a des exemples pour mettre de la couleur sur le site Purearea, mais la méthode utilisée c'est-à-dire faire une copie de la LIstImage de l'exploreurTreeGadget puis de mettre la couleur de fond à la list est une bonne idée sauf que la ListImage utilisée par l'exploreurTreeGadget est la ListImage système, donc la copie faite aura un nombre d'icônes limité car au fur et à mesure que l'on ouvre des dossiers avec l'explorateur windows et d'autres outils MS, cet Liste système va grandir, en clair celà veut dire que l'explorateur ayant une liste tronquée ne pourra pas afficher tous les icônes (j'ai fait des tests).

Pour l'instant je vois 2 solutions pour mettre la couleur et donc avoir les icônes transparents :

Soit faire une copie de la listImage système dans la boucle d'évenement, mais j'ai pas fait de tests (et je suis pas sur que ça marche correctement), soit ce que j'ai écrit en PB, mettre de la couleur de fond aux icônes de la listeImage sytème ce qui aura donc la propriété d'avoir les icônes transparents pour l'exploreurTreeGadget mais l'inconvénient c'est que si on ouvre l'explorateur de Windows, le fond des icônes aura cette couleur, donc en quittant le programme qui utilise cette technique, il faut réatribuer la couleur de fond initiale aux icônes.
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

Chris,

Ca marche sans problème sous WIN98.
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Message par Chris »

Super, merci ;)

Je continue à essayer d'ajouter des fonctions, ça pourrait faire une lib sympa.

Si tu as des idées, n'hésite pas!

Chris :)
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

J'ai fait une procedure pour la couleur, presque finie et je poste ça demain car aujourd'hui j'ai plein de choses à faire et j'aurais pas trop le temps.
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

Voici les 4 procédures nécessaire pour la couleur.
Il faut mettre au début du code l'appel à InitTreeGadget() et lorsque l'on quitte le programme il faut appeller FreeTreeGadget() pour rétablir la couleur système à la listimage.

Si l'explorateur window est déjà ouvert, on appui sur F5 pour réactualiser l'affichage et les icônes reprennet leur couleur de fond classique.
J'ai pas chercher, mais on devrait trouver un message qui va bien pour obliger toutes les fenêtres à se redessiner.

Code : Tout sélectionner

; ;========================================================================================
; ;========================================================================================

Procedure InitTreeGadget()
  ; cette procedure va permettre d'initialiser toutes les valeurs necessaires pour
  ; faire fonctionner correctement nos fonctions
  
  Global hImageListS.l
  
  ; on récupère le Handle de la ListeImage système
  
    hImageListS = SHGetFileInfo_("", 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_SMALLICON | #SHGFI_SYSICONINDEX)
EndProcedure

; ;========================================================================================
; ;========================================================================================

Procedure FreeTreeGadget()
 ; restaure la couleur initiale à la ListImage système
   ImageList_SetBkColor_(hImageListS, GetSysColor_(#COLOR_WINDOW)) 
EndProcedure

; ;========================================================================================
; ;========================================================================================

Procedure.l TreeGadgetListImageID(Gadget.l, ListImageType.l)

  ;  Auteur : Denis
  
  ; retourne -1 en cas d'erreur
  ; retourne 0 si aucune ListImage n'est associée
  ; sinon retourne le Handle de la ListImage associée
  
  ValeurRetour = -1
  Gadget_ID = GadgetID(Gadget)
  If Gadget_ID And (ListImageType = #TVSIL_NORMAL Or ListImageType = #TVSIL_STATE)
    ValeurRetour = SendMessage_(Gadget_ID, #TVM_GETIMAGELIST, ListImageType, 0)
  EndIf
  
  ProcedureReturn ValeurRetour
EndProcedure

; ;========================================================================================
; ;========================================================================================

Procedure.l SetTreeGadgetColor(Gadget.l, Parametre.l)

  ;  Auteur : Denis
  
  ; pour ressembler à la procedure que j'ai utilisée pour les ListIconGadget
  ; Paramètre est composé de la couleur et de l'option  --> Couleur.l [ | Option.l ]
  ; voici la synthaxe utilisable SetTreeGadgetColor(#Gadget, Couleur.l [ | Option.l ])
  ; Couleur  --> couleur désirée
  ; Option   --> #PB_SetTextColor     pour colorier le texte
  ; --> #PB_SetListColor     pour colorier le texte et le fond du TreeGadget
  ;
  ; nouvelles constantes introduites pour Option pour le TreeGadget
  ;
  ;- -> #PB_SetLineColor     pour colorier les lignes
  ;
  ; La couleur étant basée sur 24 bits, il nous en reste 8 pour faire nos tests

  ;******************************************************************************
  ;* Voici un appel typique de la commande
  ;*
  ;*  SetTreeGadgetColor(#ExplorerTreeGadget, Couleur | #PB_SetListColor)
  ;*
  ;*
  ;******************************************************************************
  
  ; La fonction retourne -1 en cas d'échec, sinon elle retourne une autre valeur
  ; Voici un nombre en binaire ou j'ai mis un x pour les bits que l'on peut utiliser,
  ; donc ceux que la valeur de couleur n'utilise pas. Les 24 bit de couleurs sont à 0
  ; c'est juste un exemple
  ;
  ; xxxxxxxx000000000000000000000000
  ; |______||______________________|
  ; dispo          couleur
  ;
  ; donc si on le représente en hexadécimal on a
  ;
  ; $xx000000    --> le $ indique un nombre hexa
  ;
  ;
  ; Hexa                Binaire
  ;
  ; #PB_SetTextColor            = $01000000  -->  00000001000000000000000000000000
  ; #PB_SetLineColor            = $02000000  -->  00000010000000000000000000000000
  ; #PB_SetListColor            = $04000000  -->  00000100000000000000000000000000
  ; #PB_NoListBackColor         = $FFFFFFFF  -->  11111111111111111111111111111111
  
  
  
  ValeurRetour = -1
  Gadget_ID = GadgetID(Gadget)
  If Gadget_ID ; on teste que le Gadget existe, sinon on retourne -1
    ; on teste si Paramètre vaut -1 et si oui, on applique les couleurs système au TreeGadget
    If Parametre = -1
      ; si le dernier paramètre des 2 premiers messages vaut -1,
      ; le système applique les couleurs sytèmes
      ; cette valeur vaut #CLR_DEFAULT dans le cas des lignes, allez savoir pourquoi ??????
      SendMessage_(Gadget_ID, #TVM_SETTEXTCOLOR, 0, -1) ; Le texte
      SendMessage_(Gadget_ID, #TVM_SETBKCOLOR, 0, -1) ; Le fond de la liste
      SendMessage_(Gadget_ID, #TVM_SETLINECOLOR, 0, #CLR_DEFAULT) ; Le fond de la liste
      ValeurRetour = 1 ; on retourne un valeur différente de -1 car c'est bon
    Else
      ; sinon on va appliquer la couleur à l'élément choisi
      ; on teste de quel élément il s'agit :
      Element = Parametre & $FF000000 ; on sélectionne la partie indiquant Option
      Couleur = Parametre & $00FFFFFF ; on sélectionne la couleur seule
      If Element = #PB_SetTextColor
        Message = #TVM_SETTEXTCOLOR
      ElseIf Element = #PB_SetListColor
        Message = #TVM_SETBKCOLOR
      ElseIf Element = #PB_SetLineColor
        Message = #TVM_SETLINECOLOR
      EndIf
      
      If Message ; on envoie le message si Message est différent de 0
        SendMessage_(Gadget_ID, Message, 0, Couleur)
        If Message = #TVM_SETBKCOLOR
          ; ici, on va assigner à la ListImage une couleur de Fond pour que les icônes
          ; soient affichée par transparence
          HwnDiml = TreeGadgetListImageID(Gadget, #TVSIL_NORMAL) ; on récupère le Handle
          If HwnDiml = 0 ; si pas de ListImage TVSIL_NORMAL alors on cherche TVSIL_STATE
            HwnDiml = TreeGadgetListImageID(Gadget, #TVSIL_STATE)
          EndIf
          
          If HwnDiml
            If SendMessage_(Gadget_ID, #TVM_SETIMAGELIST, #TVSIL_NORMAL, HwnDiml)
              ImageList_SetBkColor_(HwnDiml, Couleur)
            EndIf
          EndIf
        EndIf
      EndIf
      
    EndIf
    
  EndIf
  ValeurRetour = 1 ; on retourne un valeur différente de -1 car c'est bon
  ; on force la lise à être redessinée pour appliquer immédiatement les couleurs
  RedrawWindow_(Gadget_ID, 0, 0, 7)
  
  ProcedureReturn ValeurRetour
EndProcedure

; ;========================================================================================
; ;========================================================================================

Et un petit bout de code pour les essais

Code : Tout sélectionner

; constantes des Gadgets

#Index = 0
Enumeration
  #MainWindow
  #ExplorerTreeGadget
  #ButtonGadget
  #ButtonGadget1
  #ButtonGadget2
  #ButtonGadget3
  #TextGadgetSystem
  #TextGadgetTree
  #Font
  #Librairie1
EndEnumeration

#TVM_SETBKCOLOR = $111D
#TVM_SETTEXTCOLOR = $111E
#TVM_SETLINECOLOR = $1128
#TVM_SETINSERTMARKCOLOR = $1125

#PB_SetLineColor = $02000000

#TVSIL_NORMAL = 0
#TVSIL_STATE = 2


#CSIDL_DESKTOP = 0

; structures Microsoft
Structure SHITEMID
  cb.l
  abID.b[1]
EndStructure

Structure ITEMIDLIST
  mkid.SHITEMID
EndStructure


; ;========================================================================================
; ;========================================================================================

Procedure InitTreeGadget()
  ; cette procedure va permettre d'initialiser toutes les valeurs necessaires pour
  ; faire fonctionner correctement nos fonctions
  
  Global  hImageListS.l
  
  ; on récupère le Handle de la ListeImage système
  
    hImageListS = SHGetFileInfo_("", 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_SMALLICON | #SHGFI_SYSICONINDEX)
EndProcedure

; ;========================================================================================
; ;========================================================================================
Procedure FreeTreeGadget()
 ; restaure la couleur initiale à la ListImage système
   ImageList_SetBkColor_(hImageListS, GetSysColor_(#COLOR_WINDOW)) 
EndProcedure

; ;========================================================================================
; ;========================================================================================


; ;========================================================================================
; ;========================================================================================

Procedure.l TreeGadgetListImageID(Gadget.l, ListImageType.l)

  ;  Auteur : Denis
  
  ; retourne -1 en cas d'erreur
  ; retourne 0 si aucune ListImage n'est associée
  ; sinon retourne le Handle de la ListImage associée
  
  ValeurRetour = -1
  Gadget_ID = GadgetID(Gadget)
  If Gadget_ID And (ListImageType = #TVSIL_NORMAL Or ListImageType = #TVSIL_STATE)
    ValeurRetour = SendMessage_(Gadget_ID, #TVM_GETIMAGELIST, ListImageType, 0)
  EndIf
  
  ProcedureReturn ValeurRetour
EndProcedure

; ;========================================================================================
; ;========================================================================================

Procedure.l SetTreeGadgetColor(Gadget.l, Parametre.l)

  ;  Auteur : Denis
  
  ; pour ressembler à la procedure que j'ai utilisée pour les ListIconGadget
  ; voici la synthaxe utilisable SetTreeGadgetColor(#Gadget, Couleur.l [ | Option.l ])
  ; Couleur  --> couleur désirée
  ; Option   --> #PB_SetTextColor     pour colorier le texte
  ;- -> #PB_SetListColor     pour colorier le texte et le fond du TreeGadget
  ;
  ; nouvelles constantes introduites pour Option pour le TreeGadget
  ;
  ;- -> #PB_SetLineColor     pour colorier les lignes
  ;
  ; La couleur étant basée sur 24 bits, il nous en reste 8 pour faire nos tests
  
  ; La fonction retourne -1 en cas d'échec, sinon elle retourne une autre valeur
  ; Voici un nombre en binaire ou j'ai mis un x pour les bits que l'on peut utiliser,
  ; donc ceux que la valeur de couleur n'utilise pas. Les 24 bit de couleurs sont à 0
  ; c'est juste un exemple
  ;
  ; xxxxxxxx000000000000000000000000
  ; |______||______________________|
  ; dispo          couleur
  ;
  ; donc si on le représente en hexadécimal on a
  ;
  ; $xx000000    --> le $ indique un nombre hexa
  ;
  ;
  ; Hexa                Binaire
  ;
  ; #PB_SetTextColor            = $01000000  -->  00000001000000000000000000000000
  ; #PB_SetLineColor            = $02000000  -->  00000010000000000000000000000000
  ; #PB_SetListColor            = $04000000  -->  00000100000000000000000000000000
  ; #PB_NoListBackColor         = $FFFFFFFF  -->  11111111111111111111111111111111
  
  
  
  ValeurRetour = -1
  Gadget_ID = GadgetID(Gadget)
  If Gadget_ID ; on teste que le Gadget existe, sinon on retourne -1
    ; on teste si Paramètre vaut -1 et si oui, on applique les couleurs système au TreeGadget
    If Parametre = -1
      ; si le dernier paramètre des 2 premiers messages vaut -1,
      ; le système applique les couleurs sytèmes
      ; cette valeur vaut #CLR_DEFAULT dans le cas des lignes, allez savoir pourquoi ??????
      SendMessage_(Gadget_ID, #TVM_SETTEXTCOLOR, 0, -1) ; Le texte
      SendMessage_(Gadget_ID, #TVM_SETBKCOLOR, 0, -1) ; Le fond de la liste
      SendMessage_(Gadget_ID, #TVM_SETLINECOLOR, 0, #CLR_DEFAULT) ; Le fond de la liste
      ; ImageList_SetBkColor_(HwnDiml, #CLR_NONE)
      ValeurRetour = 1 ; on retourne un valeur différente de -1 car c'est bon
    Else
      ; sinon on va appliquer la couleur à l'élément choisi
      ; on teste de quel élément il s'agit :
      Element = Parametre & $FF000000 ; on sélectionne la partie indiquant Option
      Couleur = Parametre & $00FFFFFF ; on sélectionne la couleur seule
      If Element = #PB_SetTextColor
        Message = #TVM_SETTEXTCOLOR
      ElseIf Element = #PB_SetListColor
        Message = #TVM_SETBKCOLOR
      ElseIf Element = #PB_SetLineColor
        Message = #TVM_SETLINECOLOR
      EndIf
      
      If Message ; on envoie le message si Message est différent de 0
        SendMessage_(Gadget_ID, Message, 0, Couleur)
        If Message = #TVM_SETBKCOLOR
          ; ici, on va assigner à la ListImage une couleur de Fond pour que les icônes
          ; soient affichée par transparence
          HwnDiml = TreeGadgetListImageID(Gadget, #TVSIL_NORMAL) ; on récupère le Handle
;           If HwnDiml = 0 ; si pas de ListImage TVSIL_NORMAL alors on cherche TVSIL_STATE
;             HwnDiml = TreeGadgetListImageID(Gadget, #TVSIL_STATE)
;           EndIf
          
          If HwnDiml
            If SendMessage_(Gadget_ID, #TVM_SETIMAGELIST, #TVSIL_NORMAL, HwnDiml)
              ImageList_SetBkColor_(HwnDiml, Couleur)
            EndIf
          EndIf
        EndIf
      EndIf
      
    EndIf
    
  EndIf
  ValeurRetour = 1 ; on retourne un valeur différente de -1 car c'est bon
  ; on force la lise à être redessinée pour appliquer immédiatement les couleurs
  RedrawWindow_(Gadget_ID, 0, 0, 7)
  
  ProcedureReturn ValeurRetour
EndProcedure

; ;========================================================================================
; ;========================================================================================

If OpenWindow(#MainWindow, 0, 0, 300, 620, #PB_Window_SystemMenu | #PB_Window_ScreenCentered, "  SetTreeGadgetColor()")
  If CreateGadgetList(WindowID()) And ExplorerTreeGadget(#ExplorerTreeGadget, 10, 10, 280, 280, "*.*", #PB_Explorer_AutoSort )
    InitTreeGadget()
    ButtonFont.l = LoadFont(#Font, "Arial", 11, #PB_Font_HighQuality)
    
    ButtonGadget(#ButtonGadget, 12, 305, 280, 50, "     Choissisez la couleur du fond     Choose backgnd color", #PB_Button_MultiLine)
    ButtonGadget(#ButtonGadget1, 12, 365, 280, 50, "     Choissisez la couleur du texte     Choose text color", #PB_Button_MultiLine)
    ButtonGadget(#ButtonGadget2, 12, 425, 280, 50, "     Choissisez la couleur des lignes     Choose lines color", #PB_Button_MultiLine)
    ButtonGadget(#ButtonGadget3, 12, 485, 280, 50, "                   Couleurs système                      System colors", #PB_Button_MultiLine)
    
    SetGadgetFont(#ButtonGadget, ButtonFont)
    SetGadgetFont(#ButtonGadget1, ButtonFont)
    SetGadgetFont(#ButtonGadget2, ButtonFont)
    SetGadgetFont(#ButtonGadget3, ButtonFont)
    
    
    Repeat
      Select WaitWindowEvent()
          
          
        Case #PB_EventGadget
          
          event = EventGadgetID()
          If event = #ButtonGadget ; couleur du fond
            couleur = ColorRequester()
            If couleur <> - 1
              SetTreeGadgetColor(#ExplorerTreeGadget, Couleur | #PB_SetListColor)
            EndIf
            
          ElseIf event = #ButtonGadget1 ; couleur du texte
            couleur = ColorRequester()
            If couleur <> - 1
              SetTreeGadgetColor(#ExplorerTreeGadget, Couleur | #PB_SetTextColor)
            EndIf
            
          ElseIf event = #ButtonGadget2 ; couleur des lignes
            couleur = ColorRequester()
            If couleur <> - 1
              SetTreeGadgetColor(#ExplorerTreeGadget, Couleur | #PB_SetLineColor)
            EndIf
            
          ElseIf event = #ButtonGadget3 ; couleurs système
            SetTreeGadgetColor(#ExplorerTreeGadget, #PB_NoListBackColor)
          EndIf
          
        Case #PB_EventCloseWindow
          FreeTreeGadget()
          Quit + 1
          
      EndSelect
      
    Until Quit
  EndIf
EndIf
End
Avatar de l’utilisateur
Chris
Messages : 3731
Inscription : sam. 24/janv./2004 14:54
Contact :

Message par Chris »

Salut :)

Merci, Denis pour le code des couleurs. :wink:
Je l'ai inclus dans la lib, ça fonctionne bien, sauf quand je mets les cases à cocher, elles restent sur un fond blanc.
Il faudrait redessiner le gadget à chaque fois qu'on change la couleur, mais pour faire ça, il faut le détruire et le recréer. Bon, je verrai ça plus tard :)

J'ai ajouté une fonction qui compte le nombre d'éléments dans la branche sélectionnée, mais il y a un petit truc qui me chiffonne.

Pour compter les éléments, il faut ouvrir la branche. J'ai donc fait une procedure pour ça, mais on voit la branche qui s'ouvre et se referme. C'est pas très propre comme truc, surtout avec des dossiers bien pleins. (Par ex., le rep "Includes" du SDK de MicroMou).

Voilà la procédure, si par hasard, tu avais une idée, parce que moi, avec mon anglais très approximatif, je ne vois pas comment faire pour compter les éléments, sans ouvrir la branche. (Ou sans afficher l'ouverture).

Code : Tout sélectionner

Procedure ETG_GetCount(HndETG)      ; Retourne le nombre d'éléments dans la branche sélectionnée
  CurItem = SendMessage_(HndETG,#TVM_GETNEXTITEM, #TVGN_CARET,#NULL)
  If ETG_HaveChild() <> 0
    If SendMessage_(HndETG,#TVM_GETITEMSTATE,CurItem,#TVIS_EXPANDED) = 4194
      IsOpen = 1
    Else
      IsOpen = 0
    EndIf
    If IsOpen = 0
      SendMessage_(HndETG,#TVM_EXPAND,#TVE_EXPAND,CurItem)
    EndIf
    Child = SendMessage_(HndETG,#TVM_GETNEXTITEM,#TVGN_CHILD,CurItem)
    SendMessage_(HndETG,#TVM_SELECTITEM,#TVGN_CARET,Child)
    Repeat
      Current = SendMessage_(HndETG,#TVM_GETNEXTITEM, #TVGN_CARET,#NULL)
      If Current <> 0
        a + 1
      EndIf
      NextIt = SendMessage_(HndETG,#TVM_GETNEXTITEM,#TVGN_NEXT,Current)
      SendMessage_(HndETG,#TVM_SELECTITEM,#TVGN_CARET,NextIt)
    Until Current = 0
    If IsOpen = 0
      SendMessage_(HndETG,#TVM_EXPAND,#TVE_COLLAPSE,CurItem)
    EndIf
  EndIf
  ProcedureReturn PeekL(@a)
EndProcedure
Chris :)
Anonyme2
Messages : 3518
Inscription : jeu. 22/janv./2004 14:31
Localisation : Sourans

Message par Anonyme2 »

Je l'ai inclus dans la lib, ça fonctionne bien, sauf quand je mets les cases à cocher, elles restent sur un fond blanc.
Il me semble que ces boites à cocher sont des images. Il rfaudrait que je retrouve ou j'ai lu celà.

Pour le reste j'ai pas encore regardé :oops:
Répondre