- Suppression d'un enregistrement.
Code : Tout sélectionner
EnableExplicit
Enumeration Window
#mf
EndEnumeration
Enumeration Gadget
#mfList
#mfName
#mfNote
#mfAge
#mfNew
#mfUpdate
#mfDelete
EndEnumeration
UseSQLiteDatabase()
Global Database, DatabaseName.s = "mabase.sqlite", ReqSql.s = ""
Structure newRecord
Item.i
Idauto.i
Name.s
Note.s
Age.s
EndStructure
Global Record.newRecord
;Plan de l'application
Declare Start()
Declare ShowRecords()
Declare RecordSelect()
Declare RecordNew()
Declare RecordUpdate()
Declare RecordDelete()
Declare Exit()
Start()
Procedure Start()
Database = OpenDatabase(#PB_Any, DatabaseName, "", "", #PB_Database_SQLite)
If Not Database
MessageRequester("Information", "Impossible s'ouvrir la base de données")
Exit()
EndIf
OpenWindow(#mf, 0, 0, 800, 600, "Contacts", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ListIconGadget(#mfList, 5, 10, 250, 570, "Nom", 240, #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
TextGadget(#PB_Any, 275, 26, 80, 20, "Nom")
StringGadget(#mfName, 365, 23, 400, 20, "")
TextGadget(#PB_Any, 275, 55, 80, 20, "Note")
EditorGadget(#mfNote, 365, 55, 400, 175)
TextGadget(#PB_Any, 275, 245, 80, 20, "Age")
StringGadget(#mfAge, 365, 245, 400, 20, "", #PB_String_Numeric)
ButtonGadget(#mfNew,700,480,80,24,"Nouveau")
ButtonGadget(#mfUpdate,700,515,80,24,"Insert")
ButtonGadget(#mfDelete,700,550,80,24,"Supprimer")
;Triggers
BindGadgetEvent(#mfList, @RecordSelect(), #PB_EventType_LeftClick)
BindGadgetEvent(#mfNew, @RecordNew())
BindGadgetEvent(#mfUpdate, @RecordUpdate())
BindGadgetEvent(#mfDelete, @RecordDelete())
BindEvent(#PB_Event_CloseWindow, @Exit())
ShowRecords()
Repeat : WaitWindowEvent() : ForEver
EndProcedure
;Liste des enregistrements
Procedure ShowRecords()
ReqSql = "select idauto, name, note from contacts"
If DatabaseQuery(Database, ReqSql)
ClearGadgetItems(#mfList)
While NextDatabaseRow(Database)
AddGadgetItem(#mfList, -1, GetDatabaseString(Database, 1))
SetGadgetItemData(#mfList, CountGadgetItems(#mfList) - 1, GetDatabaseLong(Database, 0))
Wend
EndIf
SetGadgetState(#mfList, Record\Item)
SetActiveGadget(#mfList)
RecordSelect()
EndProcedure
;Affichage d'un contact
Procedure RecordSelect()
Record\Item = GetGadgetState(#mfList)
Record\Idauto = GetGadgetItemData(#mfList, Record\Item)
ReqSql = "select name, note, age from contacts where idauto = ?"
SetDatabaseLong(Database, 0, Record\Idauto)
If DatabaseQuery(Database, ReqSql) And NextDatabaseRow(Database)
SetGadgetText(#mfName, GetDatabaseString(Database, 0))
SetGadgetText(#mfNote, GetDatabaseString(Database, 1))
SetGadgetText(#mfAge, GetDatabaseString(Database, 2))
EndIf
SetGadgetText(#mfUpdate, "Mise à jour")
DisableGadget(#mfUpdate, #False)
DisableGadget(#mfDelete, #False)
EndProcedure
;Reset du formulaire de saisie de contact
Procedure RecordNew()
Protected Gadget
ClearStructure(Record, newRecord)
For Gadget = #mfName To #mfAge
SetGadgetText(Gadget, "")
Next
SetGadgetText(#mfUpdate, "Insert")
DisableGadget(#mfUpdate, #False)
DisableGadget(#mfDelete, #True)
SetActiveGadget(#mfName)
EndProcedure
;Mise à jour du contact
Procedure RecordUpdate()
;Préparation des requetes de création et de mise à jour d'un enregistrement
If Record\Idauto = 0
ReqSql = "insert into contacts (name, note, age) values (?,?,?)"
Record\Item = CountGadgetItems(#mfList)
Else
ReqSql = "update contacts set name = ?, note = ?, age = ? where idauto = ?"
EndIf
;Controle commun à la création & la modification de données
; - Le nom est obligatoire
With Record
\Name = GetGadgetText(#mfName)
\Note = GetGadgetText(#mfNote)
\Age = GetGadgetText(#mfAge)
If \Name <> ""
SetDatabaseString(Database, 0, \Name)
SetDatabaseString(Database, 1, \Note)
SetDatabaseString(Database, 2, \Age)
SetDatabaseLong(Database, 3, \Idauto)
DatabaseUpdate(Database, ReqSql)
If DatabaseError() <> ""
MessageRequester("Information", "Immpossible de mettre à jour la base de données" + #CRLF$ + DatabaseError())
EndIf
ShowRecords()
Else
MessageRequester("Information", "Le nom est obligatoire")
SetActiveGadget(#mfName)
EndIf
EndWith
EndProcedure
Procedure RecordDelete()
ReqSql = "delete from contacts where idauto = ?"
SetDatabaseLong(Database, 0, Record\Idauto)
DatabaseUpdate(Database, ReqSQL)
If DatabaseError() <> ""
MessageRequester("Information", "Immpossible de mettre à jour la base de données" + #CRLF$ + DatabaseError())
EndIf
ShowRecords()
EndProcedure
Procedure Exit()
If IsDatabase(Database)
CloseDatabase(Database)
EndIf
End
EndProcedure