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

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

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