TreeGadget

Ollivier · Post by **Ollivier** » Mon Jul 23, 2007 8:53 pm

Hi, I'm new. So, sorry if anybody created same code.
I'll think to translate variables' names

If anybody could help me to write an algo to update the position of the menu's window when I move the main window, it'd be cool :D

Thanks!

Code: Select all

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

Seven available TreeGadget's actions (translated it's better):

Code: Select all


  
Procedure TreeCreateFirstSister(Gadget.l, Item.l, Name.s)

  ItemLevel = GetGadgetItemAttribute(Gadget, Item, #PB_Tree_SubLevel)
  
  ExitFor = 0 
  
  For i = Item + 1 To 0 Step -1
  
    LevelControl = GetGadgetItemAttribute(Gadget, i, #PB_Tree_SubLevel) 
    If LevelControl < ItemLevel
      Item = i
      i = ExitFor
    EndIf
        
  Next i
  
  AddGadgetItem(Gadget, Item + 1, Name, 0, ItemLevel)
  
EndProcedure



Procedure TreeCreateNextSister(Gadget.l, Item.l, Name.s)

  ItemLevel = GetGadgetItemAttribute(Gadget, Item, #PB_Tree_SubLevel)
  
  ExitFor = CountGadgetItems(Gadget)
  
  For i = Item + 1 To ExitFor 
  
    LevelControl = GetGadgetItemAttribute(Gadget, i, #PB_Tree_SubLevel) 
    
    If LevelControl > ItemLevel
      Item = i
    EndIf 
    
    If LevelControl <= ItemLevel
      i = ExitFor
    EndIf   
    
  Next i
  
  AddGadgetItem(Gadget, Item + 1, Name, 0, ItemLevel)
  
EndProcedure



Procedure TreeCreateLastSister(Gadget.l, Item.l, Name.s)

  ItemLevel = GetGadgetItemAttribute(Gadget, Item, #PB_Tree_SubLevel)
  
  ExitFor = CountGadgetItems(Gadget) 
  
  For i = Item + 1 To ExitFor
  
    LevelControl = GetGadgetItemAttribute(Gadget, i, #PB_Tree_SubLevel) 
    
    If LevelControl => ItemLevel
      Item = i
    EndIf 
    If LevelControl < ItemLevel
      i = ExitFor
    EndIf 
    
  Next i 
  
  AddGadgetItem(Gadget, Item + 1, Name, 0, ItemLevel) 
  
EndProcedure



Procedure TreeCreateFirstChild(Gadget.l, Item.l, Name.s)

  ItemLevel = GetGadgetItemAttribute(Gadget, Item, #PB_Tree_SubLevel) 
  AddGadgetItem(Gadget, Item + 1, Name, 0, ItemLevel + 1) 
  SetGadgetItemState(Gadget, Item, #PB_Tree_Expanded) 
  
EndProcedure



Procedure TreeCreateLastChild(Gadget.l, Item.l, Name.s)

  ItemLevel = GetGadgetItemAttribute(Gadget, Item, #PB_Tree_SubLevel) 
  
  ExitFor = CountGadgetItems(Gadget) 
  
  For i = Item + 1 To ExitFor 
  
    LevelControl = GetGadgetItemAttribute(Gadget, i, #PB_Tree_SubLevel) 
    
    If LevelControl <= ItemLevel
      Item = i - 1
      i = ExitFor
    EndIf 
    
  Next i
   
  AddGadgetItem(Gadget, Item + 1, Name, 0, ItemLevel + 1) 
  SetGadgetItemState(Gadget, Item, #PB_Tree_Expanded) 
  
EndProcedure



Procedure.s LoadTree(FileNameString.s)

  If FileNameString <> ""
  
    File.l = ReadFile(#PB_Any, FileNameString)
    
    If File <> 0
    
      Item = 0
      
      Repeat
      
        Level.l = ReadLong(File)
        ValueString.s = ReadString(File)
        AddGadgetItem(Gadget, Item, ValueString, 0, Level)
        Item + 1
        
      Until Eof(File)
      
      CloseFile(File)
      
    Else
    
      FileNameString = ""
      
    EndIf    
  EndIf
  
  ProcedureReturn FileNameString
EndProcedure



Procedure.l SaveTree(FileNameString.s)

  File = CreateFile(#PB_Any, FileNameString)
  
  If File <> 0
  
    For i = 0 To CountGadgetItems(Gadget) - 1
    
      StringValue.s = GetGadgetItemText(Gadget, i)     
      Level.l = GetGadgetItemAttribute(Gadget, i, #PB_Tree_SubLevel)
      WriteLong(File, Level)
      WriteStringN(File, StringValue)
      
    Next
    
    CloseFile(File)
  EndIf
  
  ProcedureReturn File
EndProcedure

netmaestro · Post by **netmaestro** » Mon Jul 23, 2007 10:13 pm

If anybody could help me to write an algo to update the position of the menu's window when I move the main window, it'd be cool

Procedure WinProc and SetWindowCallBack are the only changes made, also removed move code from main loop as it's no longer meaningful.

Code: Select all

Procedure WinProc(hwnd, msg, wparam, lparam)
  result = #PB_ProcessPureBasicEvents
  Select msg
    Case #WM_MOVING
      ResizeWindow(0, WindowX(1) - 30, WindowY(1) + 30, #PB_Ignore, #PB_Ignore)
  EndSelect
  ProcedureReturn result
EndProcedure
  
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) 
  SetWindowCallback(@WinProc(), 1)
  
  ; 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_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

Ollivier · Post by **Ollivier** » Mon Jul 23, 2007 11:54 pm

Excellent. My new prog is cool now!

Tree is the base for me, cause informations start only from one point.

Thank you!

SeregaZ · Post by **SeregaZ** » Fri Sep 28, 2012 3:58 pm

I have a question about TreeGadget and use menu. why this menu is open, when i pres right button on clear place, not on some item on this TreeGadget. i want to open menu only when mouse over some select item. if mouse over free-white space of TreeGadget - do not open menu.

RASHAD · Post by **RASHAD** » Fri Sep 28, 2012 4:58 pm

That is an old thread
Try

Code: Select all

If OpenWindow(0, 0, 0, 400, 600, "TreeGadget", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  TreeGadget(0, 10, 10, 380, 580,#PB_Tree_CheckBoxes)
    For a = 0 To 10
      AddGadgetItem (0, -1, "Normal Item "+Str(a), 0, 0)
      AddGadgetItem (0, -1, "Node "+Str(a), 0, 0)
      AddGadgetItem(0, -1, "Sub-Item 1", 0, 1)
      AddGadgetItem(0, -1, "Sub-Item 2", 0, 1)
      AddGadgetItem(0, -1, "Sub-Item 3", 0, 1)
      AddGadgetItem(0, -1, "Sub-Item 4", 0, 1)
      AddGadgetItem (0, -1, "File "+Str(a), 0, 0)
    Next
      
CreatePopupMenu(0)
  MenuItem(1, "Open")
  MenuItem(2, "Save")
  MenuItem(3, "Save as")
  MenuItem(4, "Quit")
  MenuBar()
  hmnuSub = OpenSubMenu("Recent files")
  MenuItem(5, "PureBasic.exe")
  MenuItem(6, "Test.txt")
CloseSubMenu()
r.RECT
Repeat
  Select WaitWindowEvent()
     
    Case #PB_Event_CloseWindow
      Quit = 1         

                       
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0
        Select EventType()
            Case #PB_EventType_RightClick
                 r\left = GadgetItemID(0, GetGadgetState(0))
                 SendMessage_(GadgetID(0),#TVM_GETITEMRECT,1,@r)
                 GetCursorPos_(p.POINT)
                 ScreenToClient_(GadgetID(0),@p)
                 If p\x <= r\Right
                    DisplayPopupMenu(0, WindowID(0))
                 EndIf
        EndSelect
      EndSelect
  EndSelect
Until Quit = 1
EndIf

SeregaZ · Post by **SeregaZ** » Fri Sep 28, 2012 5:24 pm

super! thanks

for more i change If p\x <= r\Right to If p\x <= r\Right And p\x >= r\Left And p\y <= r\bottom And p\y >= r\top

SeregaZ · Post by **SeregaZ** » Fri Sep 28, 2012 6:17 pm

hm... one more: left click make select some item only if mouse over this item. but right click make select when you are over free space, but on the same line, where is lay some item. how to ban this right selection?

PureBasic Forums - English

TreeGadget

TreeGadget

Re: TreeGadget

Re: TreeGadget

Re: TreeGadget

Re: TreeGadget