Basic Univers
#MessReqYesNo = #PB_MessageRequester_YesNo
#MessReqYesNoCancel = #PB_MessageRequester_YesNoCancel
#MessReqOk = #PB_MessageRequester_Ok
#MessReqYes = #PB_MessageRequester_Yes
#MessReqNo = #PB_MessageRequester_No
#MessReqCancel = #PB_MessageRequester_Cancel
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