[TUTO] Sauver vos List / Map / Structure avec Json

Informations pour bien débuter en PureBasic
Répondre
Avatar de l’utilisateur
microdevweb
Messages : 1800
Inscription : mer. 29/juin/2011 14:11
Localisation : Belgique

[TUTO] Sauver vos List / Map / Structure avec Json

Message par microdevweb »

Le meilleur moyen pour sauvegarder vos List / Map / Structure est l'utilisation de Json. Cependant si vous utilisé une liaison avec l'adresse mémoire d'une autre liste, vous aller rencontrer un problème :mrgreen:
Je vous invite à regardé ces 2 procédures

Code : Tout sélectionner

ChangeMemorisToIndex()
ChangeIndexToMemoris()


Dans cette exemple simple de Base de donnée je montre comment sauvegarder en Json, ainsi qu'une petite gestion multi langue simplifiée.

:arrow: Pour tester:
  • Sauver le code en (nom.pb)
  • Compiler le code et ajouter des article à votre panier
  • Sauvegarder vos donnée Fichier --> Sauver
  • Quitter le programme
  • Désactiver ceci

    Code : Tout sélectionner

    Procedure OpenMainForm()
      ;BuildDataOfTesting()
  • Compiler le code (les liste seront vide normal :wink: )
  • Ouvrez le fichier (sauvegarder avant) Fichier --> Ouvrir
Voila j'espère que cela vous sera utile

Code : Tout sélectionner

EnableExplicit
Declare OpenMainForm()
Declare FillsBasket()
Declare FillsProducts()
; La structure des produits
; The structure of products
Structure product
      name$
      price.f
      *myCategory
EndStructure
; La structure du panier d'achat
; The structure of shopping basquet
Structure basket
      *myProduct
      quantity.i
EndStructure
Structure Db
      ; Une liste pour la catégorie de produit
      ; On lsit for category of product
      List Category$()
      ; La liste de tous les produits
      ; The list of all products
      List myProduct.product()
      ; Le pannier d'achat
      ; The shopping basquet
      List myShoppingBasquet.basket()
EndStructure
; La base de données
; The Database
Global myDb.DB
Global gFileName$
; Gestion de la langue
; Language management
Enumeration Lg
      #Fr
      #En
EndEnumeration     
Enumeration Form
      #LangageForm
      #BtFr
      #BtEn
EndEnumeration
Global gCurrentLangage
Procedure SelectLanguage()
      Select EventGadget()
            Case #BtFr
                  gCurrentLangage=#Fr
            Case #BtEn
                  gCurrentLangage=#En
      EndSelect
      CloseWindow(#LangageForm)
      OpenMainForm()
EndProcedure
Procedure OpenSelectLanguage()
      Protected Flag=#PB_Window_ScreenCentered
      OpenWindow(#LangageForm,0,0,400,90,"",Flag)
      ButtonGadget(#BtFr,10,10,380,30,"Parlez-vous Français ?")
      ButtonGadget(#BtEn,10,50,380,30,"Do you speak English ?")
      BindEvent(#PB_Event_Gadget,@SelectLanguage(),#LangageForm)
EndProcedure
Enumeration Form
      #MainForm
      #MainMenu
      #M_Save
      #M_Open
      #M_Exit
      #Lst_Products
      #Lst_Basket
      #BtAddProduct
      #BtRemoveProduct
EndEnumeration
Procedure CloseMainForm()
      End
EndProcedure
Procedure ChangeIndexToMemoris()
      ; Change l'index de liste de Category en iadresse mémoire
      ; Change the list index of Category in memoris adress
      ForEach myDb\myProduct()
            With myDb\myProduct()
                  SelectElement(myDb\Category$(),\myCategory)
                  \myCategory=@myDb\Category$()
            EndWith
      Next
      ; Change l'adresse mémoire de Product en index de liste
      ; Change the memoris adress of Product in list index
      ForEach myDb\myShoppingBasquet()
            With myDb\myShoppingBasquet()
                  SelectElement(myDb\myProduct(),\myProduct)
                  \myProduct=@myDb\myProduct()
            EndWith
      Next
EndProcedure
Procedure ChangeMemorisToIndex()
      ; Change l'adresse mémoire de Category en index de liste
      ; Change the memoris adress of Category in list index
      ForEach myDb\myProduct()
            With myDb\myProduct()
                  ChangeCurrentElement(myDb\Category$(),\myCategory)
                  \myCategory=ListIndex(myDb\Category$())
            EndWith
      Next
      ; Change l'adresse mémoire de Product en index de liste
      ; Change the memoris adress of Product in list index
      ForEach myDb\myShoppingBasquet()
            With myDb\myShoppingBasquet()
                  ChangeCurrentElement(myDb\myProduct(),\myProduct)
                  \myProduct=ListIndex(myDb\myProduct())
            EndWith
      Next
EndProcedure
Procedure SaveFile()
      Dim txt$(1)
      txt$(#Fr)="Sauvegarde de votre base de données"
      txt$(#En)="Saving your database"
      If gFileName$=""
            gFileName$=SaveFileRequester(txt$(gCurrentLangage),"new_db.mdb","mdb file|*.mdb",0)
            If gFileName$=""
                  ProcedureReturn 
            EndIf
            If Right(gFileName$,4)<>".mdb"
                  gFileName$+".mdb"
            EndIf
      EndIf
      ChangeMemorisToIndex()
      Protected myJson
      myJson=CreateJSON(#PB_Any)
      If myJson=0
            MessageRequester("Json Error","Can not create Json")
            gFileName$=""
            ProcedureReturn 
      EndIf
      InsertJSONStructure(JSONValue(myJson),@myDb,Db)
      If SaveJSON(myJson,gFileName$,#PB_JSON_PrettyPrint)=0
            MessageRequester("Json Error","Can not create a Json File")
            gFileName$=""
            ProcedureReturn 
      EndIf
      ChangeIndexToMemoris()
EndProcedure
Procedure pOpenFile()
      Protected file$,myJson
      Dim txt$(1)
      txt$(#Fr)="Ouvrir de votre base de données"
      txt$(#En)="Open your database"
      file$=OpenFileRequester(txt$(gCurrentLangage),"","mdb file|*.mdb",0)
      If file$=""
            ProcedureReturn 
      EndIf
      gFileName$=file$
      ClearStructure(@myDb,Db)
      InitializeStructure(@myDb,Db)
      myJson=LoadJSON(#PB_Any,file$,#PB_JSON_NoCase)
      If myJson=0
            MessageRequester("Json Error","Line "+Str(JSONErrorLine())+" : "+JSONErrorPosition())
            ProcedureReturn 
      EndIf
      ExtractJSONStructure(JSONValue(myJson),@myDb,DB) 
      ChangeIndexToMemoris()
      FillsProducts()
      FillsBasket()
EndProcedure
Procedure AddProduct()
      If GetGadgetState(#Lst_Products)=-1:ProcedureReturn :EndIf
      ChangeCurrentElement(myDb\myProduct(),GetGadgetItemData(#Lst_Products,GetGadgetState(#Lst_Products)))
      With myDb\myShoppingBasquet()
            ; Recherche si il y a déjà le produit dans le panier, si oui ajoute une pièce
            ; Find if product already exists in the shopping basket, if yes add one part
            ForEach myDb\myShoppingBasquet()
                  If \myProduct=@myDb\myProduct()
                        \quantity+1
                        FillsBasket()
                        SetActiveGadget(#Lst_Products)
                        ProcedureReturn 
                  EndIf
            Next
            AddElement(myDb\myShoppingBasquet())
            \myProduct=@myDb\myProduct()
            \quantity=1
            SetActiveGadget(#Lst_Products)
            FillsBasket()
      EndWith
EndProcedure
Procedure RemoveProduct()
      If GetGadgetState(#Lst_Basket)=-1:ProcedureReturn :EndIf
      ChangeCurrentElement(myDb\myShoppingBasquet(),GetGadgetItemData(#Lst_Basket,GetGadgetState(#Lst_Basket)))
      With myDb\myShoppingBasquet()
            \quantity-1
            If \quantity=0
                  DeleteElement(myDb\myShoppingBasquet())
            EndIf
            FillsBasket()
            SetActiveGadget(#Lst_Basket)
      EndWith
EndProcedure
Procedure FillsBasket()
      Protected Values$
      ClearGadgetItems(#Lst_Basket)
      ForEach myDb\myShoppingBasquet()
            With myDb\myShoppingBasquet()
                  Values$=Str(\quantity)+Chr(10)
                  ChangeCurrentElement(myDb\myProduct(),\myProduct)
                  Values$+myDb\myProduct()\name$
                  AddGadgetItem(#Lst_Basket,-1,Values$)
                  SetGadgetItemData(#Lst_Basket,CountGadgetItems(#Lst_Basket)-1,@myDb\myShoppingBasquet())
            EndWith
      Next
EndProcedure
Procedure  BuildDataOfTesting()
      ; Ajout de quelques catégories (Vous pouvez en ajouter en les séprarant par Chr(10))
      ; Added some categories (You can add any more  separating them Chr(10))
      Protected Tmp$
      Select gCurrentLangage
            Case #Fr
                  Tmp$="Fruits"+Chr(10)+"Légumes"+Chr(10)+"Viandes"
            Case #En
                  Tmp$="Fruits"+Chr(10)+"Vegetables"+Chr(10)+"meat"
      EndSelect
      Protected Nb=CountString(Tmp$,Chr(10)),N
      For N=1 To Nb+1
            AddElement(myDb\Category$())
            myDb\Category$()=StringField(Tmp$,N,Chr(10))
      Next
      ; Ajout de quelques fruits
      ; Added some fruits 
      FirstElement(myDb\Category$())
      Select gCurrentLangage
            Case #Fr
                  Tmp$="pommes\5.60"+Chr(10)+"oranges\6.4"+Chr(10)+"banannes\8.2"
            Case #En
                  Tmp$="apples\5.60"+Chr(10)+"oranges\6.4"+Chr(10)+"bananas\8.2"
      EndSelect
      Nb=CountString(Tmp$,Chr(10))
      For N=1 To Nb+1
            AddElement(myDb\myProduct())
            With myDb\myProduct()
                  \myCategory=@myDb\Category$()
                  \name$=StringField(StringField(Tmp$,N,Chr(10)),1,"\")
                  \price=ValF(StringField(StringField(Tmp$,N,Chr(10)),2,"\"))
            EndWith
      Next
      ; Ajout de quelques légumes
      ; Added some vegetables
      NextElement(myDb\Category$())
      Select gCurrentLangage
            Case #Fr
                  Tmp$="carotes\3,20"+Chr(10)+"poireaux\4.65"+Chr(10)+"laitue\0.85"
            Case #En
                  Tmp$="carrots\3,20"+Chr(10)+"leeks\4.65"+Chr(10)+"lettuce\0.85"
      EndSelect
      Nb=CountString(Tmp$,Chr(10))
      For N=1 To Nb+1
            AddElement(myDb\myProduct())
            With myDb\myProduct()
                  \myCategory=@myDb\Category$()
                  \name$=StringField(StringField(Tmp$,N,Chr(10)),1,"\")
                  \price=ValF(StringField(StringField(Tmp$,N,Chr(10)),2,"\"))
            EndWith
      Next
      ; Ajout de quelques viande
      ; Added some meat
      NextElement(myDb\Category$())
      Select gCurrentLangage
            Case #Fr
                  Tmp$="porc\6,20"+Chr(10)+"boeuf\18.30"+Chr(10)+"poulet\4.75"
            Case #En
                  Tmp$="pig\6,20"+Chr(10)+"beef\18.30"+Chr(10)+"chicken\4.75"
      EndSelect
      Nb=CountString(Tmp$,Chr(10))
      For N=1 To Nb+1
            AddElement(myDb\myProduct())
            With myDb\myProduct()
                  \myCategory=@myDb\Category$()
                  \name$=StringField(StringField(Tmp$,N,Chr(10)),1,"\")
                  \price=ValF(StringField(StringField(Tmp$,N,Chr(10)),2,"\"))
            EndWith
      Next
EndProcedure
Procedure FillsProducts()
      Protected Values$,N
      ForEach myDb\Category$()
            N=0
            ForEach myDb\myProduct()
                  With myDb\myProduct()
                        If \myCategory=@myDb\Category$()
                              If N=0
                                    Values$=myDb\Category$()
                              Else
                                    Values$=" "
                              EndIf
                              Values$+Chr(10)+\name$+Chr(10)+StrF(\price,2)+Chr(128)
                              AddGadgetItem(#Lst_Products,-1,Values$)
                              SetGadgetItemData(#Lst_Products,CountGadgetItems(#Lst_Products)-1,@myDb\myProduct())
                              N+1
                        EndIf
                  EndWith
            Next
      Next
      SetActiveGadget(#Lst_Products)
      SetGadgetState(#Lst_Products,0)
EndProcedure
Procedure OpenMainForm()
      BuildDataOfTesting()
      Protected Tilte$
      Select gCurrentLangage
            Case #Fr
                  Tilte$="Utilisez Json pour sauvez vos Structures"
            Case #En
                  Tilte$="Use Json For saving you Structures"
      EndSelect
      Protected Flag=#PB_Window_Maximize|#PB_Window_SystemMenu
      OpenWindow(#MainForm,0,0,800,600,Tilte$,Flag)
      CreateMenu(#MainMenu,WindowID(#MainForm))
      Dim txt$(7,1)
      ;{ Gestion du menu
      ;  Menu management
      txt$(0,#Fr)="Fichier"
      txt$(0,#En)="File"
      txt$(1,#Fr)="Sauver"
      txt$(1,#En)="Save"
      txt$(2,#Fr)="Ouvrir"
      txt$(2,#En)="Save"
      txt$(3,#Fr)="Quitter"
      txt$(3,#En)="Exit"
      MenuTitle(txt$(0,gCurrentLangage))
      MenuItem(#M_Open,txt$(2,gCurrentLangage))
      MenuItem(#M_Save,txt$(1,gCurrentLangage))
      MenuBar()
      MenuItem(#M_Exit,txt$(3,gCurrentLangage))
      BindEvent(#PB_Event_CloseWindow,@CloseMainForm(),#MainForm)
      BindMenuEvent(#MainMenu,#M_Open,@pOpenFile())
      BindMenuEvent(#MainMenu,#M_Save,@SaveFile())
      BindMenuEvent(#MainMenu,#M_Exit,@CloseMainForm())
      ;}
      ;{ Gestion liste des produits
      ;  List of products management
      Protected M=10 ; Marge entre les champs / margin letween fields
      Protected BtW=180
      Protected W=(WindowWidth(#MainForm)-(BtW+(M*4)))/2
      Protected H=WindowHeight(#MainForm)-(M*4)
      ListIconGadget(#Lst_Products,M,M,W,H,"",0,#PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines)
      Protected WC=GadgetWidth(#Lst_Products)/3
      txt$(4,#Fr)="Catégorie"
      txt$(4,#En)="Category"
      txt$(5,#Fr)="Produit"
      txt$(5,#En)="Product"
      txt$(6,#Fr)="Prix"
      txt$(6,#En)="Price"
      txt$(7,#Fr)="Quantité"
      txt$(7,#En)="Quantity"
      AddGadgetColumn(#Lst_Products,0,txt$(4,gCurrentLangage),WC)
      AddGadgetColumn(#Lst_Products,1,txt$(5,gCurrentLangage),WC)
      AddGadgetColumn(#Lst_Products,2,txt$(6,gCurrentLangage),WC)
      SortList(myDb\Category$(),#PB_Sort_Ascending)
      SortStructuredList(myDb\myProduct(),#PB_Sort_Ascending ,OffsetOf(product\name$),TypeOf(product\name$))
      FillsProducts()
      ;}
      ;{ Gestion des boutons
      ;  Buttons management
      Protected X=M+W+M
      Protected Y=(H/2)-80
      ButtonGadget(#BtAddProduct,X,Y,BtW,30," >> ")
      BindGadgetEvent(#BtAddProduct,@AddProduct())
      Y+30+M
      ButtonGadget(#BtRemoveProduct,X,Y,BtW,30," << ")
      BindGadgetEvent(#BtRemoveProduct,@RemoveProduct())
      ;}
      ;{ Gestion du pannier d'achat
      ;  Shopping basket management
      X=W+(M*3)+BTW
      ListIconGadget(#Lst_Basket,X,M,W,H,"",0,#PB_ListIcon_FullRowSelect|#PB_ListIcon_GridLines)
      WC=GadgetWidth(#Lst_Basket)/2
      AddGadgetColumn(#Lst_Basket,0,txt$(7,gCurrentLangage),WC)
      AddGadgetColumn(#Lst_Basket,1,txt$(5,gCurrentLangage),WC)
      FillsBasket()
      ;}
EndProcedure
OpenSelectLanguage()
Repeat :WaitWindowEvent():ForEver
Windows 10 64 bits PB: 5.70 ; 5.72 LST
Work at Centre Spatial de Liège
Haut
Répondre

Revenir à « Informations et tutoriaux »