[TUTO]TreeGadget : petites applis

[Ollivier]

Salut,

J'ai modifié le Post pour m'éclaircir un peu au sujet de TreeGadget.
Alors voici une petite documentation pour effectuer une demi douzaine d'actions sur un TreeGadget avec la procedure Arbr() présente en tête de l'exemple source plus bas.

Code : Tout sélectionner

;*************************************************************************************
;Arbr(Action, Arbre, Clef, Racine) ¤ Traite l'arbre représenté par un TreeGadget
;Ollivier 07/07
;*************************************************************************************

;Entrées  ACTION.      LONG Contient le n° de l'action que la procédure doit exécuter
;         ARBRE.       LONG Contient le n° du TreeGadget que la procédure doit modifier
;         CLEF.        LONG Contient le n° du GadgetItem auquel la procédure se réfère
;         RACINE.      STRING Contient la chaîne (GadgetItemText) que la procédure peut utiliser
;         >>>> (Pour les fichiers) Contient le nom du fichier que la procédure peut traiter
;
;Sortie   REACTION.    LONG
;         >>>> (Pour les fichiers) Contient la réussite du transfert avec le fichier traité
;
;
; -------------------------------------------------------------------------------------
; ACTION = 0 : Efface entièrement l'arbre
; -------------------------------------------------------------------------------------
;Entrees: ARBRE  N° de l'arbre à effacer
;         RACINE Contenu de la clef racine une fois l'arbre effacé

;Rem      S'il n'y a plus de clef, il n'y a plus d'édition possible.
;         Donc une clef racine est recréée après l'effacement de l'arbre

;Sortie   REACTION Pointeur vers la chaîne contenant le rapport d'erreur
          
; -------------------------------------------------------------------------------------
; ACTION = 1 : Crée une clef 'soeur ainée' de la clef spécifiée
; -------------------------------------------------------------------------------------
;Entrees: ARBRE  N° de l'arbre à modifier
;         CLEF   N° de la clef spécifiée
;         RACINE Contenu de la clef 'soeur ainée'

;Rem      La 'soeur ainée' est la première clef dans la liste
;         qui contient la clef spécifiée.
;         Une liste peut être considérée comme l'ensemble de clef contigües de même 
;         niveau.
;         La 'soeur ainée' a le même niveau que la clef spécifiée

;Sortie   REACTION Pointeur vers la chaîne contenant le rapport d'erreur
          
; -------------------------------------------------------------------------------------
; ACTION = 2 : Crée une clef 'soeur cadette' de la clef spécifiée
; -------------------------------------------------------------------------------------
;Entrees: ARBRE  N° de l'arbre à modifier
;         CLEF   N° de la clef spécifiée
;         RACINE Contenu de la clef 'soeur cadette'

;Rem      La 'soeur cadette' est la clef qui succède immédiatement
;         à la clef spécifiée
;         La 'soeur cadette' a le même niveau que la clef spécifiée

;Sortie   REACTION Pointeur vers la chaîne contenant le rapport d'erreur
          
; -------------------------------------------------------------------------------------
; ACTION = 3 : Crée une clef 'soeur benjamine' de la clef spécifiée
; -------------------------------------------------------------------------------------
;Entrees: ARBRE  N° de l'arbre à modifier
;         CLEF   N° de la clef spécifiée
;         RACINE Contenu de la clef 'soeur benjamine'

;Rem      La 'soeur benjamine' est la dernière clef dans la liste
;         qui contient la clef spécifiée
;         La 'soeur benjamine' a le même niveau que la clef spécifiée

;Sortie   REACTION Pointeur vers la chaîne contenant le rapport d'erreur
          
; -------------------------------------------------------------------------------------
; ACTION = 4 : Crée une clef 'fille ainée' de la clef spécifiée
; -------------------------------------------------------------------------------------
;Entrees: ARBRE  N° de l'arbre à modifier
;         CLEF   N° de la clef spécifiée
;         RACINE Contenu de la clef 'fille ainée'

;Rem      La 'fille ainée' est la première clef dans la sous-liste
;         contenue par la clef spécifiée
;         La 'fille ainée' a un niveau N+1 par rapport au niveau N
;         de la clef spécifiée

;Sortie   REACTION Pointeur vers la chaîne contenant le rapport d'erreur
          
; -------------------------------------------------------------------------------------
; ACTION = 5 : Crée une clef 'fille benjamine' de la clef spécifiée
; -------------------------------------------------------------------------------------
;Entrees: ARBRE  N° de l'arbre à modifier
;         CLEF   N° de la clef spécifiée
;         RACINE Contenu de la clef 'fille benjamine'

;Rem      La 'fille benjamine' est la dernière clef dans la sous-liste
;         contenue par la clef spécifiée
;         La 'fille benjamine' a un niveau N+1 par rapport au niveau N
;         de la clef spécifiée

;Sortie   REACTION Pointeur vers la chaîne contenant le rapport d'erreur
          
; -------------------------------------------------------------------------------------
; ACTION = 8 : Enregistre l'arbre dans un fichier spécifié
; -------------------------------------------------------------------------------------
;Entrees: ARBRE  N° de l'arbre à enregistrer
;         RACINE Nom du fichier d'enregistrement

;Rem      Le format utilisé est une succession de champs
;         STRING + LONG pour chaque clef.
;         STRING = Contenu de la clé en cours d'enregistrement
;         LONG   = Niveau de la clé en cours d'enregistrement

;Sortie   REACTION Pointeur vers la chaîne contenant le rapport d'erreur
          
; -------------------------------------------------------------------------------------
; ACTION = 9 : Charge l'arbre depuis un fichier spécifié
; -------------------------------------------------------------------------------------
;Entrees: ARBRE  N° de l'arbre à charger
;         RACINE Nom du fichier de chargement

;Rem      Le format utilisé est une succession de champs
;         STRING + LONG pour chaque clef.
;         STRING = Contenu de la clé en cours d'enregistrement
;         LONG   = Niveau de la clé en cours d'enregistrement

;Sortie   REACTION Pointeur vers la chaîne contenant le rapport d'erreur

[Ollivier]

Voici un petit exemple :
(Et désolé pour les dysfonctionnement de sélection, je débute!)

Code : Tout sélectionner

Procedure.L Arbr(Action.L, Arbre.L, Clef.L, Racine.S) 
  Reaction.L = 0
  ClefFinale.L = CountGadgetItems(Arbre) - 1 
  If Action <= 5 
    JeunesseClef.L = GetGadgetItemAttribute(Arbre, Clef, #PB_Tree_SubLevel) 
    Select Action 
    Case 0: ClearGadgetItemList(Arbre): Clef = -1: JeunesseClef = 0
    Case 1 
      For i = Clef To 0 Step -1 
        Jeunesse = GetGadgetItemAttribute(Arbre, i, #PB_Tree_SubLevel) 
        If Jeunesse < JeunesseClef: Clef = i: i = 0 
        ElseIf Jeunesse = 0: Clef = -1: i = 0: EndIf 
      Next i 
    Case 2, 3, 5 
      ClefFinale = CountGadgetItems(Arbre) 
      For i = Clef + 1 To ClefFinale 
        Jeunesse = GetGadgetItemAttribute(Arbre, i, #PB_Tree_SubLevel) 
        If Action = 5: If Jeunesse <= JeunesseClef: Clef = i - 1: i = ClefFinale: EndIf 
        ElseIf Action = 2: If Jeunesse > JeunesseClef: Clef = i: EndIf 
          If Jeunesse <= JeunesseClef: i = ClefFinale: EndIf 
        Else: If Jeunesse => JeunesseClef: Clef = i: EndIf 
          If Jeunesse < JeunesseClef: i = ClefFinale: EndIf 
        EndIf 
      Next 
      If Action = 5: JeunesseClef + 1: EndIf 
    Case 4: JeunesseClef + 1 
    EndSelect    
    AddGadgetItem(Arbre, Clef + 1, Racine, 0, JeunesseClef)
    If Action = 4 Or Action = 5: SetGadgetItemState(Arbre, Clef, #PB_Tree_Expanded): EndIf 
  Else 
    Select Action      
    Case 8 
      Reaction.L = CreateFile(#PB_Any, Racine) 
      If Reaction <> 0 
        For i = 0 To ClefFinale 
          WriteLong(Reaction, GetGadgetItemAttribute(Arbre, i, #PB_Tree_SubLevel) ) 
          WriteStringN(Reaction, GetGadgetItemText(Arbre, i) ) 
        Next 
      EndIf 
    Case 9: Reaction = ReadFile(#PB_Any, Racine) 
      If Reaction <> 0: i.L = 0 
        ClearGadgetItemList(Arbre) 
        Repeat 
          Level.L = ReadLong(Reaction) 
          String.s = ReadString(Reaction) 
          AddGadgetItem(Arbre, i, String, 0, Level): i + 1 
        Until Eof(Reaction) 
      EndIf      
    EndSelect 
    If IsFile(Reaction): CloseFile(Reaction): EndIf 
    ProcedureReturn Reaction 
  EndIf 
EndProcedure 

Global DSt.S = "" 
DSt + "GFFGFFG8F0GDF68F0GBF68F770G4F7G1F8FG070G3F77FFF8FG078G4F7F888FG07866G3F77FFFG078" 
DSt + "G06G3FG378F4G06G2FG278FFF4G06G2FG178G0F4G06G2FG078G1F4G06G2FG17G1F466G5FG07G1F46" 
DSt + "GFF4GFFGFFGFFGFFG6FGBCFG09CG9ECFG09GBCF99GEF99FFGB7F99GD7F99FFGB7F99GEF99FFGB9FG" 
DSt + "19G9B9FGF9FF7GFF7FFGB7FFGE7FF7FFGB7FF7GFF7FFGB7FFGE7G1FGB7GFFG2FGB7FFGE7FF7FFGB7" 
DSt + "FF7GFF7FFGB7FFGE7FF7FFGB7FF7GFF7FFGB9FG19G9B9FGF9F99GEF99FFGBCFG09CG9ECFG09GBCFF" 
DSt + "7GFF7FFGB7FFGE7G1FGB7GFFG2FGB7FFGE7FF7FFGB7FF7GFF7FFGB7FFGE7FF7FFGB7FF7GFF7FFGB9" 
DSt + "FG19G9B9FGF9F99GEF99FFGB7F99GD7F99FFGB7F99GEF99FFGBCFG09CG9ECFG09GBCGFFFFGB9G1F9" 
DSt + "G9B9G1FGB9G1F99GEF99FFFGACFG19CG8ECFG19GACFF7GFF7FFFGA7FFGE7FF7FFFGA7FF7GFF7FFFG" 
DSt + "A7FFGE7FF7FFFGA7FF7GFF7FFFGA7FFGE7G2FGA7GFFFFGB9G1F9G9B9G1FGB9G1F99GEF99FFFGA7F9" 
DSt + "9GD7F99FFFGA7F99GEF99FFFGA7F99GD7F99FFFGA7F99GEF99FFFGA7F99GD7F99FFFGA7F99GEF99F" 
DSt + "FFGACFG19CG8ECFG19GACGFFFFG20G57000FFG20G170007G00FG20G170007G00FG20G170007G00FG" 
DSt + "20G170007G00FG20G170007G00FG20G57G00FGF0F000G9F000F000G1F000G1F000F000G0F07F70G0" 
DSt + "F000F000G0F7FF70G0F000F000G2F70G1F000F000G2F0G2F000F000G9F000F000G2F0G2F000F000G" 
DSt + "2F7G2F000F0FGB0F0FGF0GFFGFFGFFGFFG6F00GDF0FF0GFFF0F0GEF00GDF000G6F000GCF0EEEG50G" 
DSt + "3F0G7E0G3F0G7E0G3F0G7E0G3F0G0EG80FFF0EEE0G7E0FFF0EE0G7E0G0F0E0G7E0G1F00G7E0G2FG9" 
DSt + "0GFFG4F" 

Procedure.L ValHex(a.s) 
  x = Asc(a): If x < 58: S = x - 48: Else: S = x - 55: EndIf: ProcedureReturn S 
EndProcedure 

Procedure RecupIco() 
  Ico.S = "" 
  For i = 1 To Len(DSt): A.S = Mid(DSt, i, 1) 
    If A = "G": N.S = Mid(DSt, i + 1, 1) 
      A = Mid(DSt, i + 2, 1): For j = 1 To 4 + ValHex(N): Ico + A: Next: i + 2 
    Else: Ico + A 
    EndIf 
  Next: Adr = 0 
  For ix = 0 To 7 
    CreateImage(ix, 20, 20): StartDrawing(ImageOutput(ix) ) 
      For y = 0 To 19 
        For x = 0 To 19 
          Adr + 1: Pt = ValHex(Mid(Ico, Adr, 1)) 
          If Pt & 8: coef = 255: Else: coef = 128: EndIf 
          R = ((Pt & 4) >> 2) * coef: V = ((Pt & 2) >> 1) * coef: B = ((Pt & 1) ) * coef 
          C = RGB(R, V, B): If Pt = 7: C = RGB(192, 192, 192): EndIf          
          If Pt = 8: C = RGB(128, 128, 128): EndIf: Plot(x, y, C) 
        Next 
      Next 
      StopDrawing() 
    Next 
EndProcedure 

Procedure Enreg(Gadget) 
  Repeat 
    Repeat          
      Name.S = SaveFileRequester("Enregistrer sous", "", "Tout type de fichier|*.*;Base de données|*.BDD", 1) 
      If Name = "": Goto ExitEnreg: EndIf 
      If 0 Or FileSize(Name) = -2: MessageRequester("Message", "Nom de fichier invalide !", 0): EndIf 
    Until FileSize(Name) <> -2  
    If FileSize(Name) <> -1 
      Mess = MessageRequester("Message", "Le fichier " + Name + " existe déjà ! Voulez-vous l'écraser ?", #PB_MessageRequester_YesNoCancel) 
      If Mess = #PB_MessageRequester_Cancel: Goto ExitEnreg: EndIf 
    EndIf 
  Until FileSize(Name) = -1 Or Mess = #PB_MessageRequester_Yes 
  Arbr(8, Gadget, 0, Name) 
ExitEnreg: 
EndProcedure 

Procedure Charge(Gadget) 
  Name.S = OpenFileRequester("Ouvrir", "", "Tout type de fichier|*.*;Base de données|*.BDD", 1) 
  If FileSize(Name) < 0 
    MessageRequester("Message", "Nom de fichier incorrect ou inexistant !", 0)    
  Else 
    Arbr(9, Gadget, 0, Name) 
  EndIf 
EndProcedure 

;************************************************************************  
; PREPARATION MENU 
;************************************************************************  
  ; On récupère les icônes 
  ;************************ 
  RecupIco() 

  ; On crée la fenêtre du menu 
  ;**************************** 
  OpenWindow(0, 10, 10, 28, 28 * 8, "x", #PB_Window_BorderLess) 
  StickyWindow(0, 1) 
  HideWindow(0, 1) 

  ; On crée les boutons du menu 
  ;****************************** 
  CreateGadgetList(WindowID(0) ) 
  For i = 0 To 7 
    ButtonImageGadget(i, 0, 28 * i, 28, 28, ImageID(i) ) 
  Next i 
  
  ; On rajoute un peu d'aide 
  ;************************** 
  GadgetToolTip(0, "Détruire l'arbre") 
  GadgetToolTip(1, "Crée une clé 'soeur ainée'") 
  GadgetToolTip(2, "Crée une clé 'soeur cadette'") 
  GadgetToolTip(3, "Crée une clé 'soeur benjamine'") 
  GadgetToolTip(4, "Crée une clé 'enfant ainé'") 
  GadgetToolTip(5, "Crée une clé 'enfant benjamin'") 
  GadgetToolTip(6, "Enregistrer sous") 
  GadgetToolTip(7, "Ouvrir") 
;************************************************************************  
;************************************************************************  
  
  
;************************************************************************  
;  PREPARATION FENETRE PRINCIPALE 
;************************************************************************  
  ; On crée la fenêtre 
  ;******************** 
  OpenWindow(1, 0, 0, 400, 450, "ArBr", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_SizeGadget) 
  
  ; On crée le TreeGadget 
  ;*********************** 
  CreateGadgetList(WindowID(1) ) 
  Global Gadget = TreeGadget(-1, 0, 0, 400, 450, #PB_Tree_AlwaysShowSelection) 
  LoadFont(0, "Verdana", 16, #PB_Font_Italic) 
  SetGadgetFont(Gadget, FontID(0) ) 
  
  ; On crée un menu PopUp 
  ;*********************** 
  CreatePopupMenu(0) 
  MenuItem(0, "Renommer") 
  MenuItem(1, "Supprimer") 
  
  ; Derniers préparatifs 
  ;********************** 
  Arbr(0, Gadget, 0, "(vide)") 
  SetGadgetState(Gadget, 0)
  ResizeWindow(0, WindowX(1) - 30, WindowY(1) + 30, #PB_Ignore, #PB_Ignore) 
  HideWindow(0, 0)  
  
;************************************************************************  
;************************************************************************  
  
  
  
  
  
  ; On fait une boucle d'événements 
  ;********************************* 
  Global Modified.L = 0  
  Repeat 
    Ev = WaitWindowEvent()    
    Selected = GetGadgetState(Gadget) 
    Select Ev 
    Case #WM_RBUTTONDOWN 
      DisplayPopupMenu(0, WindowID(1) )      
    Case #PB_Event_Gadget 
      Gadg = EventGadget() 
      Select Gadg 
      Case 0: Nouv = 0      
        Arbr(0, Gadget, 0, "(vide_" + Str(Nouv) + ")"): Modified = 1 
      Case 1, 2, 3, 4, 5 
        ;If Selected <> -1 
        ;  OldSelected = Selected 
        Nouv + 1
        Arbr(Gadg, Gadget, Selected, "(vide_" + Str(Nouv) + ")"): Modified = 1 
        ;Else 
        ;  Selected = OldSelected 
        ;EndIf 
      Case 6 
        Enreg(Gadget) 
      Case 7 
        Charge(Gadget) 
      EndSelect 
    Case #PB_Event_Menu 
      Select EventMenu() 
      Case 0 
        SetGadgetItemText(Gadget, Selected, InputRequester("Renommer", "Entrez le nouveau nom :", GetGadgetItemText(Gadget, Selected) ) ) 
        Modified = 1 
      Case 1 
        If MessageRequester("Confirmer", "Voulez-vous réellement supprimer " + GetGadgetItemText(Gadget, Selected) + " ?", #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes 
          RemoveGadgetItem(Gadget, Selected): Modified = 1 
          If CountGadgetItems(Gadget) = 0 
            Arbr(0, Gadget, 0, "(vide)") 
          EndIf 
        EndIf 
      EndSelect 
    Case #PB_Event_SizeWindow 
      ResizeGadget(Gadget, 0, 0, WindowWidth(1), WindowHeight(1) )      
    Case #PB_Event_MoveWindow 
      ResizeWindow(0, WindowX(1) - 30, WindowY(1) + 30, #PB_Ignore, #PB_Ignore) 
    Case #PB_Event_CloseWindow 
      If Modified 
        Mess = MessageRequester("Message", "Le document n'a pas été enregistré. Souhaitez-vous le faire maintenant ?", #PB_MessageRequester_YesNoCancel) 
        Select Mess 
          Case #PB_MessageRequester_Yes 
            Enreg(Gadget) 
          Case #PB_MessageRequester_No 
            Quit = 1 
        EndSelect 
      Else 
        Quit = 1 
      EndIf      
    EndSelect 
  Until Quit = 1 

[Droopy]

T'es trop fort avec les TreeGadget Ollivier

ScreenShot : http://purebasic.myftp.org/?filename=fi ... livier.jpg

[Ollivier]

Hey Droopy, tu peux mettre un petit screenshoot sur le post? Ce serait vraiment cool! Je peux pas le faire actuellement...

Merci Droopy

Une autre appli non finie: un trip sur les pliages

Code : Tout sélectionner

;{ Globals }
Global ClipBoard.S
Global WindowTextTree.L
;}

Procedure.B DirectiveControl(TextLine.S, DirGroup.S)
  ; Called by TextAddLine()
  IsDirective.B = 0
  TextLine = UCase(TextLine)
  DirGroup = UCase(DirGroup)
  ExitFor.L = CountString(DirGroup, "|")
  For i = 0 To ExitFor
    Dir.S = StringField(DirGroup, i + 1, "|")
    LenDir = Len(Dir)
    If Left(TextLine, LenDir) = Dir
      EndChar = Asc(Mid(TextLine, LenDir + 1, 1) )
      If EndChar < 65 Or EndChar > 90
        IsDirective = 1
        i = ExitFor
      EndIf
    Else
      IsDirective = 0
    EndIf
  Next
  ProcedureReturn IsDirective
EndProcedure

Procedure TextAddLine(Gadget.L, TextLine.S = "")
  Static LineNumber.L
  Static Level.L
  If Gadget = -1
    LineNumber = 0
    Level = 0
  Else
    TextLine = LTrim(TextLine)
    If TextLine <> ""
      AddGadgetItem(Gadget, LineNumber, TextLine, 0, Level)
    EndIf    
    If DirectiveControl(TextLine, ";}|EndProcedure|EndIf|Next|EndEnumeration|Until|ForEver")
      Level - 1
    EndIf
    If DirectiveControl(TextLine, ";{|Procedure|If|For|Enumeration|Repeat")
      Level + 1
    EndIf
    LineNumber + 1
  EndIf
EndProcedure

Procedure Text2Tree(TextTree)
  TextLine.S = ""
  KeyWordMode.B = 1
  TextAddLine(-1)
  For i = 1 To Len(ClipBoard)
    LineChar.B = Asc(Mid(ClipBoard, i, 1) )
    If LineChar = 34
      KeyWordMode = 1 - KeyWordMode
    EndIf
    If LineChar = 13 Or (LineChar = 58 And KeyWordMode = 1)
      TextAddLine(TextTree, TextLine)
      TextLine = ""
      i + 1
    Else
      TextLine + Chr(LineChar)
    EndIf
  Next
  TextAddLine(TextTree, TextLine)
  TextLine = ""
EndProcedure

Procedure.L InitTree()
  WindowTextTree = OpenWindow(-1, 10, 10, 450, 600, "Press [Ctrl A] and [Ctrl C] in your PB editor before running", #PB_Window_SystemMenu| #PB_Window_SizeGadget)
  CreateGadgetList(WindowID(WindowTextTree) )
  TextTree.L = TreeGadget(-1,0, 0, 400, 300)
  TextTreeFont.L = LoadFont(-1, "Courier New", 10)
  SetGadgetFont(TextTree, FontID(TextTreeFont) )
  ProcedureReturn TextTree
EndProcedure

Procedure Main()
  ClipBoard = GetClipboardText()

  TextTree = InitTree()
  Text2Tree(TextTree)

  Repeat
    Ev = WaitWindowEvent()
    If Ev = #PB_Event_SizeWindow
      ResizeGadget(TextTree, 0, 0, WindowWidth(WindowTextTree), WindowHeight(WindowTextTree) )
    EndIf
  Until Ev = #PB_Event_CloseWindow
EndProcedure

  Main()

[Kwai chang caine]

Trop cool.......
Y m'épate, Y m'épate, Y m'épate, ....

[Backup]

je viens de mettre ce post dans les tuto ! Merci ..

[Ollivier]

@kcc

J'essaie de rendre un peu le plaisir que certain m'offre à partager des bons petits code. C'est une bonne ambiance tout ça

[beauregard]

J'essaie de rendre un peu le plaisir que certain m'offre à partager des bons petits code. C'est une bonne ambiance tout ça

on peut même dire pour l'amour du code

[Ollivier]

Désolé pour le code que j'ai pu faire. J'ai misé sur la convivialité "copier/coller/exécuter"

C'est vrai qu'un vrai tuto c'est aussi une explication correcte du code. D'autant plus que mes noms de variables et noms de procédures sont en Anglais.