Sign in Join
Wiki copytemporary

How to write in-memory database applications in Lazarus/FPC/fr: what changed

Revision 1 to 2. Removed lines have a minus sign; added lines have a plus sign.

OldNewLine
1----
2-[[Portal:Databases|**Portail de la base de données**]]
3-Références:
4-
5- * [[Databases/fr|Information générale]]
6- * [[Database libraries/fr|Bibliothèques]]
7- * [[Database field type/fr|Types de champ]]
8- * [[Data Controls tab/fr|Contrôles]]
9- * [[Lazarus DB Faq/fr|FAQ]]
10- * [[SqlDBHowto/fr|Comment faire en SQL ?]]
11- * [[Working With TSQLQuery/fr|Travailler avec TSQLQuery]]
12- * Applications de base de données en mémoire
13-
14-Tutoriels/articles pratiques :
15-
16- * [[Lazarus Database Overview/fr|Vue d'ensemble]]
17- * [[SQLdb Tutorial0/fr|0 - Configuration de la base de données]]
18- * [[SQLdb Tutorial1/fr|1 - Commençons]]
19- * [[SQLdb Tutorial2/fr|2 - Edition]]
20- * [[SQLdb Tutorial3/fr|3 - Requêtes]]
21- * [[SQLdb Tutorial4/fr|4 - Modules de données]]
22- * [[SQLdb Programming Reference/fr|Référence de programmation SQLdb]]
23-
24-Bases de données
25-
26- [[Advantage Database Server/fr|Advantage]] \- [[MySQLDatabases/fr|MySQL]] \- [[mssqlconn/fr|MSSQL]] \- [[postgres/fr|Postgres]] \- [[Firebird/fr|Interbase]] \- [[Firebird/fr|Firebird]] \- [[Oracle/fr|Oracle]] \- [[ODBCConn/fr|ODBC]] \- [[TParadox/fr|Paradox]] \- [[SQLite/fr|SQLite]] \- [[Lazarus Tdbf Tutorial/fr|dBASE]] \- [[MS Access/fr|MS Access]] \- [[Zeos tutorial/fr|Zeos]]
27-
28-## Contents
29-
30- * 1 Introduction
31- * 2 Enregistrer des MemDatasets dans des fichiers persistants
32- * 3 Clés primaires auto-incrémentées
33- * 4 Faire respecter l'intégrité référentielle
34- * 5 Problèmes connus
35- * 6 TBufDataSet
36- * 7 Trier un DBGrid sur l'événement TitleClick pour un TBufDataSet
37- * 8 Tri sur des colonnes multiples dans un DBGrid
38- * 9 ZMSQL
39- * 10 Contributeurs
40-
411## Introduction
422
43-Dans certaines circonstances, il est pertinent d'utiliser des DaatSets en mémoire. Si vous cherchez une base de donnée rapide, pour un utilisateur unique, un besoin non critique, sans SQL ni transaction, [[TMemDataset/fr|TMemDataset]] est fait pour vous.
3+Dans certaines circonstances, il est pertinent d'utiliser des DaatSets en mémoire. Si vous cherchez une base de donnée rapide, pour un utilisateur unique, un besoin non critique, sans SQL ni transaction, [[TMemDataset/fr|TMemDataset]] est fait pour vous.
444
45-Certains bénéfices sont :
5+Certains bénéfices sont :
466
47- * Une exécution rapide. Comme tout les traitements sont réalisés en mémoire, aucune donnée ne sont enregistrées sur disque sauf si explicitement demandé. La mémoire est manifestement plus rapide que le disque dur.
48- * Aucun besoin en bibliothèque externe (pas de fichier .so ou .dll), aucun besoin d'installer un serveur.
49- * Le code est multi plate-forme et peut être compilé sur n'importe quel système d'exploitation instantanément.
50- * Puisque toute la programmation est faite en Lazarus/FPC, de telles applications sont faciles à maintenir. En évitant de basculer constamment entre la programmation de back-end et celle de front-end, en utilisant des MemDataSets vous pouvez vous concentrer sur votre code Pascal.
7+- Une exécution rapide. Comme tout les traitements sont réalisés en mémoire, aucune donnée ne sont enregistrées sur disque sauf si explicitement demandé. La mémoire est manifestement plus rapide que le disque dur.
8+- Aucun besoin en bibliothèque externe (pas de fichier .so ou .dll), aucun besoin d'installer un serveur.
9+- Le code est multi plate-forme et peut être compilé sur n'importe quel système d'exploitation instantanément.
10+- Puisque toute la programmation est faite en Lazarus/FPC, de telles applications sont faciles à maintenir. En évitant de basculer constamment entre la programmation de back-end et celle de front-end, en utilisant des MemDataSets vous pouvez vous concentrer sur votre code Pascal.
5111
52-![Light bulb](https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png) **Remarque:** Plus tard dans cet article est introduit le BufDataset. [[TBufDataset/fr|TBufDataset]] est souvent un meilleur choix que [[TMemDataset/fr|TMemDataset]].
12+> **Note:** Plus tard dans cet article est introduit le BufDataset. [[TBufDataset/fr|TBufDataset]] est souvent un meilleur choix que [[TMemDataset/fr|TMemDataset]].
5313
54-J'illustrerai comment programmer des bases de données relationnelles non-SQL en mémoire, en me concentrant sur le respect de l'intégrité et le filtrage, la simulation des champs clé primaire auto-incrémentés et autres.
14+J'illustrerai comment programmer des bases de données relationnelles non-SQL en mémoire, en me concentrant sur le respect de l'intégrité et le filtrage, la simulation des champs clé primaire auto-incrémentés et autres.
5515
56-Cette page partage avec vous ce que j'ai appris en expérimentant avec les TMemDatasets. Il peut y avoir certaines autres façons de faire, plus efficaces. Si tel est le cas, merci de contribuer à ce document pour le bénéfice de la communauté Lazarus/FPC.
16+Cette page partage avec vous ce que j'ai appris en expérimentant avec les TMemDatasets. Il peut y avoir certaines autres façons de faire, plus efficaces. Si tel est le cas, merci de contribuer à ce document pour le bénéfice de la communauté Lazarus/FPC.
5717
58-C'est l'unité memds qui fournit TMemDataset, vous devrez donc l'ajouter dasn vos clauses uses.
18+C'est l'unité memds qui fournit TMemDataset, vous devrez donc l'ajouter dasn vos clauses uses.
5919
6020## Enregistrer des MemDatasets dans des fichiers persistants
6121
62-Dans la partie [interface](</index.php?title=Interface/fr&action=edit&redlink=1> "Interface/fr \(page does not exist\)") de votre code, déclarez un type tableau pour stocker l'information sur les TMemDataSets que vous vloulez rendre persistant à la fin de la session et restaurer au début de la prochaine session. Vou devez déclarer aussi une variable de type TSaveTables.
22+Dans la partie [[Interface/fr|interface]] de votre code, déclarez un type tableau pour stocker l'information sur les TMemDataSets que vous vloulez rendre persistant à la fin de la session et restaurer au début de la prochaine session. Vou devez déclarer aussi une variable de type TSaveTables.
6323
64-J'utilise aussi une variable globale vSuppressEvents de type booléen, pour les événements de suppression utilisés pour le respect de l'intégrité référentielle, pendant la restauration des données.
24+J'utilise aussi une variable globale vSuppressEvents de type booléen, pour les événements de suppression utilisés pour le respect de l'intégrité référentielle, pendant la restauration des données.
6525
66-Vous obtenez ceci :
67-```
26+Vous obtenez ceci :
27+
28+``` pascal
6829type
69- TSaveTables=array[1..15] of TMemDataset;
70- var
71- //Global variable that holds tables for saving/restoring session
72- vSaveTables:TSaveTables;
73- //Suppress events flag variables. Used during data loading from files.
74- vSuppressEvents:Boolean;
30+ TSaveTables=array[1..15] of TMemDataset;
31+var
32+ //Global variable that holds tables for saving/restoring session
33+ vSaveTables:TSaveTables;
34+ //Suppress events flag variables. Used during data loading from files.
35+ vSuppressEvents:Boolean;
7536```
7637
77-Au lieu d'utiliser une variable globale comme je l'ai fait, vous pourriez la mettre sous forme d'une propriété de la fiche. TMemDataset donne une façon d'enregistrer nativement les données dans un fichier persistant : la méthode SaveToFile. Mais vous pouvez préférer sauver les données dans un fichier [CSV](</index.php?title=CSV/fr&action=edit&redlink=1> "CSV/fr \(page does not exist\)") pour un usage externe plus facile. Par conséquent, je vais combiner les deux méthodes dans les mêmes procédures. Je définis une constante cSaveRestore dans la partie Interface, par laquelle je peux définir si les données sont stockées et chargées comme fichiers natifs MemDataset ou comme fichiers CSV.
78-```
38+Au lieu d'utiliser une variable globale comme je l'ai fait, vous pourriez la mettre sous forme d'une propriété de la fiche. TMemDataset donne une façon d'enregistrer nativement les données dans un fichier persistant : la méthode SaveToFile. Mais vous pouvez préférer sauver les données dans un fichier [[CSV/fr|CSV]] pour un usage externe plus facile. Par conséquent, je vais combiner les deux méthodes dans les mêmes procédures. Je définis une constante cSaveRestore dans la partie Interface, par laquelle je peux définir si les données sont stockées et chargées comme fichiers natifs MemDataset ou comme fichiers CSV.
39+
40+``` pascal
7941const
80- //Constant cSaveRestore determines the way for saving and restoring of MemDatasets to persistent files
81- cSaveRestore=0; //0=MemDataset native way, 1=saving and restoring from CSV
42+ //Constant cSaveRestore determines the way for saving and restoring of MemDatasets to persistent files
43+ cSaveRestore=0; //0=MemDataset native way, 1=saving and restoring from CSV
8244```
8345
84-Maintenant, vous pouvez enregistrer les MemDatasets sur l'événement FormClose et les charger sur l'événement FormCreate. Instantiez également les éléments du tableau de MemDatasets sur l'événement FormCreate aussi.
85-```
46+Maintenant, vous pouvez enregistrer les MemDatasets sur l'événement FormClose et les charger sur l'événement FormCreate. Instantiez également les éléments du tableau de MemDatasets sur l'événement FormCreate aussi.
47+
48+``` pascal
8649procedure TMainForm.FormCreate(Sender: TObject);
87- begin
88- //List of tables to be saved/restored for a session
89- vSaveTables[1]:=Products;
90- vSaveTables[2]:=Boms;
91- vSaveTables[3]:=Stocks;
92- vSaveTables[4]:=Orders;
93- vSaveTables[5]:=BomCalculationProducts;
94- vSaveTables[6]:=BomCalculationComponents;
95- vSaveTables[7]:=BomCalculationFooter;
96- vSaveTables[8]:=BomCalculationProductsMultiple;
97- vSaveTables[9]:=BomCalculationComponentsMultiple;
98- vSaveTables[10]:=BomCalculationFooterMultiple;
99- vSaveTables[11]:=ImportVariants;
100- vSaveTables[12]:=ImportToTables;
101- vSaveTables[13]:=ImportToFields;
102- vSaveTables[14]:=ImportFromTables;
103- vSaveTables[15]:=ImportFromFields;
104- //Restore session
105- RestoreSession;
106- GetAutoincrementPrimaryFields;
107- end;
50+begin
51+ //List of tables to be saved/restored for a session
52+ vSaveTables[1]:=Products;
53+ vSaveTables[2]:=Boms;
54+ vSaveTables[3]:=Stocks;
55+ vSaveTables[4]:=Orders;
56+ vSaveTables[5]:=BomCalculationProducts;
57+ vSaveTables[6]:=BomCalculationComponents;
58+ vSaveTables[7]:=BomCalculationFooter;
59+ vSaveTables[8]:=BomCalculationProductsMultiple;
60+ vSaveTables[9]:=BomCalculationComponentsMultiple;
61+ vSaveTables[10]:=BomCalculationFooterMultiple;
62+ vSaveTables[11]:=ImportVariants;
63+ vSaveTables[12]:=ImportToTables;
64+ vSaveTables[13]:=ImportToFields;
65+ vSaveTables[14]:=ImportFromTables;
66+ vSaveTables[15]:=ImportFromFields;
67+ //Restore session
68+ RestoreSession;
69+ GetAutoincrementPrimaryFields;
70+end;
10871```
10972
110-
111-
112-```
73+``` pascal
11374procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
114- begin
115- //Save memdatasets to files (to save current session)
116- SaveSession;
117- end;
75+begin
76+ //Save memdatasets to files (to save current session)
77+ SaveSession;
78+end;
11879```
11980
120-
121-
122-```
81+``` pascal
12382procedure RestoreSession;
124- var
125- I:Integer;
126- begin
83+var
84+ I:Integer;
85+begin
86+ try
87+ MemoMessages.Append(TimeToStr(Now())+' Starting restoration of previously saved session.');
88+ vSuppressEvents:=True; //Supress events used for referential integrity enforcing
89+ //Disable controls and refresh all datasets
90+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
91+ vSaveTables[I].DisableControls;
92+ vSaveTables[I].Refresh; //Important if dataset was filtered
93+ end;
94+ //Load memdatasets from files (to restore previous session)
95+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
96+ vSaveTables[I].First;
97+ MemoMessages.Append(TimeToStr(Now())+' Starting restoration of table: '+vSaveTables[I].Name);
12798 try
128- MemoMessages.Append(TimeToStr(Now())+' Starting restoration of previously saved session.');
129- vSuppressEvents:=True; //Supress events used for referential integrity enforcing
130- //Disable controls and refresh all datasets
131- for I:=Low(vSaveTables) to High(vSaveTables) do begin
132- vSaveTables[I].DisableControls;
133- vSaveTables[I].Refresh; //Important if dataset was filtered
99+ //If data is loaded from a csv file, then table must be deleted first.
100+ if cSaveRestore=1 then begin
101+ MemoMessages.Append(TimeToStr(Now())+' Starting delete of all records in table: '+vSaveTables[I].Name);
102+ //This way of deleting all records is incredibly slow.
103+ {while not vSaveTables[I].EOF do begin
104+ vSaveTables[I].Delete;
105+ end;}
106+ //This method for deleting of all records is much faster
107+ EmptyMemDataSet(vSaveTables[I]);
108+ MemoMessages.Append(TimeToStr(Now())+' All records from table: '+vSaveTables[I].Name+' deleted.');
134109 end;
135- //Load memdatasets from files (to restore previous session)
136- for I:=Low(vSaveTables) to High(vSaveTables) do begin
137- vSaveTables[I].First;
138- MemoMessages.Append(TimeToStr(Now())+' Starting restoration of table: '+vSaveTables[I].Name);
139- try
140- //If data is loaded from a csv file, then table must be deleted first.
141- if cSaveRestore=1 then begin
142- MemoMessages.Append(TimeToStr(Now())+' Starting delete of all records in table: '+vSaveTables[I].Name);
143- //This way of deleting all records is incredibly slow.
144- {while not vSaveTables[I].EOF do begin
145- vSaveTables[I].Delete;
146- end;}
147- //This method for deleting of all records is much faster
148- EmptyMemDataSet(vSaveTables[I]);
149- MemoMessages.Append(TimeToStr(Now())+' All records from table: '+vSaveTables[I].Name+' deleted.');
150- end;
151- except
152- on E:Exception do begin
153- MemoMessages.Append(TimeToStr(Now())+' Error while deleteing records from table: '+vSaveTables[I].Name +'. '+E.Message);
154- end;
110+ except
111+ on E:Exception do begin
112+ MemoMessages.Append(TimeToStr(Now())+' Error while deleteing records from table: '+vSaveTables[I].Name +'. '+E.Message);
113+ end;
114+ end;
115+ try
116+ try
117+ MemoMessages.Append(TimeToStr(Now())+' Restoring table: '+vSaveTables[I].Name);
118+ //Check constant for way of saving/restoring data and load saved session
119+ case cSaveRestore of
120+ 0:vSaveTables[I].LoadFromFile(vSaveTables[I].Name);
121+ 1:LoadFromCsv(vSaveTables[I]);
155122 end;
156- try
157- try
158- MemoMessages.Append(TimeToStr(Now())+' Restoring table: '+vSaveTables[I].Name);
159- //Check constant for way of saving/restoring data and load saved session
160- case cSaveRestore of
161- 0:vSaveTables[I].LoadFromFile(vSaveTables[I].Name);
162- 1:LoadFromCsv(vSaveTables[I]);
163- end;
164- except
165- on E:Exception do begin
166- MemoMessages.Append(TimeToStr(Now())+' Error while restoring table: '+vSaveTables[I].Name +'. '+E.Message);
167- end;
168- end;
169- finally
170- vSaveTables[I].Active:=True;//Needed because of LoadFromFile method....
123+ except
124+ on E:Exception do begin
125+ MemoMessages.Append(TimeToStr(Now())+' Error while restoring table: '+vSaveTables[I].Name +'. '+E.Message);
171126 end;
172- MemoMessages.Append(TimeToStr(Now())+' Table: '+vSaveTables[I].Name+' restored.');
173127 end;
174128 finally
175- vSuppressEvents:=False;
176- //Refresh all datasets and enable controls
177- for I:=Low(vSaveTables) to High(vSaveTables) do begin
178- vSaveTables[I].Refresh; //Needed for tables that are filtered.
179- vSaveTables[I].EnableControls;
180- end;
181- MemoMessages.Append(TimeToStr(Now())+' All tables restored from saved files.');
129+ vSaveTables[I].Active:=True;//Needed because of LoadFromFile method....
182130 end;
131+ MemoMessages.Append(TimeToStr(Now())+' Table: '+vSaveTables[I].Name+' restored.');
183132 end;
133+ finally
134+ vSuppressEvents:=False;
135+ //Refresh all datasets and enable controls
136+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
137+ vSaveTables[I].Refresh; //Needed for tables that are filtered.
138+ vSaveTables[I].EnableControls;
139+ end;
140+ MemoMessages.Append(TimeToStr(Now())+' All tables restored from saved files.');
141+ end;
142+end;
184143```
185144
186-
187-
188-```
145+``` pascal
189146procedure SaveSession;
190- var
191- I:Integer;
192- begin
147+var
148+ I:Integer;
149+begin
150+ try
151+ MemoMessages.Append(TimeToStr(Now())+' Starting saving session to persistent files.');
152+ vSuppressEvents:=True;
153+ //Disable controls and refresh all datasets
154+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
155+ vSaveTables[I].DisableControls;
156+ vSaveTables[I].Refresh; //Important if dataset was filtered
157+ end;
158+ //Save session to file
159+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
160+ vSaveTables[I].First;
161+ MemoMessages.Append(TimeToStr(Now())+' Saving table: '+vSaveTables[I].Name);
193162 try
194- MemoMessages.Append(TimeToStr(Now())+' Starting saving session to persistent files.');
195- vSuppressEvents:=True;
196- //Disable controls and refresh all datasets
197- for I:=Low(vSaveTables) to High(vSaveTables) do begin
198- vSaveTables[I].DisableControls;
199- vSaveTables[I].Refresh; //Important if dataset was filtered
200- end;
201- //Save session to file
202- for I:=Low(vSaveTables) to High(vSaveTables) do begin
203- vSaveTables[I].First;
204- MemoMessages.Append(TimeToStr(Now())+' Saving table: '+vSaveTables[I].Name);
205- try
206- //Check constant for way of saving/restoring data and save session
207- case cSaveRestore of
208- 0:vSaveTables[I].SaveToFile(vSaveTables[I].Name);
209- 1:SaveToCsv(vSaveTables[I]);
210- end;
211- except
212- on E:Exception do begin
213- MemoMessages.Append(TimeToStr(Now())+' Error while saving table: '+vSaveTables[I].Name +'. '+E.Message);
214- end;
215- end;
216- MemoMessages.Append(TimeToStr(Now())+' Table: '+vSaveTables[I].Name+' saved.');
163+ //Check constant for way of saving/restoring data and save session
164+ case cSaveRestore of
165+ 0:vSaveTables[I].SaveToFile(vSaveTables[I].Name);
166+ 1:SaveToCsv(vSaveTables[I]);
217167 end;
218- finally
219- vSuppressEvents:=False;
220- //Refresh all datasets and enable controls
221- for I:=Low(vSaveTables) to High(vSaveTables) do begin
222- vSaveTables[I].Refresh; //Needed for tables that are filtered
223- vSaveTables[I].EnableControls;
168+ except
169+ on E:Exception do begin
170+ MemoMessages.Append(TimeToStr(Now())+' Error while saving table: '+vSaveTables[I].Name +'. '+E.Message);
224171 end;
225- MemoMessages.Append(TimeToStr(Now())+' All tables saved to files.');
226172 end;
173+ MemoMessages.Append(TimeToStr(Now())+' Table: '+vSaveTables[I].Name+' saved.');
227174 end;
175+ finally
176+ vSuppressEvents:=False;
177+ //Refresh all datasets and enable controls
178+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
179+ vSaveTables[I].Refresh; //Needed for tables that are filtered
180+ vSaveTables[I].EnableControls;
181+ end;
182+ MemoMessages.Append(TimeToStr(Now())+' All tables saved to files.');
183+ end;
184+end;
228185```
229186
230-
231-
232-```
187+``` pascal
233188procedure EmptyMemDataSet(DataSet:TMemDataSet);
234- var
235- vTemporaryMemDataSet:TMemDataSet;
236- vFieldDef:TFieldDef;
237- I:Integer;
238- begin
239- try
240- //Create temporary MemDataSet
241- vTemporaryMemDataSet:=TMemDataSet.Create(nil);
242- //Store FieldDefs to Temporary MemDataSet
243- for I:=0 to DataSet.FieldDefs.Count-1 do begin
244- vFieldDef:=vTemporaryMemDataSet.FieldDefs.AddFieldDef;
245- with DataSet.FieldDefs[I] do begin
246- vFieldDef.Name:=Name;
247- vFieldDef.DataType:=DataType;
248- vFieldDef.Size:=Size;
249- vFieldDef.Required:=Required;
250- end;
251- end;
252- //Clear existing fielddefs
253- DataSet.Clear;
254- //Restore fielddefs
255- DataSet.FieldDefs:=vTemporaryMemDataSet.FieldDefs;
256- DataSet.Active:=True;
257- finally
258- vTemporaryMemDataSet.Clear;
259- vTemporaryMemDataSet.Free;
189+var
190+ vTemporaryMemDataSet:TMemDataSet;
191+ vFieldDef:TFieldDef;
192+ I:Integer;
193+begin
194+ try
195+ //Create temporary MemDataSet
196+ vTemporaryMemDataSet:=TMemDataSet.Create(nil);
197+ //Store FieldDefs to Temporary MemDataSet
198+ for I:=0 to DataSet.FieldDefs.Count-1 do begin
199+ vFieldDef:=vTemporaryMemDataSet.FieldDefs.AddFieldDef;
200+ with DataSet.FieldDefs[I] do begin
201+ vFieldDef.Name:=Name;
202+ vFieldDef.DataType:=DataType;
203+ vFieldDef.Size:=Size;
204+ vFieldDef.Required:=Required;
260205 end;
261206 end;
207+ //Clear existing fielddefs
208+ DataSet.Clear;
209+ //Restore fielddefs
210+ DataSet.FieldDefs:=vTemporaryMemDataSet.FieldDefs;
211+ DataSet.Active:=True;
212+ finally
213+ vTemporaryMemDataSet.Clear;
214+ vTemporaryMemDataSet.Free;
215+ end;
216+end;
262217```
263218
264-
265-
266-```
219+``` pascal
267220procedure LoadFromCsv(DataSet:TDataSet);
268- var
269- vFieldCount:Integer;
270- I:Integer;
271- begin
272- try
273- //Assign SdfDataSetTemporary
274- with SdfDataSetTemporary do begin
275- Active:=False;
276- ClearFields;
277- FileName:=DataSet.Name+'.txt';
278- FirstLineAsSchema:=True;
279- Active:=True;
280- //Determine number of fields
281- vFieldCount:=FieldDefs.Count;
282- end;
283- //Iterate through SdfDataSetTemporary and insert records into MemDataSet
284- SdfDataSetTemporary.First;
285- while not SdfDataSetTemporary.EOF do begin
286- DataSet.Append;
287- //Iterate through FieldDefs
288- for I:=0 to vFieldCount-1 do begin
289- try
290- DataSet.Fields[I].Value:=SdfDataSetTemporary.Fields[I].Value;
291- except
292- on E:Exception do begin
293- MemoMessages.Append(TimeToStr(Now())+' Error while setting value for field: '
294- +DataSet.Name+'.'+DataSet.Fields[I].Name +'. '+E.Message);
295- end;
296- end;
297- end;
298- try
299- DataSet.Post;
300- except
301- on E:Exception do begin
302- MemoMessages.Append(TimeToStr(Now())+' Error while posting record to table: '
303- +DataSet.Name+'.'+E.Message);
304- end;
221+var
222+ vFieldCount:Integer;
223+ I:Integer;
224+begin
225+ try
226+ //Assign SdfDataSetTemporary
227+ with SdfDataSetTemporary do begin
228+ Active:=False;
229+ ClearFields;
230+ FileName:=DataSet.Name+'.txt';
231+ FirstLineAsSchema:=True;
232+ Active:=True;
233+ //Determine number of fields
234+ vFieldCount:=FieldDefs.Count;
235+ end;
236+ //Iterate through SdfDataSetTemporary and insert records into MemDataSet
237+ SdfDataSetTemporary.First;
238+ while not SdfDataSetTemporary.EOF do begin
239+ DataSet.Append;
240+ //Iterate through FieldDefs
241+ for I:=0 to vFieldCount-1 do begin
242+ try
243+ DataSet.Fields[I].Value:=SdfDataSetTemporary.Fields[I].Value;
244+ except
245+ on E:Exception do begin
246+ MemoMessages.Append(TimeToStr(Now())+' Error while setting value for field: '
247+ +DataSet.Name+'.'+DataSet.Fields[I].Name +'. '+E.Message);
305248 end;
306- SdfDataSetTemporary.Next;
307249 end;
308- finally
309- SdfDataSetTemporary.Active:=False;
310- SdfDataSetTemporary.ClearFields;
311250 end;
251+ try
252+ DataSet.Post;
253+ except
254+ on E:Exception do begin
255+ MemoMessages.Append(TimeToStr(Now())+' Error while posting record to table: '
256+ +DataSet.Name+'.'+E.Message);
257+ end;
258+ end;
259+ SdfDataSetTemporary.Next;
312260 end;
261+ finally
262+ SdfDataSetTemporary.Active:=False;
263+ SdfDataSetTemporary.ClearFields;
264+ end;
265+end;
313266```
314267
315-
316-
317-```
268+``` pascal
318269procedure SaveToCsv(DataSet:TDataSet);
319- var
320- myFileName:string;
321- myTextFile: TextFile;
322- i: integer;
323- s: string;
324- begin
325- myFileName:=DataSet.Name+'.txt';
326- //create a new file
327- AssignFile(myTextFile, myFileName);
328- Rewrite(myTextFile);
329- s := ''; //initialize empty string
330- try
331- //write field names (as column headers)
332- for i := 0 to DataSet.Fields.Count - 1 do
333- begin
334- s := s + Format('%s,', [DataSet.Fields[i].FieldName]);
335- end;
336- Writeln(myTextFile, s);
337- DataSet.First;
338- //write field values
339- while not DataSet.Eof do
270+var
271+ myFileName:string;
272+ myTextFile: TextFile;
273+ i: integer;
274+ s: string;
275+begin
276+ myFileName:=DataSet.Name+'.txt';
277+ //create a new file
278+ AssignFile(myTextFile, myFileName);
279+ Rewrite(myTextFile);
280+ s := ''; //initialize empty string
281+ try
282+ //write field names (as column headers)
283+ for i := 0 to DataSet.Fields.Count - 1 do
284+ begin
285+ s := s + Format('%s,', [DataSet.Fields[i].FieldName]);
286+ end;
287+ Writeln(myTextFile, s);
288+ DataSet.First;
289+ //write field values
290+ while not DataSet.Eof do
291+ begin
292+ s := '';
293+ for i := 0 to DataSet.FieldCount - 1 do
340294 begin
341- s := '';
342- for i := 0 to DataSet.FieldCount - 1 do
343- begin
344- //Numerical fields without quotes, string fields with quotes
345- if ((DataSet.FieldDefs[i].DataType=ftInteger)
346- or (DataSet.FieldDefs[i].DataType=ftFloat)) then
347- s := s + Format('%s,', [DataSet.Fields[i].AsString])
348- else
349- s := s + Format('"%s",', [DataSet.Fields[i].AsString]);
350- end;
351- Writeln(myTextfile, s);
352- DataSet.Next;
295+ //Numerical fields without quotes, string fields with quotes
296+ if ((DataSet.FieldDefs[i].DataType=ftInteger)
297+ or (DataSet.FieldDefs[i].DataType=ftFloat)) then
298+ s := s + Format('%s,', [DataSet.Fields[i].AsString])
299+ else
300+ s := s + Format('"%s",', [DataSet.Fields[i].AsString]);
353301 end;
354- finally
355- CloseFile(myTextFile);
302+ Writeln(myTextfile, s);
303+ DataSet.Next;
356304 end;
357- end;
305+ finally
306+ CloseFile(myTextFile);
307+ end;
308+end;
358309```
359310
360311## Clés primaires auto-incrémentées
361312
362-Le champ de type auto-incrémenté n'est pas supporté par TMemDataset. Néanmoins, vous pouvez le simuler en utilisant un champ de type entier et en fournissant un procédé de calcul pour les champs auto-incrémentés. Nous avons besoin de variables globales ou propriétés publiques pour le stockage de la valeur du champ. Je préfère les variables globales, déclarées dans la partie Interface.
363-```
313+Le champ de type auto-incrémenté n'est pas supporté par TMemDataset. Néanmoins, vous pouvez le simuler en utilisant un champ de type entier et en fournissant un procédé de calcul pour les champs auto-incrémentés. Nous avons besoin de variables globales ou propriétés publiques pour le stockage de la valeur du champ. Je préfère les variables globales, déclarées dans la partie Interface.
314+
315+``` pascal
364316var
365- //Global variables used for calculation of autoincrement primary key fields of MemDatasets
366- vCurrentId:Integer=0;
367- vProductsId:Integer=0;
368- vBomsId:Integer=0;
369- vBomCalculationProductsId:Integer=0;
370- vBomCalculationComponentsId:Integer=0;
371- vBomCalculationFooterId:Integer=0;
372- vBomCalculationProductsMultipleId:Integer=0;
373- vBomCalculationComponentsMultipleId:Integer=0;
374- vBomCalculationFooterMultipleId:Integer=0;
375- vStocksId:Integer=0;
376- vOrdersId:Integer=0;
377- vImportVariantsId:Integer=0;
378- vImportToTablesId:Integer=0;
379- vImportToFieldsId:Integer=0;
380- vImportFromTablesId:Integer=0;
381- vImportFromFieldsId:Integer=0;
317+ //Global variables used for calculation of autoincrement primary key fields of MemDatasets
318+ vCurrentId:Integer=0;
319+ vProductsId:Integer=0;
320+ vBomsId:Integer=0;
321+ vBomCalculationProductsId:Integer=0;
322+ vBomCalculationComponentsId:Integer=0;
323+ vBomCalculationFooterId:Integer=0;
324+ vBomCalculationProductsMultipleId:Integer=0;
325+ vBomCalculationComponentsMultipleId:Integer=0;
326+ vBomCalculationFooterMultipleId:Integer=0;
327+ vStocksId:Integer=0;
328+ vOrdersId:Integer=0;
329+ vImportVariantsId:Integer=0;
330+ vImportToTablesId:Integer=0;
331+ vImportToFieldsId:Integer=0;
332+ vImportFromTablesId:Integer=0;
333+ vImportFromFieldsId:Integer=0;
382334```
383335
384-Ensuite nous avons une procédure pour le calcul des valeurs du champ auto-incrémenté :
385-```
336+Ensuite nous avons une procédure pour le calcul des valeurs du champ auto-incrémenté :
337+
338+``` pascal
386339procedure GetAutoincrementPrimaryFields;
387- var
388- I:Integer;
389- vId:^Integer;
390- begin
391- try
392- MemoMessages.Lines.Append(TimeToStr(Now())+' Getting information about autoincrement fields');
393- vSuppressEvents:=True;
394- //Disable controls and refresh all datasets
395- for I:=Low(vSaveTables) to High(vSaveTables) do begin
396- vSaveTables[I].DisableControls;
397- vSaveTables[I].Refresh; //Important if dataset was filtered
398- end;
399- for I:=Low(vSaveTables) to High(vSaveTables) do begin
400- with vSaveTables[I] do begin
401- //Use appropriate global variable
402- case StringToCaseSelect(Name,
403- ['Products','Boms','Stocks','Orders',
404- 'BomCalculationProducts','BomCalculationComponents','BomCalculationFooter',
405- 'BomCalculationProductsMultiple','BomCalculationComponentsMultiple','BomCalculationFooterMultiple',
406- 'ImportVariants','ImportToTables','ImportToFields','ImportFromTables','ImportFromFields']) of
407- 0:vId:=@vProductsId;
408- 1:vId:=@vBomsId;
409- 2:vId:=@vStocksId;
410- 3:vId:=@vOrdersId;
411- 4:vId:=@vBomCalculationProductsId;
412- 5:vId:=@vBomCalculationComponentsId;
413- 6:vId:=@vBomCalculationFooterId;
414- 7:vId:=@vBomCalculationProductsMultipleId;
415- 8:vId:=@vBomCalculationComponentsMultipleId;
416- 9:vId:=@vBomCalculationFooterMultipleId;
417- 10:vId:=@vImportVariantsId;
418- 11:vId:=@vImportToTablesId;
419- 12:vId:=@vImportToFieldsId;
420- 13:vId:=@vImportFromTablesId;
421- 14:vId:=@vImportFromFieldsId;
422- end;
423- try
424- //Find last value of Id and save it to global variable
425- Last;
426- vCurrentId:=FieldByName(Name+'Id').AsInteger;
427- if (vCurrentId>vId^) then vId^:=vCurrentId;
428- finally
429- //Remove reference;
430- vId:=nil;
431- end;
432- end;
340+var
341+ I:Integer;
342+ vId:^Integer;
343+begin
344+ try
345+ MemoMessages.Lines.Append(TimeToStr(Now())+' Getting information about autoincrement fields');
346+ vSuppressEvents:=True;
347+ //Disable controls and refresh all datasets
348+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
349+ vSaveTables[I].DisableControls;
350+ vSaveTables[I].Refresh; //Important if dataset was filtered
351+ end;
352+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
353+ with vSaveTables[I] do begin
354+ //Use appropriate global variable
355+ case StringToCaseSelect(Name,
356+ ['Products','Boms','Stocks','Orders',
357+ 'BomCalculationProducts','BomCalculationComponents','BomCalculationFooter',
358+ 'BomCalculationProductsMultiple','BomCalculationComponentsMultiple','BomCalculationFooterMultiple',
359+ 'ImportVariants','ImportToTables','ImportToFields','ImportFromTables','ImportFromFields']) of
360+ 0:vId:=@vProductsId;
361+ 1:vId:=@vBomsId;
362+ 2:vId:=@vStocksId;
363+ 3:vId:=@vOrdersId;
364+ 4:vId:=@vBomCalculationProductsId;
365+ 5:vId:=@vBomCalculationComponentsId;
366+ 6:vId:=@vBomCalculationFooterId;
367+ 7:vId:=@vBomCalculationProductsMultipleId;
368+ 8:vId:=@vBomCalculationComponentsMultipleId;
369+ 9:vId:=@vBomCalculationFooterMultipleId;
370+ 10:vId:=@vImportVariantsId;
371+ 11:vId:=@vImportToTablesId;
372+ 12:vId:=@vImportToFieldsId;
373+ 13:vId:=@vImportFromTablesId;
374+ 14:vId:=@vImportFromFieldsId;
433375 end;
434- finally
435- vSuppressEvents:=False;
436- //Refresh all datasets and enable controls
437- for I:=Low(vSaveTables) to High(vSaveTables) do begin
438- vSaveTables[I].Refresh;
439- vSaveTables[I].EnableControls;
376+ try
377+ //Find last value of Id and save it to global variable
378+ Last;
379+ vCurrentId:=FieldByName(Name+'Id').AsInteger;
380+ if (vCurrentId>vId^) then vId^:=vCurrentId;
381+ finally
382+ //Remove reference;
383+ vId:=nil;
440384 end;
441- MemoMessages.Lines.Append(TimeToStr(Now())+' Autoincrement fields - done.');
442385 end;
443386 end;
387+ finally
388+ vSuppressEvents:=False;
389+ //Refresh all datasets and enable controls
390+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
391+ vSaveTables[I].Refresh;
392+ vSaveTables[I].EnableControls;
393+ end;
394+ MemoMessages.Lines.Append(TimeToStr(Now())+' Autoincrement fields - done.');
395+ end;
396+end;
444397```
445398
446-
447-
448-```
399+``` pascal
449400function StringToCaseSelect(Selector:string;CaseList:array of string):Integer;
450- var
451- cnt: integer;
401+var
402+ cnt: integer;
403+begin
404+ Result:=-1;
405+ for cnt:=0 to Length(CaseList)-1 do
406+ begin
407+ if CompareText(Selector, CaseList[cnt]) = 0 then
452408 begin
453- Result:=-1;
454- for cnt:=0 to Length(CaseList)-1 do
455- begin
456- if CompareText(Selector, CaseList[cnt]) = 0 then
457- begin
458- Result:=cnt;
459- Break;
460- end;
461- end;
409+ Result:=cnt;
410+ Break;
462411 end;
412+ end;
413+end;
463414```
464415
465-La procédure GetAutoincrementPrimaryFields est appelées chaque fois après que vous restaurez (chargez) les données depuis des fichiers persistants, pour charger les dernières valeurs auto-incrémentées dans les variables globales (ou les propriétés si vous préférez). L'auto-incrémentation est faite dans l'événement OnNewRecord de chaque MemDataSet. Par exemple, pour le MemDataSet Orders :
466-```
416+La procédure GetAutoincrementPrimaryFields est appelées chaque fois après que vous restaurez (chargez) les données depuis des fichiers persistants, pour charger les dernières valeurs auto-incrémentées dans les variables globales (ou les propriétés si vous préférez). L'auto-incrémentation est faite dans l'événement OnNewRecord de chaque MemDataSet. Par exemple, pour le MemDataSet Orders :
417+
418+``` pascal
467419procedure TMainForm.OrdersNewRecord(DataSet: TDataSet);
468- begin
469- if vSuppressEvents=True then Exit;
470- //Set new autoincrement value
471- vOrdersId:=vOrdersId+1;
472- DataSet.FieldByName('OrdersId').AsInteger:=vOrdersId;
473- end;
420+begin
421+ if vSuppressEvents=True then Exit;
422+ //Set new autoincrement value
423+ vOrdersId:=vOrdersId+1;
424+ DataSet.FieldByName('OrdersId').AsInteger:=vOrdersId;
425+end;
474426```
475427
476-Comme précédemment expliqué, j'utilise la variable globale vSuppressEvents comme drapeau pour le cas de la restauration dees données depuis les fichiers persistants.
428+Comme précédemment expliqué, j'utilise la variable globale vSuppressEvents comme drapeau pour le cas de la restauration dees données depuis les fichiers persistants.
477429
478430## Faire respecter l'intégrité référentielle
479431
480-Il n'y a pas de respect de l'intégrité référentielle implémenté dans le composant MemDataSet, donc vous devez le faire par vous-même.
432+Il n'y a pas de respect de l'intégrité référentielle implémenté dans le composant MemDataSet, donc vous devez le faire par vous-même.
481433
482-Supposons que nous avons deux tables : MasterTable and DetailTable. Il y a divers endroits où le code d'intégrité référentielle demande à être utilisé :
434+Supposons que nous avons deux tables : MasterTable and DetailTable. Il y a divers endroits où le code d'intégrité référentielle demande à être utilisé :
483435
484- * Le code d'insertion/de mise à jour est logé dans l'événement `BeforePost` de DetailTable : avant que l'enregistrement de détail nouveau/modifié ne soit posté/enregistré, il a besoin d'être contrôlé pour se plier aux exigences de l'intégrité référentielle (i.e. la clé du DetailTable doit exister comme clé étrangère dans MasterTable).
485- * Le code de suppression est logé dans l'événement `BeforeDelete` de la table MasterTable : avant que l'enregistrement maître soit supprimé, il a besoin d'être sûr que ses enregistrements détails vérifient les exigences d'intégrité référentielle (i.e. qu'ils soient supprimés).
436+- Le code d'insertion/de mise à jour est logé dans l'événement `BeforePost` de DetailTable : avant que l'enregistrement de détail nouveau/modifié ne soit posté/enregistré, il a besoin d'être contrôlé pour se plier aux exigences de l'intégrité référentielle (i.e. la clé du DetailTable doit exister comme clé étrangère dans MasterTable).
437+- Le code de suppression est logé dans l'événement `BeforeDelete` de la table MasterTable : avant que l'enregistrement maître soit supprimé, il a besoin d'être sûr que ses enregistrements détails vérifient les exigences d'intégrité référentielle (i.e. qu'ils soient supprimés).
486438
487-```
439+``` pascal
488440procedure TMainForm.MasterTableBeforeDelete(DataSet: TDataSet);
489- begin
490- if vSuppressEvents=True then Exit;
491- try
492- DetailTable.DisableControls;
493- // Enforce referential delete ("cascade delete") for table "MasterTable"
494- while not DetailTable.EOF do begin
495- DetailTable.Delete;
496- end;
497- DetailTable.Refresh;
498- finally
499- DetailTable.EnableControls;
500- end;
441+begin
442+ if vSuppressEvents=True then Exit;
443+ try
444+ DetailTable.DisableControls;
445+ // Enforce referential delete ("cascade delete") for table "MasterTable"
446+ while not DetailTable.EOF do begin
447+ DetailTable.Delete;
501448 end;
449+ DetailTable.Refresh;
450+ finally
451+ DetailTable.EnableControls;
452+ end;
453+end;
502454```
503455
504-
505-
506-```
456+``` pascal
507457procedure TMainForm.DetailTableBeforePost(DataSet: TDataSet);
508- begin
509- if vSuppressEvents=True then Exit;
510- // Enforce referential insert/update for table "DetailTable" with
511- // foreign key "MasterTableID" linking to
512- // the MasterTable ID primary key field
513- DataSet.FieldByName('MasterTableId').AsInteger:=
514- MasterTable.FieldByName('ID').AsInteger;
515- end;
458+begin
459+ if vSuppressEvents=True then Exit;
460+ // Enforce referential insert/update for table "DetailTable" with
461+ // foreign key "MasterTableID" linking to
462+ // the MasterTable ID primary key field
463+ DataSet.FieldByName('MasterTableId').AsInteger:=
464+ MasterTable.FieldByName('ID').AsInteger;
465+end;
516466```
517467
518-Après que vous ayez fourni les insertion/mise jour/suppression référentielles, tout ce que vous devez faire est de filtrer les données. Vous faites ceci avec l'événement `AfterScroll` de MasterTable et dans l'événement `OnFilter` de DetailTable.
468+Après que vous ayez fourni les insertion/mise jour/suppression référentielles, tout ce que vous devez faire est de filtrer les données. Vous faites ceci avec l'événement `AfterScroll` de MasterTable et dans l'événement `OnFilter` de DetailTable.
519469
520-N'oubliez pas de définir la propriété `Filtered` de DetailTable à 'True'.
521-```
470+N'oubliez pas de définir la propriété `Filtered` de DetailTable à 'True'.
471+
472+``` pascal
522473procedure TMainForm.MasterTableAfterScroll(DataSet: TDataSet);
523- begin
524- if vSuppressEvents=True then Exit;
525- DetailTable.Refresh;
526- end;
474+begin
475+ if vSuppressEvents=True then Exit;
476+ DetailTable.Refresh;
477+end;
527478```
528479
529-
530-
531-```
480+``` pascal
532481procedure TMainForm.DetailTableFilterRecord(DataSet: TDataSet;
533- var Accept: Boolean);
534- begin
535- if vSuppressEvents=True then Exit;
536- // Show only child fields whose foreign key points to current
537- // master table record
538- Accept:=DataSet.FieldByName('MasterTableId').AsInteger=
539- MasterTable.FieldByName('ID').AsInteger;
540- end;
482+ var Accept: Boolean);
483+begin
484+ if vSuppressEvents=True then Exit;
485+ // Show only child fields whose foreign key points to current
486+ // master table record
487+ Accept:=DataSet.FieldByName('MasterTableId').AsInteger=
488+ MasterTable.FieldByName('ID').AsInteger;
489+end;
541490```
542491
543492## Problèmes connus
544493
545-Il y a plusieurs limitations dans l'utilisation des MemDatasets.
494+Il y a plusieurs limitations dans l'utilisation des MemDatasets.
546495
547- * La méthode `Locate` ne fonctionne pas.
548- * Le filtrage utilisant les propriétés Filter et Filtered ne fonctionne pas, vous devez utiliser du code en dur dans l'événement `OnFilter`.
549- * Une boucle de suppression des enregistrements semble être incroyablement lente. Donc j'utilise ma procédure `EmptyMemDataset` au lieu de `while not EOF do Delete;`.
550- * Dans FPC 2.6.x et antérieur, la méthode `CopyFromDataSet` copie uniquement les enregistrements depuis la position actuelle du curseur jusqu'à la fin du DataSet source. Donc, vous devez faire un `MemDataset1.First;` avant `MemDataSet2.CopyFromDataSet(MemDataset1);`. Cela a été corrigé dans le tronc de la révision 26233.
551- * Remarquez qu'il n'y a pas (encore) de `CopyFromDataset` dans Bufdataset, c'est donc actuellement un avantage pour MemDS.
552- * Voir le [rapport de bug](<http://bugs.freepascal.org/view.php?id=25426>).
496+- La méthode `Locate` ne fonctionne pas.
497+- Le filtrage utilisant les propriétés Filter et Filtered ne fonctionne pas, vous devez utiliser du code en dur dans l'événement `OnFilter`.
498+- Une boucle de suppression des enregistrements semble être incroyablement lente. Donc j'utilise ma procédure `EmptyMemDataset` au lieu de `while not EOF do Delete;`.
499+- Dans FPC 2.6.x et antérieur, la méthode `CopyFromDataSet` copie uniquement les enregistrements depuis la position actuelle du curseur jusqu'à la fin du DataSet source. Donc, vous devez faire un `MemDataset1.First;` avant `MemDataSet2.CopyFromDataSet(MemDataset1);`. Cela a été corrigé dans le tronc de la révision 26233.
500+ - Remarquez qu'il n'y a pas (encore) de `CopyFromDataset` dans Bufdataset, c'est donc actuellement un avantage pour MemDS.
501+ - Voir le [rapport de bug](http://bugs.freepascal.org/view.php?id=25426).
553502
554503## TBufDataSet
555504
556-Comme indiqué auparavant, MemDataSet est privé de filtre personnalisé, de type auto-incrémenté et de méthode Locate, il est donc mieux d'utiliser TBufDataSet à la place. TBufDataset est fourni par l'unité BufDataset.
505+Comme indiqué auparavant, MemDataSet est privé de filtre personnalisé, de type auto-incrémenté et de méthode Locate, il est donc mieux d'utiliser TBufDataSet à la place. TBufDataset est fourni par l'unité BufDataset.
557506
558-Puisqu'il n'y a pas de composant pour l'édition du TBufDataSet en conception (mais vous pouvez définir les champs lors de la conception), vous pouvez par le code créer un composant personnalisé enveloppe (_wrapper_) ou l'utiliser, à la manière de ClientDataSet dans Delphi. Consultez la documentation des ClientDataSet de Delphi pour les détails.
507+Puisqu'il n'y a pas de composant pour l'édition du TBufDataSet en conception (mais vous pouvez définir les champs lors de la conception), vous pouvez par le code créer un composant personnalisé enveloppe (*wrapper*) ou l'utiliser, à la manière de ClientDataSet dans Delphi. Consultez la documentation des ClientDataSet de Delphi pour les détails.
559508
560-Vous pouvez utiliser les mêmes méthodes pour faire respecter l'intégrité référentielle et les champs auto-incrémentés de clé primaire comme expliqué dans MemDataSet.
509+Vous pouvez utiliser les mêmes méthodes pour faire respecter l'intégrité référentielle et les champs auto-incrémentés de clé primaire comme expliqué dans MemDataSet.
561510
562-Il y a seulement de petites différences entre MemDataSet et BufDataset :
511+Il y a seulement de petites différences entre MemDataSet et BufDataset :
563512
564-MemDataSet | BufDataset
565----|---
566-DataSet.ClearFields | DataSet.Fields.Clear
567-DataSet.CreateTable | DataSet.CreateDataSet
568-
513+| MemDataSet | BufDataset |
514+|---------------------|-----------------------|
515+| DataSet.ClearFields | DataSet.Fields.Clear |
516+| DataSet.CreateTable | DataSet.CreateDataSet |
517+
569518## Trier un DBGrid sur l'événement TitleClick pour un TBufDataSet
570519
571-Si vous souhaitez activer le tri ascendant et descendant consécutivement dans un DBGrid montrant des données depuis un TBufDataSet, vous pourrez utiliser la méthode suivante :
572-```
520+Si vous souhaitez activer le tri ascendant et descendant consécutivement dans un DBGrid montrant des données depuis un TBufDataSet, vous pourrez utiliser la méthode suivante :
521+
522+``` pascal
573523Uses
574- BufDataset, typinfo;
575-
576- function SortBufDataSet(DataSet: TBufDataSet;const FieldName: String): Boolean;
577- var
578- i: Integer;
579- IndexDefs: TIndexDefs;
580- IndexName: String;
581- IndexOptions: TIndexOptions;
582- Field: TField;
524+ BufDataset, typinfo;
525+
526+function SortBufDataSet(DataSet: TBufDataSet;const FieldName: String): Boolean;
527+var
528+ i: Integer;
529+ IndexDefs: TIndexDefs;
530+ IndexName: String;
531+ IndexOptions: TIndexOptions;
532+ Field: TField;
533+begin
534+ Result := False;
535+ Field := DataSet.Fields.FindField(FieldName);
536+ //If invalid field name, exit.
537+ if Field = nil then Exit;
538+ //if invalid field type, exit.
539+ if {(Field is TObjectField) or} (Field is TBlobField) or
540+ {(Field is TAggregateField) or} (Field is TVariantField)
541+ or (Field is TBinaryField) then Exit;
542+ //Get IndexDefs and IndexName using RTTI
543+ if IsPublishedProp(DataSet, 'IndexDefs') then
544+ IndexDefs := GetObjectProp(DataSet, 'IndexDefs') as TIndexDefs
545+ else
546+ Exit;
547+ if IsPublishedProp(DataSet, 'IndexName') then
548+ IndexName := GetStrProp(DataSet, 'IndexName')
549+ else
550+ Exit;
551+ //Ensure IndexDefs is up-to-date
552+ IndexDefs.Updated:=false; {<<<<---This line is critical as IndexDefs.Update will do nothing on the next sort if it's already true}
553+ IndexDefs.Update;
554+ //If an ascending index is already in use,
555+ //switch to a descending index
556+ if IndexName = FieldName + '__IdxA'
557+ then
583558 begin
584- Result := False;
585- Field := DataSet.Fields.FindField(FieldName);
586- //If invalid field name, exit.
587- if Field = nil then Exit;
588- //if invalid field type, exit.
589- if {(Field is TObjectField) or} (Field is TBlobField) or
590- {(Field is TAggregateField) or} (Field is TVariantField)
591- or (Field is TBinaryField) then Exit;
592- //Get IndexDefs and IndexName using RTTI
593- if IsPublishedProp(DataSet, 'IndexDefs') then
594- IndexDefs := GetObjectProp(DataSet, 'IndexDefs') as TIndexDefs
595- else
596- Exit;
597- if IsPublishedProp(DataSet, 'IndexName') then
598- IndexName := GetStrProp(DataSet, 'IndexName')
599- else
600- Exit;
601- //Ensure IndexDefs is up-to-date
602- IndexDefs.Updated:=false; {<<<<---This line is critical as IndexDefs.Update will do nothing on the next sort if it's already true}
603- IndexDefs.Update;
604- //If an ascending index is already in use,
605- //switch to a descending index
606- if IndexName = FieldName + '__IdxA'
607- then
608- begin
609- IndexName := FieldName + '__IdxD';
610- IndexOptions := [ixDescending];
611- end
612- else
613- begin
614- IndexName := FieldName + '__IdxA';
615- IndexOptions := [];
616- end;
617- //Look for existing index
618- for i := 0 to Pred(IndexDefs.Count) do
619- begin
620- if IndexDefs[i].Name = IndexName then
621- begin
622- Result := True;
623- Break
624- end; //if
625- end; // for
626- //If existing index not found, create one
627- if not Result then
628- begin
629- if IndexName=FieldName + '__IdxD' then
630- DataSet.AddIndex(IndexName, FieldName, IndexOptions, FieldName)
631- else
632- DataSet.AddIndex(IndexName, FieldName, IndexOptions);
633- Result := True;
634- end; // if not
635- //Set the index
636- SetStrProp(DataSet, 'IndexName', IndexName);
559+ IndexName := FieldName + '__IdxD';
560+ IndexOptions := [ixDescending];
561+ end
562+ else
563+ begin
564+ IndexName := FieldName + '__IdxA';
565+ IndexOptions := [];
637566 end;
567+ //Look for existing index
568+ for i := 0 to Pred(IndexDefs.Count) do
569+ begin
570+ if IndexDefs[i].Name = IndexName then
571+ begin
572+ Result := True;
573+ Break
574+ end; //if
575+ end; // for
576+ //If existing index not found, create one
577+ if not Result then
578+ begin
579+ if IndexName=FieldName + '__IdxD' then
580+ DataSet.AddIndex(IndexName, FieldName, IndexOptions, FieldName)
581+ else
582+ DataSet.AddIndex(IndexName, FieldName, IndexOptions);
583+ Result := True;
584+ end; // if not
585+ //Set the index
586+ SetStrProp(DataSet, 'IndexName', IndexName);
587+end;
638588```
639589
640-Ainsi, vous pouvez appeler cette fonction depuis un DBGride de cette manière :
641-```
590+Ainsi, vous pouvez appeler cette fonction depuis un DBGride de cette manière :
591+
592+``` pascal
642593procedure TFormMain.DBGridProductsTitleClick(Column: TColumn);
643- begin
644- SortBufDataSet(Products, Column.FieldName);
645- end;
594+begin
595+ SortBufDataSet(Products, Column.FieldName);
596+end;
646597```
647598
648599## Tri sur des colonnes multiples dans un DBGrid
649600
650-J'ai écrit TDBGridHelper pour le tri d'une grille par des colonnes multiples entre tenant enfoncé la touche majuscule (_shift_).
601+J'ai écrit TDBGridHelper pour le tri d'une grille par des colonnes multiples entre tenant enfoncé la touche majuscule (*shift*).
651602
652-Reamrquez que MaxIndexesCount doit être défini plutôt grand pour TBufDataSet parce qu'il peut y avoir de larges combinaisons d'options de tri possibles. Mais je pense que les gens ne voudront pas en utiliser plus de 10 donc la mettre à 100 devrait théoriquement suffire.
653-```
603+Reamrquez que MaxIndexesCount doit être défini plutôt grand pour TBufDataSet parce qu'il peut y avoir de larges combinaisons d'options de tri possibles. Mais je pense que les gens ne voudront pas en utiliser plus de 10 donc la mettre à 100 devrait théoriquement suffire.
604+
605+``` pascal
606+ { TDBGridHelper }
607+
608+ TDBGridHelper = class helper for TDBGrid
609+ public const
610+ cMaxColCOunt = 3;
611+ private
612+ procedure Internal_MakeNames(Fields: TStrings; out FieldsList, DescFields: String);
613+ procedure Internal_SetColumnsIcons(Fields: TStrings; AscIdx, DescIdx: Integer);
614+ function Internal_IndexNameExists(IndexDefs: TIndexDefs; IndexName: String): Boolean;
615+ public
616+ procedure Sort(const FieldName: String; AscIdx: Integer = -1; DescIdx: Integer = -1);
617+ procedure ClearSort;
618+ end;
619+
654620{ TDBGridHelper }
655-
656- TDBGridHelper = class helper for TDBGrid
657- public const
658- cMaxColCOunt = 3;
659- private
660- procedure Internal_MakeNames(Fields: TStrings; out FieldsList, DescFields: String);
661- procedure Internal_SetColumnsIcons(Fields: TStrings; AscIdx, DescIdx: Integer);
662- function Internal_IndexNameExists(IndexDefs: TIndexDefs; IndexName: String): Boolean;
663- public
664- procedure Sort(const FieldName: String; AscIdx: Integer = -1; DescIdx: Integer = -1);
665- procedure ClearSort;
666- end;
667-
668- { TDBGridHelper }
669-
670- procedure TDBGridHelper.Internal_MakeNames(Fields: TStrings; out FieldsList, DescFields: String);
671- var
672- FldList: TStringList;
673- DscList: TStringList;
674- FldDesc, FldName: String;
675- i: Integer;
676- begin
677- if Fields.Count = 0 then
678- begin
679- FieldsList := '';
680- DescFields := '';
681- Exit;
682- end;
683-
684- FldList := TStringList.Create;
685- DscList := TStringList.Create;
686- try
687- FldList.Delimiter := ';';
688- DscList.Delimiter := ';';
689-
690- for i := 0 to Fields.Count - 1 do
691- begin
692- Fields.GetNameValue(i, FldName, FldDesc);
693- FldList.Add(FldName);
694-
695- if FldDesc = 'D' then
696- DscList.Add(FldName);
697- end;
698-
699- FieldsList := FldList.DelimitedText;
700- DescFields := DscList.DelimitedText;
701- finally
702- FldList.Free;
703- DscList.Free;
704- end;
705- end;
706-
707- procedure TDBGridHelper.Internal_SetColumnsIcons(Fields: TStrings; AscIdx, DescIdx: Integer);
708- var
709- i: Integer;
710- FldDesc: String;
711- begin
712- for i := 0 to Self.Columns.Count - 1 do
713- begin
714- FldDesc := Fields.Values[Self.Columns[i].Field.FieldName];
715-
716- if FldDesc = 'A' then
717- Self.Columns[i].Title.ImageIndex := AscIdx
718- else
719- if FldDesc = 'D' then
720- Self.Columns[i].Title.ImageIndex := DescIdx
721- else
722- Self.Columns[i].Title.ImageIndex := -1
723- end;
724- end;
725-
726- function TDBGridHelper.Internal_IndexNameExists(IndexDefs: TIndexDefs; IndexName: String): Boolean;
727- var
728- i: Integer;
621+
622+procedure TDBGridHelper.Internal_MakeNames(Fields: TStrings; out FieldsList, DescFields: String);
623+var
624+ FldList: TStringList;
625+ DscList: TStringList;
626+ FldDesc, FldName: String;
627+ i: Integer;
628+begin
629+ if Fields.Count = 0 then
630+ begin
631+ FieldsList := '';
632+ DescFields := '';
633+ Exit;
634+ end;
635+
636+ FldList := TStringList.Create;
637+ DscList := TStringList.Create;
638+ try
639+ FldList.Delimiter := ';';
640+ DscList.Delimiter := ';';
641+
642+ for i := 0 to Fields.Count - 1 do
729643 begin
730- for i := 0 to IndexDefs.Count - 1 do
731- begin
732- if IndexDefs[i].Name = IndexName then
733- Exit(True)
734- end;
735-
736- Result := False
644+ Fields.GetNameValue(i, FldName, FldDesc);
645+ FldList.Add(FldName);
646+
647+ if FldDesc = 'D' then
648+ DscList.Add(FldName);
737649 end;
738-
739- procedure TDBGridHelper.Sort(const FieldName: String; AscIdx: Integer;
740- DescIdx: Integer);
741- var
742- Field: TField;
743- DataSet: TBufDataset;
744- IndexDefs: TIndexDefs;
745- IndexName, Dir, DescFields, FieldsList: String;
746- Fields: TStringList;
650+
651+ FieldsList := FldList.DelimitedText;
652+ DescFields := DscList.DelimitedText;
653+ finally
654+ FldList.Free;
655+ DscList.Free;
656+ end;
657+end;
658+
659+procedure TDBGridHelper.Internal_SetColumnsIcons(Fields: TStrings; AscIdx, DescIdx: Integer);
660+var
661+ i: Integer;
662+ FldDesc: String;
663+begin
664+ for i := 0 to Self.Columns.Count - 1 do
665+ begin
666+ FldDesc := Fields.Values[Self.Columns[i].Field.FieldName];
667+
668+ if FldDesc = 'A' then
669+ Self.Columns[i].Title.ImageIndex := AscIdx
670+ else
671+ if FldDesc = 'D' then
672+ Self.Columns[i].Title.ImageIndex := DescIdx
673+ else
674+ Self.Columns[i].Title.ImageIndex := -1
675+ end;
676+end;
677+
678+function TDBGridHelper.Internal_IndexNameExists(IndexDefs: TIndexDefs; IndexName: String): Boolean;
679+var
680+ i: Integer;
681+begin
682+ for i := 0 to IndexDefs.Count - 1 do
683+ begin
684+ if IndexDefs[i].Name = IndexName then
685+ Exit(True)
686+ end;
687+
688+ Result := False
689+end;
690+
691+procedure TDBGridHelper.Sort(const FieldName: String; AscIdx: Integer;
692+ DescIdx: Integer);
693+var
694+ Field: TField;
695+ DataSet: TBufDataset;
696+ IndexDefs: TIndexDefs;
697+ IndexName, Dir, DescFields, FieldsList: String;
698+ Fields: TStringList;
699+begin
700+ if not Assigned(DataSource.DataSet) or
701+ not DataSource.DataSet.Active or
702+ not (DataSource.DataSet is TBufDataset) then
703+ Exit;
704+ DataSet := DataSource.DataSet as TBufDataset;
705+
706+ Field := DataSet.FieldByName(FieldName);
707+ if (Field is TBlobField) or (Field is TVariantField) or (Field is TBinaryField) then
708+ Exit;
709+
710+ IndexDefs := DataSet.IndexDefs;
711+ IndexName := DataSet.IndexName;
712+
713+ if not IndexDefs.Updated then
714+ IndexDefs.Update;
715+
716+ Fields := TStringList.Create;
717+ try
718+ Fields.DelimitedText := IndexName;
719+ Dir := Fields.Values[FieldName];
720+
721+ if Dir = 'A' then
722+ Dir := 'D'
723+ else
724+ if Dir = 'D' then
725+ Dir := 'A'
726+ else
727+ Dir := 'A';
728+
729+ //If shift is presed then add field to field list
730+ if ssShift in GetKeyShiftState then
747731 begin
748- if not Assigned(DataSource.DataSet) or
749- not DataSource.DataSet.Active or
750- not (DataSource.DataSet is TBufDataset) then
751- Exit;
752- DataSet := DataSource.DataSet as TBufDataset;
753-
754- Field := DataSet.FieldByName(FieldName);
755- if (Field is TBlobField) or (Field is TVariantField) or (Field is TBinaryField) then
732+ Fields.Values[FieldName] := Dir;
733+ //We do not add to sor any more field if total field count exids cMaxColCOunt
734+ if Fields.Count > cMaxColCOunt then
756735 Exit;
757-
758- IndexDefs := DataSet.IndexDefs;
759- IndexName := DataSet.IndexName;
760-
761- if not IndexDefs.Updated then
762- IndexDefs.Update;
763-
764- Fields := TStringList.Create;
765- try
766- Fields.DelimitedText := IndexName;
767- Dir := Fields.Values[FieldName];
768-
769- if Dir = 'A' then
770- Dir := 'D'
771- else
772- if Dir = 'D' then
773- Dir := 'A'
774- else
775- Dir := 'A';
776-
777- //If shift is presed then add field to field list
778- if ssShift in GetKeyShiftState then
779- begin
780- Fields.Values[FieldName] := Dir;
781- //We do not add to sor any more field if total field count exids cMaxColCOunt
782- if Fields.Count > cMaxColCOunt then
783- Exit;
784- end
785- else
786- begin
787- Fields.Clear;
788- Fields.Values[FieldName] := Dir;
789- end;
790-
791- IndexName := Fields.DelimitedText;
792- if not Internal_IndexNameExists(IndexDefs, IndexName) then
793- begin
794- Interbal_MakeNames(Fields, FieldsList, DescFields);
795- TBufDataset(DataSet).AddIndex(IndexName, FieldsList, [], DescFields, '');
796- end;
797-
798- DataSet.IndexName := IndexName;
799- Internal_SetColumnsIcons(Fields, AscIdx, DescIdx)
800- finally
801- Fields.Free;
802- end;
736+ end
737+ else
738+ begin
739+ Fields.Clear;
740+ Fields.Values[FieldName] := Dir;
803741 end;
804-
805- procedure TDBGridHelper.ClearSort;
806- var
807- DataSet: TBufDataset;
808- Fields: TStringList;
742+
743+ IndexName := Fields.DelimitedText;
744+ if not Internal_IndexNameExists(IndexDefs, IndexName) then
809745 begin
810- if not Assigned(DataSource.DataSet) or
811- not DataSource.DataSet.Active or
812- not (DataSource.DataSet is TBufDataset) then
813- Exit;
814- DataSet := DataSource.DataSet as TBufDataset;
815-
816- DataSet.IndexName := '';
817-
818- Fields := TStringList.Create;
819- try
820- Internal_SetColumnsIcons(Fields, -1, -1)
821- finally
822- Fields.Free
823- end
746+ Interbal_MakeNames(Fields, FieldsList, DescFields);
747+ TBufDataset(DataSet).AddIndex(IndexName, FieldsList, [], DescFields, '');
824748 end;
825-```
826749
827-Pour utiliser le tri, vous avez besoin d'appeler les méthode du helper dans OnCellClick et onTitleClick.
750+ DataSet.IndexName := IndexName;
751+ Internal_SetColumnsIcons(Fields, AscIdx, DescIdx)
752+ finally
753+ Fields.Free;
754+ end;
755+end;
828756
829- * OnTitleClick - Si vous tenez enfoncé 'shift', pour ajouter une nouvelle colonne à la liste de tri ou changer le sens du tri ou seulement trier sur une colonne
830- * OnCellClick - Si vous double-cliquez sur la cellule cell[0, 0] de la grille, cela efface le tri.
757+procedure TDBGridHelper.ClearSort;
758+var
759+ DataSet: TBufDataset;
760+ Fields: TStringList;
761+begin
762+ if not Assigned(DataSource.DataSet) or
763+ not DataSource.DataSet.Active or
764+ not (DataSource.DataSet is TBufDataset) then
765+ Exit;
766+ DataSet := DataSource.DataSet as TBufDataset;
831767
768+ DataSet.IndexName := '';
769+
770+ Fields := TStringList.Create;
771+ try
772+ Internal_SetColumnsIcons(Fields, -1, -1)
773+ finally
774+ Fields.Free
775+ end
776+end;
832777```
778+
779+Pour utiliser le tri, vous avez besoin d'appeler les méthode du helper dans OnCellClick et onTitleClick.
780+
781+- OnTitleClick - Si vous tenez enfoncé 'shift', pour ajouter une nouvelle colonne à la liste de tri ou changer le sens du tri ou seulement trier sur une colonne
782+- OnCellClick - Si vous double-cliquez sur la cellule cell\[0, 0\] de la grille, cela efface le tri.
783+
784+``` pascal
833785procedure TForm1.grdCountriesCellClick(Column: TColumn);
834- begin
835- if not Assigned(Column) then
836- grdCountries.ClearSort
837- end;
838-
839- procedure TForm1.grdCountriesTitleClick(Column: TColumn);
840- begin
841- grdCountries.Sort(Column.Field.FieldName, 0, 1);
842- end;
786+begin
787+ if not Assigned(Column) then
788+ grdCountries.ClearSort
789+end;
790+
791+procedure TForm1.grdCountriesTitleClick(Column: TColumn);
792+begin
793+ grdCountries.Sort(Column.Field.FieldName, 0, 1);
794+end;
843795```
844796
845-Si vous avez affecté TitleImageList, alors vous pouvez spécifier quelle image utiliser pour le tri ascendant et quelle autre pour le tri descendant.
797+Si vous avez affecté TitleImageList, alors vous pouvez spécifier quelle image utiliser pour le tri ascendant et quelle autre pour le tri descendant.
846798
847799## ZMSQL
848800
849-Une autre façon, souvent meilleure, de travailler avec des bases de données en mémoire consiste à utiliser le paquet ZMSQL :
801+Une autre façon, souvent meilleure, de travailler avec des bases de données en mémoire consiste à utiliser le paquet ZMSQL :
850802
851- * [[ZMSQL]]
852- * <http://sourceforge.net/projects/lazarus-ccr/files/zmsql/>
853- * <http://www.lazarus.freepascal.org/index.php/topic,13821.30.html>
803+- [[ZMSQL]]
804+- [<http://sourceforge.net/projects/lazarus-ccr/files/zmsql/>](http://sourceforge.net/projects/lazarus-ccr/files/zmsql/)
805+- [<http://www.lazarus.freepascal.org/index.php/topic,13821.30.html>](http://www.lazarus.freepascal.org/index.php/topic,13821.30.html)
854806
855807## Contributeurs
856808
857809Texte original écrit par : Zlatko Matić (matalab@gmail.com) Les autres contributions sont données dans la page Historique.
858810
859811---
860-*From the Free Pascal wiki, page "How to write in-memory database applications in Lazarus/FPC/fr", as the Internet Archive kept it on 2025-03-15. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*
812+*From the Free Pascal wiki, page "How to write in-memory database applications in Lazarus/FPC/fr", as it stood on 2020-02-17 after a change by Trev, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*

Back to history