Sign in Join
Wiki copytemporary

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

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

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

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+
41+## Introduction
42+
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.
44+
45+Certains bénéfices sont :
46+
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.
51+
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]].
53+
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.
55+
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.
57+
58+C'est l'unité memds qui fournit TMemDataset, vous devrez donc l'ajouter dasn vos clauses uses.
59+
60+## Enregistrer des MemDatasets dans des fichiers persistants
61+
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.
63+
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.
65+
66+Vous obtenez ceci :
67+```
68+type
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;
75+```
76+
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+```
79+const
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
82+```
83+
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+```
86+procedure 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;
108+```
109+
110+
111+
112+```
113+procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
114+ begin
115+ //Save memdatasets to files (to save current session)
116+ SaveSession;
117+ end;
118+```
119+
120+
121+
122+```
123+procedure RestoreSession;
124+ var
125+ I:Integer;
126+ begin
127+ 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
134+ 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;
155+ 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....
171+ end;
172+ MemoMessages.Append(TimeToStr(Now())+' Table: '+vSaveTables[I].Name+' restored.');
173+ end;
174+ 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.');
182+ end;
183+ end;
184+```
185+
186+
187+
188+```
189+procedure SaveSession;
190+ var
191+ I:Integer;
192+ begin
193+ 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.');
217+ 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;
224+ end;
225+ MemoMessages.Append(TimeToStr(Now())+' All tables saved to files.');
226+ end;
227+ end;
228+```
229+
230+
231+
232+```
233+procedure 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;
260+ end;
261+ end;
262+```
263+
264+
265+
266+```
267+procedure 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;
305+ end;
306+ SdfDataSetTemporary.Next;
307+ end;
308+ finally
309+ SdfDataSetTemporary.Active:=False;
310+ SdfDataSetTemporary.ClearFields;
311+ end;
312+ end;
313+```
314+
315+
316+
317+```
318+procedure 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
340+ 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;
353+ end;
354+ finally
355+ CloseFile(myTextFile);
356+ end;
357+ end;
358+```
359+
360+## Clés primaires auto-incrémentées
361+
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+```
364+var
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;
382+```
383+
384+Ensuite nous avons une procédure pour le calcul des valeurs du champ auto-incrémenté :
385+```
386+procedure 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;
433+ 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;
440+ end;
441+ MemoMessages.Lines.Append(TimeToStr(Now())+' Autoincrement fields - done.');
442+ end;
443+ end;
444+```
445+
446+
447+
448+```
449+function StringToCaseSelect(Selector:string;CaseList:array of string):Integer;
450+ var
451+ cnt: integer;
452+ 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;
462+ end;
463+```
464+
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+```
467+procedure 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;
474+```
475+
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.
477+
478+## Faire respecter l'intégrité référentielle
479+
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.
481+
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é :
483+
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).
486+
487+```
488+procedure 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;
501+ end;
502+```
503+
504+
505+
506+```
507+procedure 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;
516+```
517+
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.
519+
520+N'oubliez pas de définir la propriété `Filtered` de DetailTable à 'True'.
521+```
522+procedure TMainForm.MasterTableAfterScroll(DataSet: TDataSet);
523+ begin
524+ if vSuppressEvents=True then Exit;
525+ DetailTable.Refresh;
526+ end;
527+```
528+
529+
530+
531+```
532+procedure 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;
541+```
542+
543+## Problèmes connus
544+
545+Il y a plusieurs limitations dans l'utilisation des MemDatasets.
546+
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>).
553+
554+## TBufDataSet
555+
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.
557+
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.
559+
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.
561+
562+Il y a seulement de petites différences entre MemDataSet et BufDataset :
563+
564+MemDataSet | BufDataset
565+---|---
566+DataSet.ClearFields | DataSet.Fields.Clear
567+DataSet.CreateTable | DataSet.CreateDataSet
568+
569+## Trier un DBGrid sur l'événement TitleClick pour un TBufDataSet
570+
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+```
573+Uses
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;
583+ 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);
637+ end;
638+```
639+
640+Ainsi, vous pouvez appeler cette fonction depuis un DBGride de cette manière :
641+```
642+procedure TFormMain.DBGridProductsTitleClick(Column: TColumn);
643+ begin
644+ SortBufDataSet(Products, Column.FieldName);
645+ end;
646+```
647+
648+## Tri sur des colonnes multiples dans un DBGrid
649+
650+J'ai écrit TDBGridHelper pour le tri d'une grille par des colonnes multiples entre tenant enfoncé la touche majuscule (_shift_).
651+
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+```
654+{ 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;
729+ 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
737+ 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;
747+ 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
756+ 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;
803+ end;
804+
805+ procedure TDBGridHelper.ClearSort;
806+ var
807+ DataSet: TBufDataset;
808+ Fields: TStringList;
809+ 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
824+ end;
825+```
826+
827+Pour utiliser le tri, vous avez besoin d'appeler les méthode du helper dans OnCellClick et onTitleClick.
828+
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.
831+
832+```
833+procedure 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;
843+```
844+
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.
846+
847+## ZMSQL
848+
849+Une autre façon, souvent meilleure, de travailler avec des bases de données en mémoire consiste à utiliser le paquet ZMSQL :
850+
851+ * [[ZMSQL]]
852+ * <http://sourceforge.net/projects/lazarus-ccr/files/zmsql/>
853+ * <http://www.lazarus.freepascal.org/index.php/topic,13821.30.html>
854+
855+## Contributeurs
856+
857+Texte original écrit par : Zlatko Matić (matalab@gmail.com) Les autres contributions sont données dans la page Historique.
858+
859+---
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).*

Back to history