Sign in Join
Wiki copytemporary

How to write in-memory database applications in Lazarus/FPC/ja: 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/ja

OldNewLine
1+---
2+[[Portal:Databases/ja|**データベースのポータル**]]
3+参照:
4+
5+ * [[Databases/ja|Databases 概要]]
6+ * [[Database libraries/ja|ライブラリ]]
7+ * [[Database field type/ja|フィールドの型]]
8+ * [[Data Controls tab/ja|コントロール]]
9+ * [[Lazarus DB Faq/ja|FAQ]]
10+ * [[SqlDBHowto/ja]]
11+ * [[Working With TSQLQuery/ja|TSQLQuery の利用]]
12+ * メモリ上で動作するデータベースの作り方
13+
14+チュートリアル/練習となる記事:
15+
16+ * [[Lazarus Database Overview/ja|概要]]
17+ * [[SQLdb Tutorial0/ja|0 - データベースのセットアップ]]
18+ * [[SQLdb Tutorial1/ja|1 - 開始]]
19+ * [[SQLdb Tutorial2/ja|2 - 編集]]
20+ * [[SQLdb Tutorial3/ja|3 - クエリ]]
21+ * [[SQLdb Tutorial4/ja|4 - データモジュール]]
22+ * [[SQLdb Programming Reference/ja]]
23+
24+各種データベース
25+
26+ [[Advantage Database Server/ja|Advantage]] \- [[MySQLDatabases/ja|MySQL]] \- [MSSQL](</index.php?title=mssqlconn/ja&action=edit&redlink=1> "mssqlconn/ja \(page does not exist\)") \- [[postgres/ja|Postgres]] \- [[Firebird/ja|Interbase]] \- [[Firebird/ja|Firebird]] \- [[Oracle/ja|Oracle]] \- [[ODBCConn/ja|ODBC]] \- [Paradox](</index.php?title=TParadox/ja&action=edit&redlink=1> "TParadox/ja \(page does not exist\)") \- [[SQLite/ja|SQLite]] \- [dBASE](</index.php?title=Lazarus_Tdbf_Tutorial/ja&action=edit&redlink=1> "Lazarus Tdbf Tutorial/ja \(page does not exist\)") \- [[MS Access/ja|MS Access]] \- [Zeos](</index.php?title=Zeos_tutorial/ja&action=edit&redlink=1> "Zeos tutorial/ja \(page does not exist\)")
27+
28+## Contents
29+
30+ * 1 イントロダクション
31+ * 2 Saving MemDatasets to persistent files
32+ * 3 Autoincrement Primary Keys
33+ * 4 Enforcing Referential Integrity
34+ * 5 Known problems
35+ * 6 TBufDataSet
36+ * 7 Sorting DBGrid on TitleClick event for TBufDataSet
37+ * 8 Sorting multiple columns in grid
38+ * 9 ZMSQL
39+ * 10 Contributors
40+
41+## イントロダクション
42+
43+There are certain circumstances when in-memory datasets make sense. If you need a fast, single-user, non mission-critical, non SQL database, without need for transactions, [[TMemDataset]] could suit your needs.
44+
45+Some benefits are:
46+
47+ * Fast execution. Since all processing is done in memory, no data is saved on hard disk until explicitly asked. Memory is surely faster than hard disk.
48+ * No need for external libraries (no .so or .dll files), no need for server installation
49+ * Code is multiplatform and can be compiled on any OS instantly
50+ * Since all programming is done in Lazarus/FPC, such applications are easier for maintenance. Instead of constantly switching from back-end programming to front-end programming, by using MemDatasets you can concentrate on your Pascal code.
51+
52+![Light bulb](https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png) **Note:** later on in this article, BufDataset is introduced. [[TBufDataset]] often is a better choice than [[TMemDataset]]
53+
54+I will illustrate how to program relational non-SQL memory databases, focusing on enforcing relation integrity and filtering, simulating auto-increment primary fields and similar.
55+
56+This page shares with you what I have learned experimenting with TMemDatasets. There might be some other, more efficient way to do this. If so, please, feel free to contribute to this document for the benefit of the Lazarus/FPC community.
57+
58+The memds unit provides TMemDataset, so you will need to add that to your uses clause.
59+
60+## Saving MemDatasets to persistent files
61+
62+In the [[Interface|interface]] part of your code, declare an array type for storing information about all the TMemDataSets that you want to make persistent at the end of a session and restore at the beginning of the next session. You have to declare a variable of type TSaveTables, too.
63+
64+I also use a global variable vSuppressEvents of type boolean, for suppressing Dataset events used for referential integrity enforcement, during data restore.
65+
66+You get this:
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+Instead of using global variables like I did, you could make them a property of the main form, also. TMemDataset has a way to natively store data to persistent file: the SaveToFile method. But, you could rather choose to save data to [[CSV]] files for easier external post processing. Therefore, I will combine both ways into same procedures. I define a constant cSaveRestore in the Interface part, by which I can define whether data will be stored and loaded as native MemDataset files or CSV files.
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+Now, you can save MemDatasets on FormClose event and load them on FormCreate event. Instantiate elements of the array of MemDatasets on the FormCreate event, too.
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+procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
111+ begin
112+ //Save memdatasets to files (to save current session)
113+ SaveSession;
114+ end;
115+```
116+```
117+procedure RestoreSession;
118+ var
119+ I:Integer;
120+ begin
121+ try
122+ MemoMessages.Append(TimeToStr(Now())+' Starting restoration of previously saved session.');
123+ vSuppressEvents:=True; //Supress events used for referential integrity enforcing
124+ //Disable controls and refresh all datasets
125+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
126+ vSaveTables[I].DisableControls;
127+ vSaveTables[I].Refresh; //Important if dataset was filtered
128+ end;
129+ //Load memdatasets from files (to restore previous session)
130+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
131+ vSaveTables[I].First;
132+ MemoMessages.Append(TimeToStr(Now())+' Starting restoration of table: '+vSaveTables[I].Name);
133+ try
134+ //If data is loaded from a csv file, then table must be deleted first.
135+ if cSaveRestore=1 then begin
136+ MemoMessages.Append(TimeToStr(Now())+' Starting delete of all records in table: '+vSaveTables[I].Name);
137+ //This way of deleting all records is incredibly slow.
138+ {while not vSaveTables[I].EOF do begin
139+ vSaveTables[I].Delete;
140+ end;}
141+ //This method for deleting of all records is much faster
142+ EmptyMemDataSet(vSaveTables[I]);
143+ MemoMessages.Append(TimeToStr(Now())+' All records from table: '+vSaveTables[I].Name+' deleted.');
144+ end;
145+ except
146+ on E:Exception do begin
147+ MemoMessages.Append(TimeToStr(Now())+' Error while deleteing records from table: '+vSaveTables[I].Name +'. '+E.Message);
148+ end;
149+ end;
150+ try
151+ try
152+ MemoMessages.Append(TimeToStr(Now())+' Restoring table: '+vSaveTables[I].Name);
153+ //Check constant for way of saving/restoring data and load saved session
154+ case cSaveRestore of
155+ 0:vSaveTables[I].LoadFromFile(vSaveTables[I].Name);
156+ 1:LoadFromCsv(vSaveTables[I]);
157+ end;
158+ except
159+ on E:Exception do begin
160+ MemoMessages.Append(TimeToStr(Now())+' Error while restoring table: '+vSaveTables[I].Name +'. '+E.Message);
161+ end;
162+ end;
163+ finally
164+ vSaveTables[I].Active:=True;//Needed because of LoadFromFile method....
165+ end;
166+ MemoMessages.Append(TimeToStr(Now())+' Table: '+vSaveTables[I].Name+' restored.');
167+ end;
168+ finally
169+ vSuppressEvents:=False;
170+ //Refresh all datasets and enable controls
171+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
172+ vSaveTables[I].Refresh; //Needed for tables that are filtered.
173+ vSaveTables[I].EnableControls;
174+ end;
175+ MemoMessages.Append(TimeToStr(Now())+' All tables restored from saved files.');
176+ end;
177+ end;
178+```
179+```
180+procedure SaveSession;
181+ var
182+ I:Integer;
183+ begin
184+ try
185+ MemoMessages.Append(TimeToStr(Now())+' Starting saving session to persistent files.');
186+ vSuppressEvents:=True;
187+ //Disable controls and refresh all datasets
188+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
189+ vSaveTables[I].DisableControls;
190+ vSaveTables[I].Refresh; //Important if dataset was filtered
191+ end;
192+ //Save session to file
193+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
194+ vSaveTables[I].First;
195+ MemoMessages.Append(TimeToStr(Now())+' Saving table: '+vSaveTables[I].Name);
196+ try
197+ //Check constant for way of saving/restoring data and save session
198+ case cSaveRestore of
199+ 0:vSaveTables[I].SaveToFile(vSaveTables[I].Name);
200+ 1:SaveToCsv(vSaveTables[I]);
201+ end;
202+ except
203+ on E:Exception do begin
204+ MemoMessages.Append(TimeToStr(Now())+' Error while saving table: '+vSaveTables[I].Name +'. '+E.Message);
205+ end;
206+ end;
207+ MemoMessages.Append(TimeToStr(Now())+' Table: '+vSaveTables[I].Name+' saved.');
208+ end;
209+ finally
210+ vSuppressEvents:=False;
211+ //Refresh all datasets and enable controls
212+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
213+ vSaveTables[I].Refresh; //Needed for tables that are filtered
214+ vSaveTables[I].EnableControls;
215+ end;
216+ MemoMessages.Append(TimeToStr(Now())+' All tables saved to files.');
217+ end;
218+ end;
219+```
220+```
221+procedure EmptyMemDataSet(DataSet:TMemDataSet);
222+ var
223+ vTemporaryMemDataSet:TMemDataSet;
224+ vFieldDef:TFieldDef;
225+ I:Integer;
226+ begin
227+ try
228+ //Create temporary MemDataSet
229+ vTemporaryMemDataSet:=TMemDataSet.Create(nil);
230+ //Store FieldDefs to Temporary MemDataSet
231+ for I:=0 to DataSet.FieldDefs.Count-1 do begin
232+ vFieldDef:=vTemporaryMemDataSet.FieldDefs.AddFieldDef;
233+ with DataSet.FieldDefs[I] do begin
234+ vFieldDef.Name:=Name;
235+ vFieldDef.DataType:=DataType;
236+ vFieldDef.Size:=Size;
237+ vFieldDef.Required:=Required;
238+ end;
239+ end;
240+ //Clear existing fielddefs
241+ DataSet.Clear;
242+ //Restore fielddefs
243+ DataSet.FieldDefs:=vTemporaryMemDataSet.FieldDefs;
244+ DataSet.Active:=True;
245+ finally
246+ vTemporaryMemDataSet.Clear;
247+ vTemporaryMemDataSet.Free;
248+ end;
249+ end;
250+```
251+```
252+procedure LoadFromCsv(DataSet:TDataSet);
253+ var
254+ vFieldCount:Integer;
255+ I:Integer;
256+ begin
257+ try
258+ //Assign SdfDataSetTemporary
259+ with SdfDataSetTemporary do begin
260+ Active:=False;
261+ ClearFields;
262+ FileName:=DataSet.Name+'.txt';
263+ FirstLineAsSchema:=True;
264+ Active:=True;
265+ //Determine number of fields
266+ vFieldCount:=FieldDefs.Count;
267+ end;
268+ //Iterate through SdfDataSetTemporary and insert records into MemDataSet
269+ SdfDataSetTemporary.First;
270+ while not SdfDataSetTemporary.EOF do begin
271+ DataSet.Append;
272+ //Iterate through FieldDefs
273+ for I:=0 to vFieldCount-1 do begin
274+ try
275+ DataSet.Fields[I].Value:=SdfDataSetTemporary.Fields[I].Value;
276+ except
277+ on E:Exception do begin
278+ MemoMessages.Append(TimeToStr(Now())+' Error while setting value for field: '
279+ +DataSet.Name+'.'+DataSet.Fields[I].Name +'. '+E.Message);
280+ end;
281+ end;
282+ end;
283+ try
284+ DataSet.Post;
285+ except
286+ on E:Exception do begin
287+ MemoMessages.Append(TimeToStr(Now())+' Error while posting record to table: '
288+ +DataSet.Name+'.'+E.Message);
289+ end;
290+ end;
291+ SdfDataSetTemporary.Next;
292+ end;
293+ finally
294+ SdfDataSetTemporary.Active:=False;
295+ SdfDataSetTemporary.ClearFields;
296+ end;
297+ end;
298+```
299+```
300+procedure SaveToCsv(DataSet:TDataSet);
301+ var
302+ myFileName:string;
303+ myTextFile: TextFile;
304+ i: integer;
305+ s: string;
306+ begin
307+ myFileName:=DataSet.Name+'.txt';
308+ //create a new file
309+ AssignFile(myTextFile, myFileName);
310+ Rewrite(myTextFile);
311+ s := ''; //initialize empty string
312+ try
313+ //write field names (as column headers)
314+ for i := 0 to DataSet.Fields.Count - 1 do
315+ begin
316+ s := s + Format('%s,', [DataSet.Fields[i].FieldName]);
317+ end;
318+ Writeln(myTextFile, s);
319+ DataSet.First;
320+ //write field values
321+ while not DataSet.Eof do
322+ begin
323+ s := '';
324+ for i := 0 to DataSet.FieldCount - 1 do
325+ begin
326+ //Numerical fields without quotes, string fields with quotes
327+ if ((DataSet.FieldDefs[i].DataType=ftInteger)
328+ or (DataSet.FieldDefs[i].DataType=ftFloat)) then
329+ s := s + Format('%s,', [DataSet.Fields[i].AsString])
330+ else
331+ s := s + Format('"%s",', [DataSet.Fields[i].AsString]);
332+ end;
333+ Writeln(myTextfile, s);
334+ DataSet.Next;
335+ end;
336+ finally
337+ CloseFile(myTextFile);
338+ end;
339+ end;
340+```
341+
342+## Autoincrement Primary Keys
343+
344+Autoincrement field type is not supported by MemDataset. Nevertheless, you can imitate it by using Integer field type and providing a calculator for autoincrement fields. We need global variables or public properties for storing current autoincrement field value. I prefer global variables, declared in Interface part.
345+```
346+var
347+ //Global variables used for calculation of autoincrement primary key fields of MemDatasets
348+ vCurrentId:Integer=0;
349+ vProductsId:Integer=0;
350+ vBomsId:Integer=0;
351+ vBomCalculationProductsId:Integer=0;
352+ vBomCalculationComponentsId:Integer=0;
353+ vBomCalculationFooterId:Integer=0;
354+ vBomCalculationProductsMultipleId:Integer=0;
355+ vBomCalculationComponentsMultipleId:Integer=0;
356+ vBomCalculationFooterMultipleId:Integer=0;
357+ vStocksId:Integer=0;
358+ vOrdersId:Integer=0;
359+ vImportVariantsId:Integer=0;
360+ vImportToTablesId:Integer=0;
361+ vImportToFieldsId:Integer=0;
362+ vImportFromTablesId:Integer=0;
363+ vImportFromFieldsId:Integer=0;
364+```
365+
366+Then we have a procedure for autoincrement field values calculation:
367+```
368+procedure GetAutoincrementPrimaryFields;
369+ var
370+ I:Integer;
371+ vId:^Integer;
372+ begin
373+ try
374+ MemoMessages.Lines.Append(TimeToStr(Now())+' Getting information about autoincrement fields');
375+ vSuppressEvents:=True;
376+ //Disable controls and refresh all datasets
377+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
378+ vSaveTables[I].DisableControls;
379+ vSaveTables[I].Refresh; //Important if dataset was filtered
380+ end;
381+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
382+ with vSaveTables[I] do begin
383+ //Use appropriate global variable
384+ case StringToCaseSelect(Name,
385+ ['Products','Boms','Stocks','Orders',
386+ 'BomCalculationProducts','BomCalculationComponents','BomCalculationFooter',
387+ 'BomCalculationProductsMultiple','BomCalculationComponentsMultiple','BomCalculationFooterMultiple',
388+ 'ImportVariants','ImportToTables','ImportToFields','ImportFromTables','ImportFromFields']) of
389+ 0:vId:=@vProductsId;
390+ 1:vId:=@vBomsId;
391+ 2:vId:=@vStocksId;
392+ 3:vId:=@vOrdersId;
393+ 4:vId:=@vBomCalculationProductsId;
394+ 5:vId:=@vBomCalculationComponentsId;
395+ 6:vId:=@vBomCalculationFooterId;
396+ 7:vId:=@vBomCalculationProductsMultipleId;
397+ 8:vId:=@vBomCalculationComponentsMultipleId;
398+ 9:vId:=@vBomCalculationFooterMultipleId;
399+ 10:vId:=@vImportVariantsId;
400+ 11:vId:=@vImportToTablesId;
401+ 12:vId:=@vImportToFieldsId;
402+ 13:vId:=@vImportFromTablesId;
403+ 14:vId:=@vImportFromFieldsId;
404+ end;
405+ try
406+ //Find last value of Id and save it to global variable
407+ Last;
408+ vCurrentId:=FieldByName(Name+'Id').AsInteger;
409+ if (vCurrentId>vId^) then vId^:=vCurrentId;
410+ finally
411+ //Remove reference;
412+ vId:=nil;
413+ end;
414+ end;
415+ end;
416+ finally
417+ vSuppressEvents:=False;
418+ //Refresh all datasets and enable controls
419+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
420+ vSaveTables[I].Refresh;
421+ vSaveTables[I].EnableControls;
422+ end;
423+ MemoMessages.Lines.Append(TimeToStr(Now())+' Autoincrement fields - done.');
424+ end;
425+ end;
426+```
427+```
428+function StringToCaseSelect(Selector:string;CaseList:array of string):Integer;
429+ var
430+ cnt: integer;
431+ begin
432+ Result:=-1;
433+ for cnt:=0 to Length(CaseList)-1 do
434+ begin
435+ if CompareText(Selector, CaseList[cnt]) = 0 then
436+ begin
437+ Result:=cnt;
438+ Break;
439+ end;
440+ end;
441+ end;
442+```
443+
444+The GetAutoincrementPrimaryFields procedure is called every time after you restore (load) data from persistent files, in order to load last autoincrement values into global variables (or properties, as you prefer). Autoincrementing is done in OnNewRecord event of every MemDataset. For example, for MemDataset Orders:
445+```
446+procedure TMainForm.OrdersNewRecord(DataSet: TDataSet);
447+ begin
448+ if vSuppressEvents=True then Exit;
449+ //Set new autoincrement value
450+ vOrdersId:=vOrdersId+1;
451+ DataSet.FieldByName('OrdersId').AsInteger:=vOrdersId;
452+ end;
453+```
454+
455+As already explained, I use vSuppressEvents global variable as flag for the case of restoring data from persistent files.
456+
457+## Enforcing Referential Integrity
458+
459+There is no enforced referential integrity implemented in MemDataset component, so you have to do it on your own.
460+
461+Let's assume we have two tables: MasterTable and DetailTable.
462+
463+There are various places where referential integrity code needs to be used:
464+
465+ * Insert/Update code is located in the `BeforePost` event of the DetailTable: before a new/updated detail record is posted/saved, it needs to be checked for meeting referential integrity requirements
466+ * Delete code is located in the `BeforeDelete` event of the MasterTable: before a master record is deleted, it needs to make sure any child records meet referential integrity requirements
467+
468+```
469+procedure TMainForm.MasterTableBeforeDelete(DataSet: TDataSet);
470+ begin
471+ if vSuppressEvents=True then Exit;
472+ try
473+ DetailTable.DisableControls;
474+ // Enforce referential delete ("cascade delete") for table "MasterTable"
475+ while not DetailTable.EOF do begin
476+ DetailTable.Delete;
477+ end;
478+ DetailTable.Refresh;
479+ finally
480+ DetailTable.EnableControls;
481+ end;
482+ end;
483+```
484+```
485+procedure TMainForm.DetailTableBeforePost(DataSet: TDataSet);
486+ begin
487+ if vSuppressEvents=True then Exit;
488+ // Enforce referential insert/update for table "DetailTable" with
489+ // foreign key "MasterTableID" linking to
490+ // the MasterTable ID primary key field
491+ DataSet.FieldByName('MasterTableId').AsInteger:=
492+ MasterTable.FieldByName('ID').AsInteger;
493+ end;
494+```
495+
496+After you provided referential Insert/Update/Delete, all you must do is provide code for master/detail filtering of data. You do it in the `AfterScroll` event of the MasterTable and in the `OnFilter` event of the DetailTable.
497+
498+Don't forget to set the `Filtered` property of DetailTable to True.
499+```
500+procedure TMainForm.MasterTableAfterScroll(DataSet: TDataSet);
501+ begin
502+ if vSuppressEvents=True then Exit;
503+ DetailTable.Refresh;
504+ end;
505+```
506+```
507+procedure TMainForm.DetailTableFilterRecord(DataSet: TDataSet;
508+ var Accept: Boolean);
509+ begin
510+ if vSuppressEvents=True then Exit;
511+ // Show only child fields whose foreign key points to current
512+ // master table record
513+ Accept:=DataSet.FieldByName('MasterTableId').AsInteger=
514+ MasterTable.FieldByName('ID').AsInteger;
515+ end;
516+```
517+
518+## Known problems
519+
520+There are several limitations when using MemDatasets.
521+
522+ * Locate method does not work
523+ * Filtering by using Filter and Filtered property does not work. You must use hardcoding in the OnFilter event.
524+ * Looping deletion of records seems to be incredibly slow. Therefore I use my EmptyMemDataset procedure instead of while not EOF do Delete;
525+ * In FPC 2.6.x and earlier, CopyFromDataSet method copies data only from the current cursor position to the end of the source dataset. So, you have to write MemDataset1.First; before MemDataSet2.CopyFromDataSet(MemDataset1);. Fixed in FPC trunk revision 26233.
526+ * Note that older versions of FPC has no CopyFromDataset in Bufdataset, at the time an advantage for MemDs.
527+ * See bug report <http://bugs.freepascal.org/view.php?id=25426>.
528+
529+## TBufDataSet
530+
531+As previously mentioned, MemDataSet lacks custom filters, autoincrement data type and the Locate method, so it is better to use TBufDataSet instead. TBufDataset is provided by the BufDataset unit.
532+
533+Since there is no component for design-time editing of TBufDataSet (but you can set up field definitions at design time), you could create a custom wrapper component or use it through code, in the same way as ClientDataSet in Delphi. Look at the Delphi documentation relating to client datasets for details.
534+
535+You can use the same methods for enforcing referential integrity and primary autoincrement fields as explained for MemDataSet.
536+
537+There are only small differences between MemDataSet and BufDataset:
538+
539+MemDataSet | BufDataset
540+---|---
541+DataSet.ClearFields | DataSet.Fields.Clear
542+DataSet.CreateTable | DataSet.CreateDataSet
543+
544+## Sorting DBGrid on TitleClick event for TBufDataSet
545+
546+If you wish to enable consecutive ascending and descending sorting of a DBGrid showing some data from TBufDataSet, you could use the following method:
547+```
548+Uses
549+ BufDataset, typinfo;
550+
551+ function SortBufDataSet(DataSet: TBufDataSet;const FieldName: String): Boolean;
552+ var
553+ i: Integer;
554+ IndexDefs: TIndexDefs;
555+ IndexName: String;
556+ IndexOptions: TIndexOptions;
557+ Field: TField;
558+ begin
559+ Result := False;
560+ Field := DataSet.Fields.FindField(FieldName);
561+ //If invalid field name, exit.
562+ if Field = nil then Exit;
563+ //if invalid field type, exit.
564+ if {(Field is TObjectField) or} (Field is TBlobField) or
565+ {(Field is TAggregateField) or} (Field is TVariantField)
566+ or (Field is TBinaryField) then Exit;
567+ //Get IndexDefs and IndexName using RTTI
568+ if IsPublishedProp(DataSet, 'IndexDefs') then
569+ IndexDefs := GetObjectProp(DataSet, 'IndexDefs') as TIndexDefs
570+ else
571+ Exit;
572+ if IsPublishedProp(DataSet, 'IndexName') then
573+ IndexName := GetStrProp(DataSet, 'IndexName')
574+ else
575+ Exit;
576+ //Ensure IndexDefs is up-to-date
577+ IndexDefs.Updated:=false; {<<<<---This line is critical as IndexDefs.Update will do nothing on the next sort if it's already true}
578+ IndexDefs.Update;
579+ //If an ascending index is already in use,
580+ //switch to a descending index
581+ if IndexName = FieldName + '__IdxA'
582+ then
583+ begin
584+ IndexName := FieldName + '__IdxD';
585+ IndexOptions := [ixDescending];
586+ end
587+ else
588+ begin
589+ IndexName := FieldName + '__IdxA';
590+ IndexOptions := [];
591+ end;
592+ //Look for existing index
593+ for i := 0 to Pred(IndexDefs.Count) do
594+ begin
595+ if IndexDefs[i].Name = IndexName then
596+ begin
597+ Result := True;
598+ Break
599+ end; //if
600+ end; // for
601+ //If existing index not found, create one
602+ if not Result then
603+ begin
604+ if IndexName=FieldName + '__IdxD' then
605+ DataSet.AddIndex(IndexName, FieldName, IndexOptions, FieldName)
606+ else
607+ DataSet.AddIndex(IndexName, FieldName, IndexOptions);
608+ Result := True;
609+ end; // if not
610+ //Set the index
611+ SetStrProp(DataSet, 'IndexName', IndexName);
612+ end;
613+```
614+
615+So, you can call this function from a DBGrid in this way:
616+```
617+procedure TFormMain.DBGridProductsTitleClick(Column: TColumn);
618+ begin
619+ SortBufDataSet(Products, Column.FieldName);
620+ end;
621+```
622+
623+
624+
625+## Sorting multiple columns in grid
626+
627+I have written TDBGridHelper for sorting grid by multiple columns while holding shift key. Note MaxIndexesCount must be set quite large for TBufDataSet because there can be quite large combinations of possible sorting options. But I think people would not use more than 10 so setting it 100 should be teoretically Ok.
628+```
629+{ TDBGridHelper }
630+
631+ TDBGridHelper = class helper for TDBGrid
632+ public const
633+ cMaxColCOunt = 3;
634+ private
635+ procedure Interbal_MakeNames(Fields: TStrings; out FieldsList, DescFields: String);
636+ procedure Internal_SetColumnsIcons(Fields: TStrings; AscIdx, DescIdx: Integer);
637+ function Internal_IndexNameExists(IndexDefs: TIndexDefs; IndexName: String): Boolean;
638+ public
639+ procedure Sort(const FieldName: String; AscIdx: Integer = -1; DescIdx: Integer = -1);
640+ procedure ClearSort;
641+ end;
642+
643+ { TDBGridHelper }
644+
645+ procedure TDBGridHelper.Interbal_MakeNames(Fields: TStrings; out FieldsList, DescFields: String);
646+ var
647+ FldList: TStringList;
648+ DscList: TStringList;
649+ FldDesc, FldName: String;
650+ i: Integer;
651+ begin
652+ if Fields.Count = 0 then
653+ begin
654+ FieldsList := '';
655+ DescFields := '';
656+ Exit;
657+ end;
658+
659+ FldList := TStringList.Create;
660+ DscList := TStringList.Create;
661+ try
662+ FldList.Delimiter := ';';
663+ DscList.Delimiter := ';';
664+
665+ for i := 0 to Fields.Count - 1 do
666+ begin
667+ Fields.GetNameValue(i, FldName, FldDesc);
668+ FldList.Add(FldName);
669+
670+ if FldDesc = 'D' then
671+ DscList.Add(FldName);
672+ end;
673+
674+ FieldsList := FldList.DelimitedText;
675+ DescFields := DscList.DelimitedText;
676+ finally
677+ FldList.Free;
678+ DscList.Free;
679+ end;
680+ end;
681+
682+ procedure TDBGridHelper.Internal_SetColumnsIcons(Fields: TStrings; AscIdx, DescIdx: Integer);
683+ var
684+ i: Integer;
685+ FldDesc: String;
686+ begin
687+ for i := 0 to Self.Columns.Count - 1 do
688+ begin
689+ FldDesc := Fields.Values[Self.Columns[i].Field.FieldName];
690+
691+ if FldDesc = 'A' then
692+ Self.Columns[i].Title.ImageIndex := AscIdx
693+ else
694+ if FldDesc = 'D' then
695+ Self.Columns[i].Title.ImageIndex := DescIdx
696+ else
697+ Self.Columns[i].Title.ImageIndex := -1
698+ end;
699+ end;
700+
701+ function TDBGridHelper.Internal_IndexNameExists(IndexDefs: TIndexDefs; IndexName: String): Boolean;
702+ var
703+ i: Integer;
704+ begin
705+ for i := 0 to IndexDefs.Count - 1 do
706+ begin
707+ if IndexDefs[i].Name = IndexName then
708+ Exit(True)
709+ end;
710+
711+ Result := False
712+ end;
713+
714+ procedure TDBGridHelper.Sort(const FieldName: String; AscIdx: Integer;
715+ DescIdx: Integer);
716+ var
717+ Field: TField;
718+ DataSet: TBufDataset;
719+ IndexDefs: TIndexDefs;
720+ IndexName, Dir, DescFields, FieldsList: String;
721+ Fields: TStringList;
722+ begin
723+ if not Assigned(DataSource.DataSet) or
724+ not DataSource.DataSet.Active or
725+ not (DataSource.DataSet is TBufDataset) then
726+ Exit;
727+ DataSet := DataSource.DataSet as TBufDataset;
728+
729+ Field := DataSet.FieldByName(FieldName);
730+ if (Field is TBlobField) or (Field is TVariantField) or (Field is TBinaryField) then
731+ Exit;
732+
733+ IndexDefs := DataSet.IndexDefs;
734+ IndexName := DataSet.IndexName;
735+
736+ if not IndexDefs.Updated then
737+ IndexDefs.Update;
738+
739+ Fields := TStringList.Create;
740+ try
741+ Fields.DelimitedText := IndexName;
742+ Dir := Fields.Values[FieldName];
743+
744+ if Dir = 'A' then
745+ Dir := 'D'
746+ else
747+ if Dir = 'D' then
748+ Dir := 'A'
749+ else
750+ Dir := 'A';
751+
752+ //If shift is presed then add field to field list
753+ if ssShift in GetKeyShiftState then
754+ begin
755+ Fields.Values[FieldName] := Dir;
756+ //We do not add to sor any more field if total field count exids cMaxColCOunt
757+ if Fields.Count > cMaxColCOunt then
758+ Exit;
759+ end
760+ else
761+ begin
762+ Fields.Clear;
763+ Fields.Values[FieldName] := Dir;
764+ end;
765+
766+ IndexName := Fields.DelimitedText;
767+ if not Internal_IndexNameExists(IndexDefs, IndexName) then
768+ begin
769+ Interbal_MakeNames(Fields, FieldsList, DescFields);
770+ TBufDataset(DataSet).AddIndex(IndexName, FieldsList, [], DescFields, '');
771+ end;
772+
773+ DataSet.IndexName := IndexName;
774+ Internal_SetColumnsIcons(Fields, AscIdx, DescIdx)
775+ finally
776+ Fields.Free;
777+ end;
778+ end;
779+
780+ procedure TDBGridHelper.ClearSort;
781+ var
782+ DataSet: TBufDataset;
783+ Fields: TStringList;
784+ begin
785+ if not Assigned(DataSource.DataSet) or
786+ not DataSource.DataSet.Active or
787+ not (DataSource.DataSet is TBufDataset) then
788+ Exit;
789+ DataSet := DataSource.DataSet as TBufDataset;
790+
791+ DataSet.IndexName := '';
792+
793+ Fields := TStringList.Create;
794+ try
795+ Internal_SetColumnsIcons(Fields, -1, -1)
796+ finally
797+ Fields.Free
798+ end
799+ end;
800+```
801+
802+To use sorting you need to call helper methods in OnCellClick and onTitleClick. OnTitleClick - If you hold shift ads new column to sot list ore changes direction to selected column or just sorts one column OnCellClick - If you double click on cell[0, 0] grid clears its sorting
803+```
804+procedure TForm1.grdCountriesCellClick(Column: TColumn);
805+ begin
806+ if not Assigned(Column) then
807+ grdCountries.ClearSort
808+ end;
809+
810+ procedure TForm1.grdCountriesTitleClick(Column: TColumn);
811+ begin
812+ grdCountries.Sort(Column.Field.FieldName, 0, 1);
813+ end;
814+```
815+
816+If you have assigned TitleImageList then you can specify which image use for ascending and which for descending operations.
817+
818+## ZMSQL
819+
820+Another, often better way to write in-memory databases is to use the [[ZMSQL|ZMSQL package]]:
821+
822+ * <http://sourceforge.net/projects/lazarus-ccr/files/zmsql/>
823+ * <http://www.lazarus.freepascal.org/index.php/topic,13821.30.html>
824+ * <http://lazarus.freepascal.org/index.php/topic,13821>
825+
826+## Contributors
827+
828+Original text written by: Zlatko Matić (matalab@gmail.com)
829+
830+Other contributions by contributors as shown in the page History.
831+
832+---
833+*From the Free Pascal wiki, page "How to write in-memory database applications in Lazarus/FPC/ja", as the Internet Archive kept it on 2025-01-17. 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