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

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

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