Sign in Join
Wiki copytemporary

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

OldNewLine
1+## Introduction
2+
3+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.
4+
5+Some benefits are:
6+
7+- 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.
8+- No need for external libraries (no .so or .dll files), no need for server installation
9+- Code is multiplatform and can be compiled on any OS instantly
10+- 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.
11+
12+> **Note:** later on in this article, BufDataset is introduced. [[TBufDataset]] often is a better choice than [[TMemDataset]]
13+
14+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.
15+
16+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.
17+
18+The memds unit provides TMemDataset, so you will need to add that to your uses clause.
19+
20+## Saving MemDatasets to persistent files
21+
22+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.
23+
24+I also use a global variable vSuppressEvents of type boolean, for suppressing Dataset events used for referential integrity enforcement, during data restore.
25+
26+You get this:
27+
28+``` pascal
29+type
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;
36+```
37+
38+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.
39+
40+``` pascal
41+const
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
44+```
45+
46+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.
47+
48+``` pascal
49+procedure TMainForm.FormCreate(Sender: TObject);
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;
71+```
72+
73+``` pascal
74+procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
75+begin
76+ //Save memdatasets to files (to save current session)
77+ SaveSession;
78+end;
79+```
80+
81+``` pascal
82+procedure RestoreSession;
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);
98+ try
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.');
109+ 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]);
122+ end;
123+ except
124+ on E:Exception do begin
125+ MemoMessages.Append(TimeToStr(Now())+' Error while restoring table: '+vSaveTables[I].Name +'. '+E.Message);
126+ end;
127+ end;
128+ finally
129+ vSaveTables[I].Active:=True;//Needed because of LoadFromFile method....
130+ end;
131+ MemoMessages.Append(TimeToStr(Now())+' Table: '+vSaveTables[I].Name+' restored.');
132+ 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;
143+```
144+
145+``` pascal
146+procedure SaveSession;
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);
162+ try
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]);
167+ end;
168+ except
169+ on E:Exception do begin
170+ MemoMessages.Append(TimeToStr(Now())+' Error while saving table: '+vSaveTables[I].Name +'. '+E.Message);
171+ end;
172+ end;
173+ MemoMessages.Append(TimeToStr(Now())+' Table: '+vSaveTables[I].Name+' saved.');
174+ 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;
185+```
186+
187+``` pascal
188+procedure EmptyMemDataSet(DataSet:TMemDataSet);
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;
205+ end;
206+ 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;
217+```
218+
219+``` pascal
220+procedure LoadFromCsv(DataSet:TDataSet);
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);
248+ end;
249+ end;
250+ 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;
260+ end;
261+ finally
262+ SdfDataSetTemporary.Active:=False;
263+ SdfDataSetTemporary.ClearFields;
264+ end;
265+end;
266+```
267+
268+``` pascal
269+procedure SaveToCsv(DataSet:TDataSet);
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
294+ begin
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]);
301+ end;
302+ Writeln(myTextfile, s);
303+ DataSet.Next;
304+ end;
305+ finally
306+ CloseFile(myTextFile);
307+ end;
308+end;
309+```
310+
311+## Autoincrement Primary Keys
312+
313+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.
314+
315+``` pascal
316+var
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;
334+```
335+
336+Then we have a procedure for autoincrement field values calculation:
337+
338+``` pascal
339+procedure GetAutoincrementPrimaryFields;
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;
375+ end;
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;
384+ end;
385+ end;
386+ 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;
397+```
398+
399+``` pascal
400+function StringToCaseSelect(Selector:string;CaseList:array of string):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
408+ begin
409+ Result:=cnt;
410+ Break;
411+ end;
412+ end;
413+end;
414+```
415+
416+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:
417+
418+``` pascal
419+procedure TMainForm.OrdersNewRecord(DataSet: TDataSet);
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;
426+```
427+
428+As already explained, I use vSuppressEvents global variable as flag for the case of restoring data from persistent files.
429+
430+## Enforcing Referential Integrity
431+
432+There is no enforced referential integrity implemented in MemDataset component, so you have to do it on your own.
433+
434+Let's assume we have two tables: MasterTable and DetailTable.
435+
436+There are various places where referential integrity code needs to be used:
437+
438+- 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
439+- 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
440+
441+``` pascal
442+procedure TMainForm.MasterTableBeforeDelete(DataSet: TDataSet);
443+begin
444+ if vSuppressEvents=True then Exit;
445+ try
446+ DetailTable.DisableControls;
447+ // Enforce referential delete ("cascade delete") for table "MasterTable"
448+ while not DetailTable.EOF do begin
449+ DetailTable.Delete;
450+ end;
451+ DetailTable.Refresh;
452+ finally
453+ DetailTable.EnableControls;
454+ end;
455+end;
456+```
457+
458+``` pascal
459+procedure TMainForm.DetailTableBeforePost(DataSet: TDataSet);
460+begin
461+ if vSuppressEvents=True then Exit;
462+ // Enforce referential insert/update for table "DetailTable" with
463+ // foreign key "MasterTableID" linking to
464+ // the MasterTable ID primary key field
465+ DataSet.FieldByName('MasterTableId').AsInteger:=
466+ MasterTable.FieldByName('ID').AsInteger;
467+end;
468+```
469+
470+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.
471+
472+Don't forget to set the `Filtered` property of DetailTable to True.
473+
474+``` pascal
475+procedure TMainForm.MasterTableAfterScroll(DataSet: TDataSet);
476+begin
477+ if vSuppressEvents=True then Exit;
478+ DetailTable.Refresh;
479+end;
480+```
481+
482+``` pascal
483+procedure TMainForm.DetailTableFilterRecord(DataSet: TDataSet;
484+ var Accept: Boolean);
485+begin
486+ if vSuppressEvents=True then Exit;
487+ // Show only child fields whose foreign key points to current
488+ // master table record
489+ Accept:=DataSet.FieldByName('MasterTableId').AsInteger=
490+ MasterTable.FieldByName('ID').AsInteger;
491+end;
492+```
493+
494+## Known problems
495+
496+There are several limitations when using MemDatasets.
497+
498+- Locate method does not work
499+- Filtering by using Filter and Filtered property does not work. You must use hardcoding in the OnFilter event.
500+- Looping deletion of records seems to be incredibly slow. Therefore I use my EmptyMemDataset procedure instead of while not EOF do Delete;
501+- 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.
502+ - Note that older versions of FPC has no CopyFromDataset in Bufdataset, at the time an advantage for MemDs.
503+ - See bug report <http://bugs.freepascal.org/view.php?id=25426>.
504+
505+## TBufDataSet
506+
507+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.
508+
509+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.
510+
511+You can use the same methods for enforcing referential integrity and primary autoincrement fields as explained for MemDataSet.
512+
513+There are only small differences between MemDataSet and BufDataset:
514+
515+| MemDataSet | BufDataset |
516+|---------------------|-----------------------|
517+| DataSet.ClearFields | DataSet.Fields.Clear |
518+| DataSet.CreateTable | DataSet.CreateDataSet |
519+
520+## Sorting DBGrid on TitleClick event for TBufDataSet
521+
522+If you wish to enable consecutive ascending and descending sorting of a DBGrid showing some data from TBufDataSet, you could use the following method:
523+
524+``` pascal
525+Uses
526+ BufDataset, typinfo;
527+
528+function SortBufDataSet(DataSet: TBufDataSet;const FieldName: String): Boolean;
529+var
530+ i: Integer;
531+ IndexDefs: TIndexDefs;
532+ IndexName: String;
533+ IndexOptions: TIndexOptions;
534+ Field: TField;
535+begin
536+ Result := False;
537+ Field := DataSet.Fields.FindField(FieldName);
538+ //If invalid field name, exit.
539+ if Field = nil then Exit;
540+ //if invalid field type, exit.
541+ if {(Field is TObjectField) or} (Field is TBlobField) or
542+ {(Field is TAggregateField) or} (Field is TVariantField)
543+ or (Field is TBinaryField) then Exit;
544+ //Get IndexDefs and IndexName using RTTI
545+ if IsPublishedProp(DataSet, 'IndexDefs') then
546+ IndexDefs := GetObjectProp(DataSet, 'IndexDefs') as TIndexDefs
547+ else
548+ Exit;
549+ if IsPublishedProp(DataSet, 'IndexName') then
550+ IndexName := GetStrProp(DataSet, 'IndexName')
551+ else
552+ Exit;
553+ //Ensure IndexDefs is up-to-date
554+ IndexDefs.Updated:=false; {<<<<---This line is critical as IndexDefs.Update will do nothing on the next sort if it's already true}
555+ IndexDefs.Update;
556+ //If an ascending index is already in use,
557+ //switch to a descending index
558+ if IndexName = FieldName + '__IdxA'
559+ then
560+ begin
561+ IndexName := FieldName + '__IdxD';
562+ IndexOptions := [ixDescending];
563+ end
564+ else
565+ begin
566+ IndexName := FieldName + '__IdxA';
567+ IndexOptions := [];
568+ end;
569+ //Look for existing index
570+ for i := 0 to Pred(IndexDefs.Count) do
571+ begin
572+ if IndexDefs[i].Name = IndexName then
573+ begin
574+ Result := True;
575+ Break
576+ end; //if
577+ end; // for
578+ //If existing index not found, create one
579+ if not Result then
580+ begin
581+ if IndexName=FieldName + '__IdxD' then
582+ DataSet.AddIndex(IndexName, FieldName, IndexOptions, FieldName)
583+ else
584+ DataSet.AddIndex(IndexName, FieldName, IndexOptions);
585+ Result := True;
586+ end; // if not
587+ //Set the index
588+ SetStrProp(DataSet, 'IndexName', IndexName);
589+end;
590+```
591+
592+So, you can call this function from a DBGrid in this way:
593+
594+``` pascal
595+procedure TFormMain.DBGridProductsTitleClick(Column: TColumn);
596+begin
597+ SortBufDataSet(Products, Column.FieldName);
598+end;
599+```
600+
601+## Sorting multiple columns in grid
602+
603+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.
604+
605+``` pascal
606+ { TDBGridHelper }
607+
608+ TDBGridHelper = class helper for TDBGrid
609+ public const
610+ cMaxColCOunt = 3;
611+ private
612+ procedure Interbal_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+
620+{ TDBGridHelper }
621+
622+procedure TDBGridHelper.Interbal_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
643+ begin
644+ Fields.GetNameValue(i, FldName, FldDesc);
645+ FldList.Add(FldName);
646+
647+ if FldDesc = 'D' then
648+ DscList.Add(FldName);
649+ end;
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
731+ begin
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
735+ Exit;
736+ end
737+ else
738+ begin
739+ Fields.Clear;
740+ Fields.Values[FieldName] := Dir;
741+ end;
742+
743+ IndexName := Fields.DelimitedText;
744+ if not Internal_IndexNameExists(IndexDefs, IndexName) then
745+ begin
746+ Interbal_MakeNames(Fields, FieldsList, DescFields);
747+ TBufDataset(DataSet).AddIndex(IndexName, FieldsList, [], DescFields, '');
748+ end;
749+
750+ DataSet.IndexName := IndexName;
751+ Internal_SetColumnsIcons(Fields, AscIdx, DescIdx)
752+ finally
753+ Fields.Free;
754+ end;
755+end;
756+
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;
767+
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;
777+```
778+
779+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
780+
781+``` pascal
782+procedure TForm1.grdCountriesCellClick(Column: TColumn);
783+begin
784+ if not Assigned(Column) then
785+ grdCountries.ClearSort
786+end;
787+
788+procedure TForm1.grdCountriesTitleClick(Column: TColumn);
789+begin
790+ grdCountries.Sort(Column.Field.FieldName, 0, 1);
791+end;
792+```
793+
794+If you have assigned TitleImageList then you can specify which image use for ascending and which for descending operations.
795+
796+## ZMSQL
797+
798+Another, often better way to write in-memory databases is to use the [[ZMSQL|ZMSQL package]]:
799+
800+- [<http://sourceforge.net/projects/lazarus-ccr/files/zmsql/>](http://sourceforge.net/projects/lazarus-ccr/files/zmsql/)
801+- [<http://www.lazarus.freepascal.org/index.php/topic,13821.30.html>](http://www.lazarus.freepascal.org/index.php/topic,13821.30.html)
802+- [<http://lazarus.freepascal.org/index.php/topic,13821>](http://lazarus.freepascal.org/index.php/topic,13821)
803+
804+## Contributors
805+
806+Original text written by: Zlatko Matić (matalab@gmail.com)
807+
808+Other contributions by contributors as shown in the page History.
809+
810+---
811+*From the Free Pascal wiki, page "How to write in-memory database applications in Lazarus/FPC", as it stood on 2023-09-13 after a change by Ernesto, 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