Basic Univers



;- REQUETE MESSAGE
#MessReqYesNo = #PB_MessageRequester_YesNo
; Pour afficher les boutons 'Oui' et 'Non'
#MessReqYesNoCancel = #PB_MessageRequester_YesNoCancel
; Pour afficher les boutons 'Oui', 'Non' et 'Annuler'
#MessReqOk = #PB_MessageRequester_Ok
; Pour afficher seulement le bouton 'OK'

;(RETOUR)
#MessReqYes = #PB_MessageRequester_Yes
; Le bouton 'Oui' a été pressé
#MessReqNo = #PB_MessageRequester_No
; Le bouton 'Non' a été pressé
#MessReqCancel = #PB_MessageRequester_Cancel
; Le bouton 'Annuler' a été pressé



Procedure TreeFirstSister(Gadget.l, Item.l, Name.s)
  ItemNiveau = GetGadgetItemAttribute(Gadget, Item, #PB_Tree_SubLevel)
  ExitFor = 0
  For i = Item + 1 To 0 Step - 1
    TestNiveau = GetGadgetItemAttribute(Gadget, i, #PB_Tree_SubLevel)
    If TestNiveau < ItemNiveau: Item = i: i = ExitFor: EndIf
  Next i
  AddGadgetItem(Gadget, Item + 1, Name, 0, ItemNiveau)
EndProcedure

Procedure TreeNextSister(Gadget.l, Item.l, Name.s)
  ItemNiveau = GetGadgetItemAttribute(Gadget, Item, #PB_Tree_SubLevel)
  ExitFor = CountGadgetItems(Gadget)
  For i = Item + 1 To ExitFor
    TestNiveau = GetGadgetItemAttribute(Gadget, i, #PB_Tree_SubLevel)
    If TestNiveau > ItemNiveau: Item = i: EndIf
    If TestNiveau <= ItemNiveau: i = ExitFor: EndIf
  Next i
  AddGadgetItem(Gadget, Item + 1, Name, 0, ItemNiveau)
EndProcedure

Procedure TreeLastSister(Gadget.l, Item.l, Name.s)
  ItemNiveau = GetGadgetItemAttribute(Gadget, Item, #PB_Tree_SubLevel)
  ExitFor = CountGadgetItems(Gadget)
  For i = Item + 1 To ExitFor
    TestNiveau = GetGadgetItemAttribute(Gadget, i, #PB_Tree_SubLevel)
    If TestNiveau => ItemNiveau: Item = i: EndIf
    If TestNiveau < ItemNiveau: i = ExitFor: EndIf
  Next i
  AddGadgetItem(Gadget, Item + 1, Name, 0, ItemNiveau)
EndProcedure

Procedure TreeFirstChild(Gadget.l, Item.l, Name.s)
  ItemNiveau = GetGadgetItemAttribute(Gadget, Item, #PB_Tree_SubLevel)
  AddGadgetItem(Gadget, Item + 1, Name, 0, ItemNiveau + 1)
  SetGadgetItemState(Gadget, Item, #PB_Tree_Expanded)
EndProcedure

Procedure TreeLastChild(Gadget.l, Item.l, Name.s)
  ItemNiveau = GetGadgetItemAttribute(Gadget, Item, #PB_Tree_SubLevel)
  ExitFor = CountGadgetItems(Gadget)
  For i = Item + 1 To ExitFor
    TestNiveau = GetGadgetItemAttribute(Gadget, i, #PB_Tree_SubLevel)
    If TestNiveau <= ItemNiveau: Item = i - 1: i = ExitFor: EndIf
  Next i
  AddGadgetItem(Gadget, Item + 1, Name, 0, ItemNiveau + 1)
  SetGadgetItemState(Gadget, Item, #PB_Tree_Expanded)
EndProcedure

Procedure.s LoadTree(Fich.s)
  If Fich <> ""
    File.l = ReadFile(#PB_Any, Fich)
    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
      Fich = ""
    EndIf
  EndIf
  ProcedureReturn Fich
EndProcedure

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


Declare TreeDelete(Gadget, Item)
Declare.s FileSaveAs(Fich.s)
Declare NewTree()
Declare UpDateMenu()
Declare ItemAuteur()
Declare ItemImport()
Declare ItemOuvrir()
Declare ItemSauver()
Declare ItemSauverSous()
Declare ItemInsEnfantAine(Gadget, TreeSelect)
Declare ItemInsEnfantBenja(Gadget, TreeSelect)
Declare ItemInsFrereAine(Gadget, TreeSelect)
Declare ItemInsFrereCadet(Gadget, TreeSelect)
Declare ItemInsFrereBenja(Gadget, TreeSelect)


Gadget = 0
#Menu_TreeEdit = 0

#ItemIns_EnfantAine = 0
#ItemIns_EnfantBenja = 14
#ItemIns_FrereAine = 1
#ItemIns_FrereCadet = 15
#ItemIns_FrereBenja = 16

#ItemSuppr = 2
#ItemModif = 3
#ItemOuvrir = 4
#ItemSauver = 5
#ItemSauverSous = 6
#ItemAuteur = 7
#ItemPropri = 8
#ItemNouv = 9
#ItemCoupe = 10
#ItemCopie = 11
#ItemColleRemplace = 12
#ItemColleEnfant = 12
#ItemColleFrere = 12
#ItemImport = 13


  If OpenWindow(0, 0, 0, 360, 450, "Base de données", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
    LoadFont(0, "verdana", 16, #PB_Font_Italic)
    CreateGadgetList(WindowID(0) )
    TreeGadget(Gadget, 0, 0, 360, 450)
    NewTree()
    Global FichBDD.s
   
    CreatePopupMenu(#Menu_TreeEdit)
    UpDateMenu()
  Else
 
    End
   
  EndIf
 
  Repeat
    Select WaitWindowEvent()
    Case #PB_Event_CloseWindow
      End
    Case #WM_RBUTTONDOWN
      DisplayPopupMenu(0, WindowID(0))
    Case #PB_Event_Menu
      TreeSelect = GetGadgetState(Gadget)
      EvMenu = EventMenu()
      If TreeSelect <> - 1
        Select EvMenu
        Case #ItemIns_EnfantAine: ItemInsEnfantAine(Gadget, TreeSelect)
        Case #ItemIns_EnfantBenja: ItemInsEnfantBenja(Gadget, TreeSelect)
        Case #ItemIns_FrereAine: ItemInsFrereAine(Gadget, TreeSelect)
        Case #ItemIns_FrereCadet: ItemInsFrereCadet(Gadget, TreeSelect)
        Case #ItemIns_FrereBenja: ItemInsFrereBenja(Gadget, TreeSelect)
        Case #ItemSuppr: TreeDelete(Gadget, TreeSelect)
        Case #ItemModif: SetGadgetItemText(Gadget, TreeSelect, InputRequester("Modifier clé", "", GetGadgetItemText(Gadget, TreeSelect, - 1) ), - 1 )
        Case #ItemCoupe:
        Case #ItemCopie:
        Case #ItemColleRemplace:
        Case #ItemColleEnfant:
        Case #ItemColleFrere:
        EndSelect
      EndIf
      Select EvMenu
        Case #ItemAuteur: ItemAuteur()
        Case #ItemImport: ItemImport()
        Case #ItemOuvrir: ItemOuvrir()
        Case #ItemSauver: ItemSauver()
        Case #ItemSauverSous: ItemSauverSous()
        Case #ItemNouv: NewTree()
      EndSelect
    EndSelect
  ForEver

Procedure ItemInsEnfantAine(Gadget, TreeSelect)
  TreeFirstChild(Gadget, TreeSelect, InputRequester("Nouvelle clé 'enfant'", "Donnez un nom pour la nouvelle clé", "") )
EndProcedure

Procedure ItemInsEnfantBenja(Gadget, TreeSelect)
  TreeLastChild(Gadget, TreeSelect, InputRequester("Nouvelle clé 'enfant'", "Donnez un nom pour la nouvelle clé", "") )
EndProcedure
 
Procedure ItemInsFrereAine(Gadget, TreeSelect)
  TreeFirstSister(Gadget, TreeSelect, InputRequester("Nouvelle clé 'soeur'", "Donnez un nom pour la nouvelle clé", "") )
EndProcedure

Procedure ItemInsFrereCadet(Gadget, TreeSelect)
  TreeNextSister(Gadget, TreeSelect, InputRequester("Nouvelle clé 'soeur'", "Donnez un nom pour la nouvelle clé", "") )
EndProcedure

Procedure ItemInsFrereBenja(Gadget, TreeSelect)
  TreeLastSister(Gadget, TreeSelect, InputRequester("Nouvelle clé 'soeur'", "Donnez un nom pour la nouvelle clé", "") )
EndProcedure
 
Procedure ItemAuteur()
  MessageRequester("A propos de...", "Ollivier qui aime beaucoup les TreeGadgets, ça le fait délirer :)", 0)
EndProcedure

Procedure ItemImport()
  SetWindowTitle(0, LoadTree(OpenFileRequester("Ouvrir", "Facture\", "Base de données|*.BDD", 1) ) )
EndProcedure

Procedure ItemOuvrir()
  Fich.s = OpenFileRequester("Ouvrir", "Facture\", "Base de données|*.BDD", 1)
  If Fich <> ""
    NewTree()
    RemoveGadgetItem(Gadget, 0):
    LoadTree(Fich)
    SetWindowTitle(0, Fich)
  EndIf
EndProcedure

Procedure ItemSauver()
  SaveTree(GetWindowTitle(0) )
EndProcedure
 
Procedure ItemSauverSous()
  Fich.s = FileSaveAs(GetWindowTitle(0) )
  If CountString(Fich, ".")
    Fich = StringField(Fich, 1, ".") + "." + StringField(Fich, 2, ".")
  EndIf
  SetWindowTitle(0, Fich)
EndProcedure
   
Procedure NewTree()
  UseGadgetList(WindowID(0) )
  FreeGadget(Gadget)
  TreeGadget(Gadget, 0, 0, 360, 450)
  SetWindowTitle(0, "Base de données")
  AddGadgetItem(Gadget, 0, "Root", 0, 0)
  SetGadgetFont(Gadget, FontID(0) )
EndProcedure
 
Procedure TreeDelete(Gadget, Item)
  If MessageRequester("Confirmation", "Voulez-vous vraiment supprimer " + GetGadgetItemText(Gadget, Item, - 1) + " ?", #MessReqYesNo) = #MessReqYes
    RemoveGadgetItem(Gadget, Item)
    If CountGadgetItems(Gadget) = 0
      NewTree()
    EndIf
  EndIf
EndProcedure

Procedure.s FileSaveAs(Fich.s)
  OldFich.s = Fich
RequesterSave:
  Fich = SaveFileRequester("Enregistrer", "Facture\", "Base de données|*.BDD", 1) + ".BDD"
  If Fich <> ""
    If FileSize(Fich) = - 1
ForceSave:
      Result = SaveTree(Fich)
      If Result = 0
        MessageRequester("Message", "L'enregitrement a échoué" + Chr(10) + "- Accès en écriture refusé sur le lecteur" + Chr(10) + "- Lecteur plein", 0)
        OldFich = Fich
      EndIf
    Else
      If FileSize(Fich) = - 2
        MessageRequester("Message", "L'enregitrement a échoué" + Chr(10) + "- Le nom de fichier spécifié correspond à un nom de dossier !", 0)
        OldFich = Fich
      Else
        If MessageRequester("Enregistrer", "Le fichier " + Fich + " existe déjà." + Chr(10) + "Souhaitez-vous l'écraser ?", #PB_MessageRequester_YesNo) = #PB_MessageRequester_Yes
          Goto ForceSave
        Else
          Goto RequesterSave
        EndIf
      EndIf
    EndIf
  Else
    Fich = OldFich
  EndIf
  ProcedureReturn Fich
EndProcedure

Procedure UpDateMenu()
    FreeMenu(#Menu_TreeEdit)
    CreatePopupMenu(#Menu_TreeEdit)
    OpenSubMenu("Clé")
      OpenSubMenu("Créer")
        OpenSubMenu("Clé 'enfant'")
          MenuItem(#ItemIns_EnfantAine, "Ainée")
          MenuItem(#ItemIns_EnfantBenja, "Benjamine")
        CloseSubMenu()
        OpenSubMenu("Clé 'soeur'")
          MenuItem(#ItemIns_FrereAine, "Ainée")
          MenuItem(#ItemIns_FrereCadet, "Cadète")
          MenuItem(#ItemIns_FrereBenja, "Benjamine")
        CloseSubMenu()
      CloseSubMenu()
      MenuItem(#ItemModif, "Modifier")
      MenuItem(#ItemSuppr, "Supprimer")
    CloseSubMenu()
    OpenSubMenu("Fichier")
      MenuItem(#ItemNouv, "Nouveau")
      MenuItem(#ItemOuvrir, "Ouvrir")
      MenuItem(#ItemImport, "Importer")
      MenuItem(#ItemSauver, "Enregistrer")
      MenuItem(#ItemSauverSous, "Enregistrer sous")
    CloseSubMenu()
    MenuBar()
    MenuItem(#ItemAuteur, "A propos de...")
EndProcedure