Sign in Join
Wiki copytemporary

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

OldNewLine
1+---
2+[[Portal:Databases|**Databases portal**]]
3+References:
4+
5+ * [[Databases|General info]]
6+ * [[Database libraries|Libraries]]
7+ * [[Database field type|Field types]]
8+ * [[Data Controls tab|Controls]]
9+ * [[Lazarus DB Faq|FAQ]]
10+ * [[SqlDBHowto|SQL how-to]]
11+ * [[Working With TSQLQuery]]
12+ * [[How to write in-memory database applications in Lazarus/FPC|In-memory database applications]]
13+
14+Tutorials/practical articles:
15+
16+ * [[Lazarus Database Overview|Overview]]
17+ * [[SQLdb Tutorial0|0 - Database set-up]]
18+ * [[SQLdb Tutorial1|1 - Getting started]]
19+ * [[SQLdb Tutorial2|2 - Editing]]
20+ * [[SQLdb Tutorial3|3 - Queries]]
21+ * [[SQLdb Tutorial4|4 - Data modules]]
22+ * [[SQLdb Programming Reference]]
23+
24+Databases
25+
26+ [[Advantage Database Server|Advantage]] \- [[MySQLDatabases|MySQL]] \- [[mssqlconn|MSSQL]] \- [[postgres|Postgres]] \- [[Firebird|Interbase]] \- [[Firebird]] \- [[Oracle]] \- [[ODBCConn|ODBC]] \- [[TParadox|Paradox]] \- [[SQLite]] \- [[Lazarus Tdbf Tutorial|dBASE]] \- [[MS Access]] \- [[Zeos tutorial|Zeos]]
27+
28+## Contents
29+
30+ * 1 Введение
31+ * 2 Сохранение MemDataset в постоянные файлы
32+ * 3 Автогенератор первичных ключей
33+ * 4 Обеспечение ссылочной целостности
34+ * 5 Известные проблемы
35+ * 6 TBufDataSet
36+ * 7 Сортировка DBGrid по событию OnTitleClick для TBufDataSet
37+ * 8 Сортировка нескольких столбцов в grid
38+ * 9 ZMSQL
39+ * 10 Авторство
40+
41+## Введение
42+
43+Существуют определенные обстоятельства, когда наборы данных в памяти имеют смысл. Если вам нужна быстрая, однопользовательская, не критически важная база данных, отличная от SQL, без транзакций, [[TMemDataset]] может удовлетворить ваши потребности.
44+
45+Некоторые преимущества:
46+
47+ * Быстрое выполнение. Поскольку вся обработка выполняется в памяти, данные не сохраняются на жестком диске до тех пор, пока это не будет задано явно. Память, безусловно, быстрее, чем жесткий диск.
48+ * Нет необходимости во внешних библиотеках (нет файлов .so или .dll), нет необходимости в установке сервера.
49+ * Код является мультиплатформенным и может быть скомпилирован в любой ОС.
50+ * Поскольку все программирование выполняется в Lazarus/FPC, такие приложения проще в обслуживании. Вместо того, чтобы постоянно переключаться с внутреннего программирования на внешнее, используя MemDatasets, вы можете сосредоточиться на своем коде Pascal.
51+
52+![Light bulb](https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png) **Примечание:** позже в этой статье будет представлен BufDataset. [[TBufDataset]] часто является лучшим выбором, чем [[TMemDataset]]
53+
54+Я проиллюстрирую, как программировать реляционные не-SQL базы данных в памяти, сосредоточив внимание на обеспечении целостности отношений и фильтрации, моделировании основных полей с автоинкрементом и т.п.
55+
56+Эта страница поделится с вами тем, что я узнал, экспериментируя с TMemDatasets. Возможно даже, что есть какой-то другой, более эффективный способ сделать это. Если это так, пожалуйста, не стесняйтесь вносить свой вклад в этот документ в интересах сообщества Lazarus/FPC.
57+
58+Модуль memds предоставляет TMemDataset, так что вам нужно будет добавить его в раздел uses вашего проекта.
59+
60+## Сохранение MemDataset в постоянные файлы
61+
62+В [[Interface|интерфейсной]] части вашего кода объявите тип массива для хранения информации обо всех TMemDataSets, которые вы хотите сделать постоянными в конце сеанса и восстановить в начале следующего сеанса. Вы также должны объявить переменную типа TSaveTables.
63+
64+Я также использую глобальную переменную vSuppressEvents типа boolean для подавления событий Dataset, используемых для обеспечения ссылочной целостности, во время восстановления данных.
65+
66+Вот, что у вас должно получиться:
67+```
68+type
69+ TSaveTables=array[1..15] of TMemDataset;
70+ var
71+ //Глобальная переменная, которая хранит таблицы для сохранения/восстановления сеанса работы
72+ vSaveTables:TSaveTables;
73+ //Переменная-флаг подавления событий датасета. Используется при загрузке данных из файлов.
74+ vSuppressEvents:Boolean;
75+```
76+
77+Вместо того, чтобы использовать глобальные переменные, как это сделал, например, я, вы также можете сделать их свойством главной формы. TMemDataset имеет способ хранения данных в постоянном файле: метод SaveToFile. Но вы, возможно, захотите сохранить данные в файлы [[CSV]] для упрощения работы с ними в дальнейшем. Поэтому я объединю оба способа в одни и те же процедуры.
78+
79+Я задаю константу cSaveRestore в интерфейсной части модуля, с помощью которой я могу определить, будут ли данные храниться и загружаться как нативные файлы MemDataset, или как файлы CSV.
80+```
81+const
82+ //Константа cSaveRestore определяет способ сохранения и восстановления MemDataset в постоянные файлы.
83+ cSaveRestore=0; //0=собственный формат MemDataset, 1=сохранение и восстановление из CSV
84+```
85+
86+Теперь вы можете сохранить MemDataset'ы в событии OnFormClose и загрузить их в событие OnFormCreate. Заполнить элементы массива экземплярами MemDataset можно также в событии OnFormCreate.
87+```
88+procedure TMainForm.FormCreate(Sender: TObject);
89+ begin
90+ //Список таблиц, которые будут сохранены/восстановлены для сеанса работы
91+ vSaveTables[1]:=Products;
92+ vSaveTables[2]:=Boms;
93+ vSaveTables[3]:=Stocks;
94+ vSaveTables[4]:=Orders;
95+ vSaveTables[5]:=BomCalculationProducts;
96+ vSaveTables[6]:=BomCalculationComponents;
97+ vSaveTables[7]:=BomCalculationFooter;
98+ vSaveTables[8]:=BomCalculationProductsMultiple;
99+ vSaveTables[9]:=BomCalculationComponentsMultiple;
100+ vSaveTables[10]:=BomCalculationFooterMultiple;
101+ vSaveTables[11]:=ImportVariants;
102+ vSaveTables[12]:=ImportToTables;
103+ vSaveTables[13]:=ImportToFields;
104+ vSaveTables[14]:=ImportFromTables;
105+ vSaveTables[15]:=ImportFromFields;
106+ //Восстанавливаем сеанс работы
107+ RestoreSession;
108+ GetAutoincrementPrimaryFields;
109+ end;
110+```
111+```
112+procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
113+ begin
114+ //Сохраняем наборы данных в файлы (чтобы сохранить текущий сеанс)
115+ SaveSession;
116+ end;
117+```
118+```
119+procedure RestoreSession;
120+ var
121+ I:Integer;
122+ begin
123+ try
124+ MemoMessages.Append(TimeToStr(Now())+' Начало восстановления ранее сохраненного сеанса.');
125+ vSuppressEvents:=True; //Подавляем события, используемые для обеспечения ссылочной целостности
126+ //Отключаем элементы управления и обновляем все наборы данных
127+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
128+ vSaveTables[I].DisableControls;
129+ vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован
130+ end;
131+ //Загружаем memdataset'ы из файлов (для восстановления предыдущего сеанса)
132+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
133+ vSaveTables[I].First;
134+ MemoMessages.Append(TimeToStr(Now())+' Начинаем восстановление таблицы: '+vSaveTables[I].Name);
135+ try
136+ //Если данные загружаются из CSV-файла, то сначала необходимо удалить таблицу.
137+ if cSaveRestore=1 then begin
138+ MemoMessages.Append(TimeToStr(Now())+' Начинаем удаление всех записей в таблице: '+vSaveTables[I].Name);
139+ //Этот способ удаления всех записей невероятно медленный.
140+ {while not vSaveTables[I].EOF do begin
141+ vSaveTables[I].Delete;
142+ end;}
143+ //Этот метод для удаления всех записей намного быстрее
144+ EmptyMemDataSet(vSaveTables[I]);
145+ MemoMessages.Append(TimeToStr(Now())+' Все записи из таблицы: '+vSaveTables[I].Name+' удалены.');
146+ end;
147+ except
148+ on E:Exception do begin
149+ MemoMessages.Append(TimeToStr(Now())+' Ошибка при удалении записей из таблицы: '+vSaveTables[I].Name +'. '+E.Message);
150+ end;
151+ end;
152+ try
153+ try
154+ MemoMessages.Append(TimeToStr(Now())+' Восстановление таблицы: '+vSaveTables[I].Name);
155+ //Проверяем константу для выбора способа сохранения/восстановления данных и загрузки сохраненного сеанса
156+ case cSaveRestore of
157+ 0:vSaveTables[I].LoadFromFile(vSaveTables[I].Name);
158+ 1:LoadFromCsv(vSaveTables[I]);
159+ end;
160+ except
161+ on E:Exception do begin
162+ MemoMessages.Append(TimeToStr(Now())+' Ошибка при восстановлении таблицы: '+vSaveTables[I].Name +'. '+E.Message);
163+ end;
164+ end;
165+ finally
166+ vSaveTables[I].Active:=True;//Требуется из-за метода LoadFromFile....
167+ end;
168+ MemoMessages.Append(TimeToStr(Now())+' Таблица: '+vSaveTables[I].Name+' восстановлена.');
169+ end;
170+ finally
171+ vSuppressEvents:=False;
172+ //Обновляем все наборы данных и включаем элементы управления
173+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
174+ vSaveTables[I].Refresh; //Необходимо для таблиц, которые фильтруются.
175+ vSaveTables[I].EnableControls;
176+ end;
177+ MemoMessages.Append(TimeToStr(Now())+' Все таблицы восстановлены из сохраненных файлов.');
178+ end;
179+ end;
180+```
181+```
182+procedure SaveSession;
183+ var
184+ I:Integer;
185+ begin
186+ try
187+ MemoMessages.Append(TimeToStr(Now())+' Начало сохранения сеанса в постоянные файлы.');
188+ vSuppressEvents:=True;
189+ //Отключаем элементы управления и обновляем все наборы данных
190+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
191+ vSaveTables[I].DisableControls;
192+ vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован
193+ end;
194+ //Сохраняем сеанс работы в файл
195+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
196+ vSaveTables[I].First;
197+ MemoMessages.Append(TimeToStr(Now())+' Сохранение таблицы: '+vSaveTables[I].Name);
198+ try
199+ //Проверяем константу для выбора способа сохранения/восстановления данных и загрузки сохраненного сеанса
200+ case cSaveRestore of
201+ 0:vSaveTables[I].SaveToFile(vSaveTables[I].Name);
202+ 1:SaveToCsv(vSaveTables[I]);
203+ end;
204+ except
205+ on E:Exception do begin
206+ MemoMessages.Append(TimeToStr(Now())+' Ошибка при сохранении таблицы: '+vSaveTables[I].Name +'. '+E.Message);
207+ end;
208+ end;
209+ MemoMessages.Append(TimeToStr(Now())+' Таблица: '+vSaveTables[I].Name+' сохранена.');
210+ end;
211+ finally
212+ vSuppressEvents:=False;
213+ //Обновляем все наборы данных и включаем элементы управления
214+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
215+ vSaveTables[I].Refresh; //Необходимо для таблиц, которые фильтруются
216+ vSaveTables[I].EnableControls;
217+ end;
218+ MemoMessages.Append(TimeToStr(Now())+' Все таблицы сохранены в файлы.');
219+ end;
220+ end;
221+```
222+```
223+procedure EmptyMemDataSet(DataSet:TMemDataSet);
224+ var
225+ vTemporaryMemDataSet:TMemDataSet;
226+ vFieldDef:TFieldDef;
227+ I:Integer;
228+ begin
229+ try
230+ //Создаем временный MemDataSet
231+ vTemporaryMemDataSet:=TMemDataSet.Create(nil);
232+ //Сохраняем FieldDefs во временном MemDataSet
233+ for I:=0 to DataSet.FieldDefs.Count-1 do begin
234+ vFieldDef:=vTemporaryMemDataSet.FieldDefs.AddFieldDef;
235+ with DataSet.FieldDefs[I] do begin
236+ vFieldDef.Name:=Name;
237+ vFieldDef.DataType:=DataType;
238+ vFieldDef.Size:=Size;
239+ vFieldDef.Required:=Required;
240+ end;
241+ end;
242+ //Очищаем существующие fielddefs
243+ DataSet.Clear;
244+ //Восстанавливаем fielddefs
245+ DataSet.FieldDefs:=vTemporaryMemDataSet.FieldDefs;
246+ DataSet.Active:=True;
247+ finally
248+ vTemporaryMemDataSet.Clear;
249+ vTemporaryMemDataSet.Free;
250+ end;
251+ end;
252+```
253+```
254+procedure LoadFromCsv(DataSet:TDataSet);
255+ var
256+ vFieldCount:Integer;
257+ I:Integer;
258+ begin
259+ try
260+ //Назначаем SdfDataSetTemporary
261+ with SdfDataSetTemporary do begin
262+ Active:=False;
263+ ClearFields;
264+ FileName:=DataSet.Name+'.txt';
265+ FirstLineAsSchema:=True;
266+ Active:=True;
267+ //Определяем количество полей
268+ vFieldCount:=FieldDefs.Count;
269+ end;
270+ //Выполняем итерацию по SdfDataSetTeditional и вставляем записи в MemDataSet.
271+ SdfDataSetTemporary.First;
272+ while not SdfDataSetTemporary.EOF do begin
273+ DataSet.Append;
274+ //Итерация по FieldDefs
275+ for I:=0 to vFieldCount-1 do begin
276+ try
277+ DataSet.Fields[I].Value:=SdfDataSetTemporary.Fields[I].Value;
278+ except
279+ on E:Exception do begin
280+ MemoMessages.Append(TimeToStr(Now())+' Ошибка при установке значения для поля: '
281+ +DataSet.Name+'.'+DataSet.Fields[I].Name +'. '+E.Message);
282+ end;
283+ end;
284+ end;
285+ try
286+ DataSet.Post;
287+ except
288+ on E:Exception do begin
289+ MemoMessages.Append(TimeToStr(Now())+' Ошибка при сохранении записи в таблицу: '
290+ +DataSet.Name+'.'+E.Message);
291+ end;
292+ end;
293+ SdfDataSetTemporary.Next;
294+ end;
295+ finally
296+ SdfDataSetTemporary.Active:=False;
297+ SdfDataSetTemporary.ClearFields;
298+ end;
299+ end;
300+```
301+```
302+procedure SaveToCsv(DataSet:TDataSet);
303+ var
304+ myFileName:string;
305+ myTextFile: TextFile;
306+ i: integer;
307+ s: string;
308+ begin
309+ myFileName:=DataSet.Name+'.txt';
310+ //создаем новый файл
311+ AssignFile(myTextFile, myFileName);
312+ Rewrite(myTextFile);
313+ s := ''; //инициализируем пустую строку
314+ try
315+ //записываем имена полей (как заголовки столбцов)
316+ for i := 0 to DataSet.Fields.Count - 1 do
317+ begin
318+ s := s + Format('%s,', [DataSet.Fields[i].FieldName]);
319+ end;
320+ Writeln(myTextFile, s);
321+ DataSet.First;
322+ //записываем значения полей
323+ while not DataSet.Eof do
324+ begin
325+ s := '';
326+ for i := 0 to DataSet.FieldCount - 1 do
327+ begin
328+ //Числовые поля без кавычек, строковые поля с кавычками
329+ if ((DataSet.FieldDefs[i].DataType=ftInteger)
330+ or (DataSet.FieldDefs[i].DataType=ftFloat)) then
331+ s := s + Format('%s,', [DataSet.Fields[i].AsString])
332+ else
333+ s := s + Format('"%s",', [DataSet.Fields[i].AsString]);
334+ end;
335+ Writeln(myTextfile, s);
336+ DataSet.Next;
337+ end;
338+ finally
339+ CloseFile(myTextFile);
340+ end;
341+ end;
342+```
343+
344+## Автогенератор первичных ключей
345+
346+Тип поля Autoincrement не поддерживается MemDataset. Тем не менее, вы можете имитировать его, используя тип поля Integer и предоставляя калькулятор для полей автогенератора. Нам нужны глобальные переменные или открытые свойства для хранения текущего значения поля автогенератора. Я предпочитаю глобальные переменные, объявленные в интерфейсной части модуля.
347+```
348+var
349+ //Глобальные переменные, используемые для вычисления полей автогенератора первичного ключа MemDatasets
350+ vCurrentId:Integer=0;
351+ vProductsId:Integer=0;
352+ vBomsId:Integer=0;
353+ vBomCalculationProductsId:Integer=0;
354+ vBomCalculationComponentsId:Integer=0;
355+ vBomCalculationFooterId:Integer=0;
356+ vBomCalculationProductsMultipleId:Integer=0;
357+ vBomCalculationComponentsMultipleId:Integer=0;
358+ vBomCalculationFooterMultipleId:Integer=0;
359+ vStocksId:Integer=0;
360+ vOrdersId:Integer=0;
361+ vImportVariantsId:Integer=0;
362+ vImportToTablesId:Integer=0;
363+ vImportToFieldsId:Integer=0;
364+ vImportFromTablesId:Integer=0;
365+ vImportFromFieldsId:Integer=0;
366+```
367+
368+Тогда у нас есть процедура для расчета значений полей автогенератора:
369+```
370+procedure GetAutoincrementPrimaryFields;
371+ var
372+ I:Integer;
373+ vId:^Integer;
374+ begin
375+ try
376+ MemoMessages.Lines.Append(TimeToStr(Now())+' Получение информации о полях автогенератора');
377+ vSuppressEvents:=True;
378+ //Отключаем элементы управления и обновляем все наборы данных
379+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
380+ vSaveTables[I].DisableControls;
381+ vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован
382+ end;
383+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
384+ with vSaveTables[I] do begin
385+ //Используем соответствующую глобальную переменную
386+ case StringToCaseSelect(Name,
387+ ['Products','Boms','Stocks','Orders',
388+ 'BomCalculationProducts','BomCalculationComponents','BomCalculationFooter',
389+ 'BomCalculationProductsMultiple','BomCalculationComponentsMultiple','BomCalculationFooterMultiple',
390+ 'ImportVariants','ImportToTables','ImportToFields','ImportFromTables','ImportFromFields']) of
391+ 0:vId:=@vProductsId;
392+ 1:vId:=@vBomsId;
393+ 2:vId:=@vStocksId;
394+ 3:vId:=@vOrdersId;
395+ 4:vId:=@vBomCalculationProductsId;
396+ 5:vId:=@vBomCalculationComponentsId;
397+ 6:vId:=@vBomCalculationFooterId;
398+ 7:vId:=@vBomCalculationProductsMultipleId;
399+ 8:vId:=@vBomCalculationComponentsMultipleId;
400+ 9:vId:=@vBomCalculationFooterMultipleId;
401+ 10:vId:=@vImportVariantsId;
402+ 11:vId:=@vImportToTablesId;
403+ 12:vId:=@vImportToFieldsId;
404+ 13:vId:=@vImportFromTablesId;
405+ 14:vId:=@vImportFromFieldsId;
406+ end;
407+ try
408+ //Находим последнее значение ID и сохраняем его в глобальной переменной
409+ Last;
410+ vCurrentId:=FieldByName(Name+'Id').AsInteger;
411+ if (vCurrentId>vId^) then vId^:=vCurrentId;
412+ finally
413+ //Удаляем ссылку
414+ vId:=nil;
415+ end;
416+ end;
417+ end;
418+ finally
419+ vSuppressEvents:=False;
420+ //Обновляем все наборы данных и включаем элементы управления
421+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
422+ vSaveTables[I].Refresh;
423+ vSaveTables[I].EnableControls;
424+ end;
425+ MemoMessages.Lines.Append(TimeToStr(Now())+' Автоинкрементные поля - готовы.');
426+ end;
427+ end;
428+```
429+```
430+function StringToCaseSelect(Selector:string;CaseList:array of string):Integer;
431+ var
432+ cnt: integer;
433+ begin
434+ Result:=-1;
435+ for cnt:=0 to Length(CaseList)-1 do
436+ begin
437+ if CompareText(Selector, CaseList[cnt]) = 0 then
438+ begin
439+ Result:=cnt;
440+ Break;
441+ end;
442+ end;
443+ end;
444+```
445+
446+Процедура `GetAutoincrementPrimaryFields` вызывается каждый раз после восстановления (загрузки) данных из постоянных файлов, чтобы загрузить последние значения автогенератора в глобальные переменные (или свойства, как вы предпочитаете). Автоинкрементация выполняется в событии OnNewRecord каждого MemDataset. Например, для таблицы Orders MemDataset:
447+```
448+procedure TMainForm.OrdersNewRecord(DataSet: TDataSet);
449+ begin
450+ if vSuppressEvents then Exit;
451+ //Устанавливаем новое значение автогенератора
452+ vOrdersId:=vOrdersId+1;
453+ DataSet.FieldByName('OrdersId').AsInteger:=vOrdersId;
454+ end;
455+```
456+
457+Как уже объяснялось, я использую глобальную переменную vSuppressEvents в качестве флага для случая восстановления данных из постоянных файлов.
458+
459+## Обеспечение ссылочной целостности
460+
461+В компоненте MemDataset встроенная ссылочная целостность не реализована, поэтому вы должны сделать это самостоятельно.
462+
463+Предположим, у нас есть две таблицы: MasterTable и DetailTable.
464+
465+Существуют различные места, где необходимо использовать код ссылочной целостности:
466+
467+ * Код вставки/обновления находится в событии `BeforePost` DetailTable: перед сохранением новой/обновленной detail-записи ее необходимо проверить на соответствие требованиям ссылочной целостности
468+ * Код удаления находится в событии `BeforeDelete` в MasterTable: перед удалением master-записи необходимо убедиться, что все дочерние записи соответствуют требованиям ссылочной целостности
469+
470+```
471+procedure TMainForm.MasterTableBeforeDelete(DataSet: TDataSet);
472+ begin
473+ if vSuppressEvents then Exit;
474+ try
475+ DetailTable.DisableControls;
476+ // Принудительное удаление ссылок («каскадное удаление») для таблицы «MasterTable»
477+ while not DetailTable.EOF do begin
478+ DetailTable.Delete;
479+ end;
480+ DetailTable.Refresh;
481+ finally
482+ DetailTable.EnableControls;
483+ end;
484+ end;
485+```
486+```
487+procedure TMainForm.DetailTableBeforePost(DataSet: TDataSet);
488+ begin
489+ if vSuppressEvents=True then Exit;
490+ // Принудительное использование ссылочной вставки/обновления для таблицы «DetailTable» с
491+ // внешним ключом «MasterTableID», ссылающимся на
492+ // поле первичного ключа идентификатора MasterTable ID
493+ DataSet.FieldByName('MasterTableId').AsInteger:=
494+ MasterTable.FieldByName('ID').AsInteger;
495+ end;
496+```
497+
498+После того, как вы предоставили ссылочную вставку/обновление/удаление, все, что вам нужно сделать, это предоставить код для master/detail фильтрации данных. Это делается в событии `AfterScroll` в MasterTable и в событии `OnFilter` в DetailTable.
499+
500+Не забудьте установить для свойства `Filtered` DetailTable значение True.
501+```
502+procedure TMainForm.MasterTableAfterScroll(DataSet: TDataSet);
503+ begin
504+ if vSuppressEvents=True then Exit;
505+ DetailTable.Refresh;
506+ end;
507+```
508+```
509+procedure TMainForm.DetailTableFilterRecord(DataSet: TDataSet;
510+ var Accept: Boolean);
511+ begin
512+ if vSuppressEvents=True then Exit;
513+ // Показывем только дочерние поля, внешний ключ которых указывает на текущую
514+ // запись master таблицы
515+ Accept:=DataSet.FieldByName('MasterTableId').AsInteger=
516+ MasterTable.FieldByName('ID').AsInteger;
517+ end;
518+```
519+
520+## Известные проблемы
521+
522+Есть несколько ограничений при использовании MemDatasets.
523+
524+ * Метод locate не работает
525+ * Фильтрация с использованием свойства Filter и Filtered не работает. Вы должны использовать жесткое кодирование в событии OnFilter.
526+ * Повторное удаление записей кажется невероятно медленным. Поэтому я использую мою процедуру EmptyMemDataset вместо `while not EOF do Delete;`
527+ * В FPC 2.6.x и более ранних версиях метод CopyFromDataSet копирует данные только с текущей позиции курсора в конец набора исходных данных. Итак, вы должны написать `MemDataset1.First;` перед `MemDataSet2.CopyFromDataSet(MemDataset1);`. Исправлено в транке ревизии FPC 26233.
528+ * Обратите внимание, что более старые версии FPC не имеют CopyFromDataset в Bufdataset, в то время как это - преимущество для MemDs.
529+ * См. багрепорт <http://bugs.freepascal.org/view.php?id=25426>.
530+
531+## TBufDataSet
532+
533+Как упоминалось ранее, в MemDataSet отсутствуют пользовательские фильтры, тип данных автоинкремента и метод Locate, поэтому взамен лучше использовать TBufDataSet. TBufDataset предоставляется модулем BufDataset.
534+
535+Поскольку нет компонента для редактирования TBufDataSet во время разработки (но вы можете настроить определения полей во время разработки), вы можете создать пользовательский компонент-обертку или использовать его через код так же, как ClientDataSet в Delphi. Подробности смотрите в документации Delphi, касающейся наборов данных клиента для подробностей.
536+
537+Вы можете использовать те же методы для обеспечения ссылочной целостности и первичных полей автоинкремента, как описано для MemDataSet.
538+
539+Между MemDataSet и BufDataset есть только небольшие различия:
540+
541+MemDataSet | BufDataset
542+---|---
543+DataSet.ClearFields | DataSet.Fields.Clear
544+DataSet.CreateTable | DataSet.CreateDataSet
545+
546+## Сортировка DBGrid по событию OnTitleClick для TBufDataSet
547+
548+Если вы хотите включить последовательную сортировку DBGrid по возрастанию и убыванию, показывающую некоторые данные из TBufDataSet, вы можете использовать следующий метод:
549+```
550+Uses
551+ BufDataset, typinfo;
552+
553+ function SortBufDataSet(DataSet: TBufDataSet;const FieldName: String): Boolean;
554+ var
555+ i: Integer;
556+ IndexDefs: TIndexDefs;
557+ IndexName: String;
558+ IndexOptions: TIndexOptions;
559+ Field: TField;
560+ begin
561+ Result := False;
562+ Field := DataSet.Fields.FindField(FieldName);
563+ //Если неверное имя поля, выйдем.
564+ if Field = nil then Exit;
565+ //Если неверный тип поля, выйдем.
566+ if {(Field is TObjectField) or} (Field is TBlobField) or
567+ {(Field is TAggregateField) or} (Field is TVariantField)
568+ or (Field is TBinaryField) then Exit;
569+ //Получаем IndexDefs и IndexName, используя RTTI
570+ if IsPublishedProp(DataSet, 'IndexDefs') then
571+ IndexDefs := GetObjectProp(DataSet, 'IndexDefs') as TIndexDefs
572+ else
573+ Exit;
574+ if IsPublishedProp(DataSet, 'IndexName') then
575+ IndexName := GetStrProp(DataSet, 'IndexName')
576+ else
577+ Exit;
578+ //Убедитесь, что IndexDefs об-нов-лен
579+ IndexDefs.Updated:=false; {<<<<---Эта строка имеет решающее значение, так как IndexDefs.Update ничего не будет делать при следующей сортировке, если она уже верна}
580+ IndexDefs.Update;
581+ //Если восходящий индекс уже используется,
582+ //переключаемся на нисходящий индекс
583+ if IndexName = FieldName + '__IdxA'
584+ then
585+ begin
586+ IndexName := FieldName + '__IdxD';
587+ IndexOptions := [ixDescending];
588+ end
589+ else
590+ begin
591+ IndexName := FieldName + '__IdxA';
592+ IndexOptions := [];
593+ end;
594+ //ищем существующий индекс
595+ for i := 0 to Pred(IndexDefs.Count) do
596+ begin
597+ if IndexDefs[i].Name = IndexName then
598+ begin
599+ Result := True;
600+ Break
601+ end; //if
602+ end; // for
603+ //Если существующий индекс не найден, создаем его
604+ if not Result then
605+ begin
606+ if IndexName=FieldName + '__IdxD' then
607+ DataSet.AddIndex(IndexName, FieldName, IndexOptions, FieldName)
608+ else
609+ DataSet.AddIndex(IndexName, FieldName, IndexOptions);
610+ Result := True;
611+ end; // if not
612+ //Устанавливаем индекс
613+ SetStrProp(DataSet, 'IndexName', IndexName);
614+ end;
615+```
616+
617+Итак, вы можете вызвать эту функцию из DBGrid следующим образом:
618+```
619+procedure TFormMain.DBGridProductsTitleClick(Column: TColumn);
620+ begin
621+ SortBufDataSet(Products, Column.FieldName);
622+ end;
623+```
624+
625+## Сортировка нескольких столбцов в grid
626+
627+Я написал TDBGridHelper для сортировки grid по нескольким столбцам, удерживая клавишу Shift.
628+
629+![Light bulb](https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png) **Примечание:** MaxIndexesCount должен быть достаточно большим для TBufDataSet, потому что могут быть довольно большие комбинации возможных вариантов сортировки.
630+
631+Но я думаю, что люди не будут использовать больше 10, поэтому установка 100 должна быть теоретически приемлемой.
632+```
633+{ TDBGridHelper }
634+
635+ TDBGridHelper = class helper for TDBGrid
636+ public const
637+ cMaxColCOunt = 3;
638+ private
639+ procedure Interbal_MakeNames(Fields: TStrings; out FieldsList, DescFields: String);
640+ procedure Internal_SetColumnsIcons(Fields: TStrings; AscIdx, DescIdx: Integer);
641+ function Internal_IndexNameExists(IndexDefs: TIndexDefs; IndexName: String): Boolean;
642+ public
643+ procedure Sort(const FieldName: String; AscIdx: Integer = -1; DescIdx: Integer = -1);
644+ procedure ClearSort;
645+ end;
646+
647+ { TDBGridHelper }
648+
649+ procedure TDBGridHelper.Interbal_MakeNames(Fields: TStrings; out FieldsList, DescFields: String);
650+ var
651+ FldList: TStringList;
652+ DscList: TStringList;
653+ FldDesc, FldName: String;
654+ i: Integer;
655+ begin
656+ if Fields.Count = 0 then
657+ begin
658+ FieldsList := '';
659+ DescFields := '';
660+ Exit;
661+ end;
662+
663+ FldList := TStringList.Create;
664+ DscList := TStringList.Create;
665+ try
666+ FldList.Delimiter := ';';
667+ DscList.Delimiter := ';';
668+
669+ for i := 0 to Fields.Count - 1 do
670+ begin
671+ Fields.GetNameValue(i, FldName, FldDesc);
672+ FldList.Add(FldName);
673+
674+ if FldDesc = 'D' then
675+ DscList.Add(FldName);
676+ end;
677+
678+ FieldsList := FldList.DelimitedText;
679+ DescFields := DscList.DelimitedText;
680+ finally
681+ FldList.Free;
682+ DscList.Free;
683+ end;
684+ end;
685+
686+ procedure TDBGridHelper.Internal_SetColumnsIcons(Fields: TStrings; AscIdx, DescIdx: Integer);
687+ var
688+ i: Integer;
689+ FldDesc: String;
690+ begin
691+ for i := 0 to Self.Columns.Count - 1 do
692+ begin
693+ FldDesc := Fields.Values[Self.Columns[i].Field.FieldName];
694+
695+ if FldDesc = 'A' then
696+ Self.Columns[i].Title.ImageIndex := AscIdx
697+ else
698+ if FldDesc = 'D' then
699+ Self.Columns[i].Title.ImageIndex := DescIdx
700+ else
701+ Self.Columns[i].Title.ImageIndex := -1
702+ end;
703+ end;
704+
705+ function TDBGridHelper.Internal_IndexNameExists(IndexDefs: TIndexDefs; IndexName: String): Boolean;
706+ var
707+ i: Integer;
708+ begin
709+ for i := 0 to IndexDefs.Count - 1 do
710+ begin
711+ if IndexDefs[i].Name = IndexName then
712+ Exit(True)
713+ end;
714+
715+ Result := False
716+ end;
717+
718+ procedure TDBGridHelper.Sort(const FieldName: String; AscIdx: Integer;
719+ DescIdx: Integer);
720+ var
721+ Field: TField;
722+ DataSet: TBufDataset;
723+ IndexDefs: TIndexDefs;
724+ IndexName, Dir, DescFields, FieldsList: String;
725+ Fields: TStringList;
726+ begin
727+ if not Assigned(DataSource.DataSet) or
728+ not DataSource.DataSet.Active or
729+ not (DataSource.DataSet is TBufDataset) then
730+ Exit;
731+ DataSet := DataSource.DataSet as TBufDataset;
732+
733+ Field := DataSet.FieldByName(FieldName);
734+ if (Field is TBlobField) or (Field is TVariantField) or (Field is TBinaryField) then
735+ Exit;
736+
737+ IndexDefs := DataSet.IndexDefs;
738+ IndexName := DataSet.IndexName;
739+
740+ if not IndexDefs.Updated then
741+ IndexDefs.Update;
742+
743+ Fields := TStringList.Create;
744+ try
745+ Fields.DelimitedText := IndexName;
746+ Dir := Fields.Values[FieldName];
747+
748+ if Dir = 'A' then
749+ Dir := 'D'
750+ else
751+ if Dir = 'D' then
752+ Dir := 'A'
753+ else
754+ Dir := 'A';
755+
756+ //Если нажата клавиша Shift, добавляем поле в список полей.
757+ if ssShift in GetKeyShiftState then
758+ begin
759+ Fields.Values[FieldName] := Dir;
760+ //Мы не добавляем в сортировку больше полей, если общее количество полей превышает cMaxColCOunt
761+ if Fields.Count > cMaxColCOunt then
762+ Exit;
763+ end
764+ else
765+ begin
766+ Fields.Clear;
767+ Fields.Values[FieldName] := Dir;
768+ end;
769+
770+ IndexName := Fields.DelimitedText;
771+ if not Internal_IndexNameExists(IndexDefs, IndexName) then
772+ begin
773+ Interbal_MakeNames(Fields, FieldsList, DescFields);
774+ TBufDataset(DataSet).AddIndex(IndexName, FieldsList, [], DescFields, '');
775+ end;
776+
777+ DataSet.IndexName := IndexName;
778+ Internal_SetColumnsIcons(Fields, AscIdx, DescIdx)
779+ finally
780+ Fields.Free;
781+ end;
782+ end;
783+
784+ procedure TDBGridHelper.ClearSort;
785+ var
786+ DataSet: TBufDataset;
787+ Fields: TStringList;
788+ begin
789+ if not Assigned(DataSource.DataSet) or
790+ not DataSource.DataSet.Active or
791+ not (DataSource.DataSet is TBufDataset) then
792+ Exit;
793+ DataSet := DataSource.DataSet as TBufDataset;
794+
795+ DataSet.IndexName := '';
796+
797+ Fields := TStringList.Create;
798+ try
799+ Internal_SetColumnsIcons(Fields, -1, -1)
800+ finally
801+ Fields.Free
802+ end
803+ end;
804+```
805+
806+Чтобы использовать сортировку, нужно вызвать вспомогательные методы в OnCellClick и onTitleClick. OnTitleClick - если вы удерживаете клавишу shift, добавляется новый столбец в список сортировки, или меняется направление сортировки выбранного столбца, или просто сортируется один столбец. OnCellClick - если дважды щелкнуть ячейку [0, 0], сетка очищает ее сортировку.
807+```
808+procedure TForm1.grdCountriesCellClick(Column: TColumn);
809+ begin
810+ if not Assigned(Column) then
811+ grdCountries.ClearSort
812+ end;
813+
814+ procedure TForm1.grdCountriesTitleClick(Column: TColumn);
815+ begin
816+ grdCountries.Sort(Column.Field.FieldName, 0, 1);
817+ end;
818+```
819+
820+Если вы назначили TitleImageList, вы можете указать, какое изображение использовать для восходящей, а какое для нисходящей сортировки.
821+
822+## ZMSQL
823+
824+Другой, часто лучший способ написания баз данных в памяти - это использование пакета ZMSQL:
825+
826+ * [[ZMSQL]]
827+ * <http://sourceforge.net/projects/lazarus-ccr/files/zmsql/>
828+ * <http://www.lazarus.freepascal.org/index.php/topic,13821.30.html>
829+
830+## Авторство
831+
832+Оригинальный текст написан: Zlatko Matić (matalab@gmail.com)
833+
834+Вклад других авторов, как показано на странице History.
835+
836+---
837+*From the Free Pascal wiki, page "How to write in-memory database applications in Lazarus/FPC/ru", as the Internet Archive kept it on 2025-01-17. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*

Back to history