Les Parties :
Troisième Partie : Gérer la Base De Données :
La form GestBase :
Grâce à cette form nous allons pouvoir :
- nous déplacer dans la base avec les boutons de navigation
- modifier un enregistrement
- supprimer un enregistrement
- créer un enregistrement
Seul le numéro de la fiche, ici, est géré automatiquement par la base.
(on peut aussi le gérer)
Ici, nous avons fait le choix de ne pas utiliser les composants
gb.db.form pour plus de souplesse et de maîtrise de ce qui se passe.
Form alimentée :
Modification demandée :
Dans l'IDE :
Le Code :
Les déclarations :
1
2
3
4
5
6
7
8
9
10
11
12
| ' Gambas class file
PUBLIC FlagAjout AS BOOLEAN
PUBLIC FlagModif AS BOOLEAN
PUBLIC FlagSuppr AS BOOLEAN
PUBLIC p AS BOOLEAN
PUBLIC hResult AS Result
PUBLIC iPosition AS INTEGER
PUBLIC iNextCharPos AS INTEGER
PUBLIC iLongMot AS INTEGER
PUBLIC iLongMotMax AS INTEGER
PUBLIC t AS STRING
|
Déplacement dans la base :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
| PUBLIC SUB btFIRST_Click() 'first
IF hresult.index > 0 THEN
FMain.camera()
hResult.MoveFirst
tee()
ELSE
FMain.beep()
ENDIF
END
PUBLIC SUB btPREV_Click() 'arrière
IF hresult.index > 0 THEN
FMain.camera()
hResult.MovePrevious
tee()
ELSE
FMain.beep()
ENDIF
END
PUBLIC SUB btNEXT_Click() 'avant
IF hResult.Index >= hResult.Count - 1 THEN
FMain.beep()
ELSE
FMain.camera()
hResult.MoveNext
tee()
ENDIF
END
PUBLIC SUB btLAST_Click() 'last
IF hResult.Index >= hResult.Count - 1 THEN
FMain.beep()
ELSE
FMain.camera()
hResult.MoveLast
tee()
ENDIF
END
|
Annulation et autres tests
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
| PUBLIC SUB btANNUL_Click() 'bouton annule
IF hResult.Index >= hResult.Count - 1 THEN
FMain.beep()
ELSE
db.Current.Begin
db.Current.Rollback()
db.Current.Commit
ENDIF
hResult = DB.Current.Exec(FMain.tribase)
hResult.MoveTo(FMain.clef)
tee()
TextBoxTrue()
END
PUBLIC SUB testValeurs() 'test des valeurs avant validation
FMain.Mms = CFloat(Val(DCMms.Value))
FMain.SD = CFloat(Val(DCSd.Value))
FMain.FR = CFloat(Val(DCFr.Value))
FMain.QT = CFloat(Val(DCQt.Value))
FMain.QM = CFloat(Val(DCQm.Value))
FMain.Rcc = CFloat(Val(DCRcc.Value))
FMain.cms = 1 / ((2 * Pi * FMain.fr) ^ 2 * FMain.mms)
FMain.qe = FMain.qm / ((FMain.qm / FMain.qt) - 1)
FMain.bl = (2 * Pi * FMain.fr * FMain.mms * FMain.rcc / FMain.qe) ^ (1 / 2)
FMain.fa = FMain.bl / FMain.mms
FMain.mas = FMain.mms / FMain.sd ^ 2
END
|
Validation après un changement dans la base :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
| PUBLIC SUB btVALID_Click() 'les différentes validations
'--------------Ajout--------------------
IF FlagAjout THEN 'Ajout
IF DCMarque.Text = "" OR DCReference.Text = "" THEN
Message.Info(("Ajout-Remplissez tous les champs de texte"))
RETURN
END IF
IF DCMms.Value = NULL OR DCSd.Value = NULL OR DCFr.Value = NULL OR DCQt.Value = NULL OR DCQm.Value = NULL OR DCRcc.Value = NULL THEN
Message.Info(("Ajout-Remplissez tous les champs numériques")
RETURN
ENDIF
IF DCMms.Value = 0 OR DCSd.Value = 0 OR DCFr.Value = 0 OR DCQt.Value = 0 OR DCQm.Value = 0 OR DCRcc.Value = 0 THEN
Message.Info(("Ajout-Pas de valeurs nulles!"))
RETURN
ENDIF
IF DCMms.Value <> 0 OR DCSd.Value <> 0 OR DCFr.Value <> 0 OR DCQt.Value <> 0 OR DCQm.Value <> 0 OR DCRcc.Value <> 0 THEN
testValeurs()
IF NOT ERROR THEN
'---------------------------------
hResult!numero = DCNumero.value
hResult!marque = DCMarque.Text
hResult!reference = DCReference.Text
hResult!mms = DCMms.Value
hResult!sd = DCSd.Value
hResult!fr = DCFr.Value
hResult!qt = DCQt.Value
hResult!qm = DCQm.Value
hResult!rcc = DCRcc.Value
hResult!FichTech = TBnFichTech.Text
hResult.Update
db.Current.Commit
'----------------------------
FlagAjout = FALSE
FMain.camera()
ENDIF
ENDIF
END IF
'-----------------------------Modif-------------------------------
IF FlagModif THEN 'modification
IF hResult.Index >= hResult.Max THEN
FMain.beep()
FlagModif = FALSE
RETURN
ELSE
IF DCMarque.Text = "" OR DCReference.Text = "" THEN
Message.Info(("Modif.-Remplissez tous les champs de texte"))
RETURN
END IF
IF DCMms.Value = NULL OR DCSd.Value = NULL OR DCFr.Value = NULL OR DCQt.Value = NULL OR DCQm.Value = NULL OR DCRcc.Value = NULL THEN
FMain.beep
Message.Info(("Modif.-Remplissez tous les champs numériques")
RETURN
ENDIF
ENDIF
' ' hResult!numero = DCNumero.value 'pas à modifier clef primaire
hResult!marque = DCMarque.Text
hResult!reference = DCReference.Text
hResult!mms = DCMms.Value
hResult!sd = DCSd.Value
hResult!fr = DCFr.Value
hResult!qt = DCQt.Value
hResult!qm = DCQm.Value
hResult!rcc = DCRcc.Value
hResult!FichTech = TBnFichTech.Text
'-------------------
hResult.Update
db.Current.Commit
'--------------------
FlagModif = FALSE
FMain.camera()
END IF
'-----------------------Suppr-------------------------------------
IF FlagSuppr THEN 'suppression
IF hresult.count <= 0 THEN
FMain.beep()
FlagSuppr = FALSE
RETURN
ELSE
hResult.MoveTo(FMain.clef)
tee()
'----------------------------
hresult.Delete()
db.Current.Commit
'----------------------------
FlagSuppr = FALSE
FMain.camera()
Message.Info(("Suppression de l'enregistrement courant effectuée")
IF hresult.Count > 0 THEN
hResult.MoveTo(FMain.clef - 1)
ELSE
hResult.MoveFirst
ENDIF
tee()
ENDIF
END IF
'-------------------------Global Valid-----------------------------
'------------- mise à jour immédiate ----------------------
hResult = DB.Current.Exec(FMain.tribase) ' pour reprendre le bon hresult
hResult.MoveTo(FMain.clef)
tee()
'------------------------------------------------
FMain.IndexInit = hResult.Count
TextBoxTrue()
'----------sortie-----------------------------
sortie:
CATCH 'gestion des erreurs de validation
IF FlagAjout = TRUE THEN
' DCMarque.Text = ""
' DCReference.Text = ""
' DCMms.Value = 0
' DCSd.Value = 0
' DCFr.Value = 0
' DCQt.Value = 0
' DCQm.Value = 0
' DCRcc.Value = 0
' TBnFichTech.Text = ""
' DCMarque.SetFocus()
'-----ou bien --------------------
hResult!marque = DCMarque.Text
hResult!reference = DCReference.Text
hResult!mms = DCMms.Value
hResult!sd = DCSd.Value
hResult!fr = DCFr.Value
hResult!qt = DCQt.Value
hResult!qm = DCQm.Value
hResult!rcc = DCRcc.Value
hResult!FichTech = TBnFichTech.Text
DCMms.SetFocus()
'-----------------------------------
FMain.beep
Message(("Vérifier les valeurs")
RETURN
ENDIF
IF FlagModif = TRUE THEN
Message(("erreur sur modification : ") & Error.text)
ENDIF
IF FlagSuppr = TRUE THEN
Message(("erreur sur suppression : ") & Error.text)
ENDIF
Message.Error(Error.Text & ", " & Str(Error.Class) & ", code : " & Error.Code & ", " & Str(Error.Backtrace) & " à " Error.Wher "\n Error.Text)
END
PUBLIC SUB Button1_Click() ' fiche technique
TBnFichTech.Enabled = FALSE
Dialog.Filter = ["*.pdf", ("Fichier pdf"), "*.PDF", ("Fichier PDF"), "*.*", ("Tous les Fichiers")]
Dialog.Title = (" Choisissez la Fiche Technique de votre HautParleur : ") & ("là où vous l'avez rangée!"
Message(("Dans la fenêtre suivante : " & "\n" & ("cliquer 'Annuler' permet d'effacer le choix.") & "\n" & ("Cliquer 'OK' permet de valider le choix.")) 'information
IF Dialog.OpenFile(FALSE) THEN
Message.Title = ("effacer le champ?")
IF Message.Question(("Voulez vous effacer le champ?"), ("Non"), ("Oui")) = 1 THEN
RETURN
ELSE
Dialog.Path = ""
ENDIF
ENDIF
TBnFichTech.Text = Dialog.Path
TBnFichTech.Visible = TRUE
TBnFichTech.Enabled = FALSE
END
PUBLIC SUB btMODIF_Click() 'modifier
textbox1.Text = ("Modification demandée"
IF NOT db.Current.Opened THEN
db.Current.Open
ENDIF
IF hResult.Index >= hResult.Count THEN
FMain.beep()
FlagModif = FALSE
RETURN
END IF
FlagModif = TRUE
'--------------------------
db.Current.Begin
hResult = db.Current.Edit("hautparleur", FMain.triSelOrdre)
hResult.MoveTo(FMain.clef)
FMain.camera()
TextBoxFalse()
DCMarque.SetFocus
sortie:
END
PUBLIC SUB btSUPPR_Click() 'suppression
textbox1.Text = ("Suppression demandée"
IF NOT db.Current.Opened THEN
db.Current.Open
ENDIF
IF hresult.Count <= 0 THEN
FMain.beep()
FlagSuppr = FALSE
RETURN
END IF
FMain.camera()
'------------------------
hResult.MoveTo(FMain.clef)
tee()
db.Current.Begin
hResult = db.Current.Edit("hautparleur", FMain.triSelOrdre)
FlagSuppr = TRUE
TextBoxFalse()
Message.Info(("Attention vous êtes sur le point" & gb.CrLf & (" d'effacer l'enregistrement courant"))
sortie:
END
PUBLIC SUB btAJOUT_Click() 'Ajout
DIM numLast AS INTEGER
Textbox1.Text = ("Ajout demandé"
IF NOT db.Current.Opened THEN
db.Current.Open
ENDIF
FMain.beep()
FlagAjout = TRUE
TextBoxFalse()
'------------------------------------
hResult = DB.Current.Exec(FMain.tribase)
hResult.MoveLast()
tee()
numLast = DCNumero.Value + 1
db.Current.Begin
hResult = db.Current.Create("hautparleur")
DCNumero.value = numLast
DCMarque.Text = ""
DCReference.Text = ""
DCMms.Value = 0
DCSd.Value = 0
DCFr.Value = 0
DCQt.Value = 0
DCQm.Value = 0
DCRcc.Value = 0
TBnFichTech.Text = ""
DCMarque.SetFocus()
END
|
Réglages de démarrage
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
| PUBLIC SUB debut()
FlagAjout = FALSE
FlagModif = FALSE
FlagSuppr = FALSE
DCNumero.Enabled = FALSE
DCNumero.Foreground = Color.Black
TextBoxTrue()
END
PUBLIC SUB DCnotEnabled()
DCNumero.Enabled = FALSE
DCMarque.Enabled = FALSE
DCReference.Enabled = FALSE
DCMms.Enabled = FALSE
DCSd.Enabled = FALSE
DCFr.Enabled = FALSE
DCQt.Enabled = FALSE
DCQm.Enabled = FALSE
DCRcc.Enabled = FALSE
TBnFichTech.Enabled = FALSE
Button1.Enabled = FALSE
Textbox1.Visible = FALSE
DCNumero.Foreground = Color.Black
DCMarque.Foreground = Color.Black
DCReference.Foreground = Color.Black
DCMms.Foreground = Color.Black
DCSd.Foreground = Color.Black
DCFr.Foreground = Color.Black
DCQt.Foreground = Color.Black
DCQm.Foreground = Color.Black
DCRcc.Foreground = Color.Black
TBnFichTech.Foreground = Color.Black
END
PUBLIC SUB DCEnabled()
DCNumero.Enabled = FALSE
DCMarque.Enabled = TRUE
DCReference.Enabled = TRUE
DCMms.Enabled = TRUE
DCSd.Enabled = TRUE
DCFr.Enabled = TRUE
DCQt.Enabled = TRUE
DCQm.Enabled = TRUE
DCRcc.Enabled = TRUE
TBnFichTech.Enabled = FALSE
Button1.Enabled = TRUE
Textbox1.Visible = TRUE
END
PUBLIC SUB TextBoxFalse()
btMODIF.Enabled = FALSE
btSUPPR.Enabled = FALSE
btAJOUT.Enabled = FALSE
btRETOUR.Enabled = FALSE
panel1.Enabled = FALSE
btVALID.Enabled = TRUE
btANNUL.Enabled = TRUE
DCEnabled()
END SUB
PUBLIC SUB TextboxTrue()
btMODIF.Enabled = TRUE
btSUPPR.Enabled = TRUE
btAJOUT.Enabled = TRUE
btRETOUR.Enabled = TRUE
panel1.Enabled = TRUE
btVALID.Enabled = FALSE
btANNUL.Enabled = FALSE
DCnotEnabled()
END SUB
PUBLIC SUB tee() 'mise à jour immédiate des champs
IF hResult.Available = TRUE THEN
DCNumero.value = hResult!numero
DCMarque.Text = hResult!marque
DCReference.Text = hResult!reference
DCMms.Value = hResult!mms
DCSd.Value = hResult!sd
DCFr.Value = hResult!fr
DCQt.Value = hResult!qt
DCQm.Value = hResult!qm
DCRcc.Value = hResult!rcc
TBnFichTech.Text = hResult!FichTech
FMain.clef = hResult.Index
ENDIF
END
|
Ouverture de la form principale
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
| PUBLIC SUB Form_Open()
IF NOT db.Current.Opened THEN
db.Current.Open
ENDIF
FMain.RetourQ = FALSE
GestBase.Text = Application.Title & " - " & GestBase.Text
debut()
hResult = DB.Current.Exec(FMain.tribase)
FMain.clef = FMain.Resultat.Index
hResult.MoveTo(FMain.clef)
tee()
CATCH
Message("GestBase Open :" & gb.CrLf & Error.Text)
ME.Close()
END
PUBLIC SUB Form_Close()
GestBase.Exit()
IF IsNull(FMain.triBase) THEN
FMain.triBase = "SELECT * FROM hautparleur ORDER BY numero;"
ENDIF
FMain.RetourQ = TRUE
db.Current.Close
FMain.RetourQuery() 'pour mettre la base à jour
FMain.Show()
END
PUBLIC SUB _new() 'boucle évènement
IF NOT db.Current.Opened THEN
db.Current.Open
ENDIF
IF FMain.RetourQ = FALSE THEN
hResult = DB.Current.Exec(FMain.tribase)
hResult.MoveTo(FMain.clef)
tee()
ENDIF
END
PUBLIC SUB datedujour() AS STRING
RETURN Format(Now, "dd-mm-yyyy_hh-mm-ss")
END
|
====================
Commandes utilisées :
DatabaseSqlite
DB
Result
Message
Select case
Return
Dialog
Stop Event ====================
Navigation :
<-- Liens du Wiki : <--<-- Accueil du WIKI : <-- ====================
Documentation :
====================