Sign in Join
Wiki copytemporary

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

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

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-
411## Введение
422
43-Существуют определенные обстоятельства, когда наборы данных в памяти имеют смысл. Если вам нужна быстрая, однопользовательская, не критически важная база данных, отличная от SQL, без транзакций, [[TMemDataset]] может удовлетворить ваши потребности.
3+Существуют определенные обстоятельства, когда наборы данных в памяти имеют смысл. Если вам нужна быстрая, однопользовательская, не критически важная база данных, отличная от SQL, без транзакций, [[TMemDataset]] может удовлетворить ваши потребности.
444
45-Некоторые преимущества:
5+Некоторые преимущества:
466
47- * Быстрое выполнение. Поскольку вся обработка выполняется в памяти, данные не сохраняются на жестком диске до тех пор, пока это не будет задано явно. Память, безусловно, быстрее, чем жесткий диск.
48- * Нет необходимости во внешних библиотеках (нет файлов .so или .dll), нет необходимости в установке сервера.
49- * Код является мультиплатформенным и может быть скомпилирован в любой ОС.
50- * Поскольку все программирование выполняется в Lazarus/FPC, такие приложения проще в обслуживании. Вместо того, чтобы постоянно переключаться с внутреннего программирования на внешнее, используя MemDatasets, вы можете сосредоточиться на своем коде Pascal.
7+- Быстрое выполнение. Поскольку вся обработка выполняется в памяти, данные не сохраняются на жестком диске до тех пор, пока это не будет задано явно. Память, безусловно, быстрее, чем жесткий диск.
8+- Нет необходимости во внешних библиотеках (нет файлов .so или .dll), нет необходимости в установке сервера.
9+- Код является мультиплатформенным и может быть скомпилирован в любой ОС.
10+- Поскольку все программирование выполняется в Lazarus/FPC, такие приложения проще в обслуживании. Вместо того, чтобы постоянно переключаться с внутреннего программирования на внешнее, используя MemDatasets, вы можете сосредоточиться на своем коде Pascal.
5111
52-![Light bulb](https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png) **Примечание:** позже в этой статье будет представлен BufDataset. [[TBufDataset]] часто является лучшим выбором, чем [[TMemDataset]]
12+> **Note:** позже в этой статье будет представлен BufDataset. [[TBufDataset]] часто является лучшим выбором, чем [[TMemDataset]]
5313
54-Я проиллюстрирую, как программировать реляционные не-SQL базы данных в памяти, сосредоточив внимание на обеспечении целостности отношений и фильтрации, моделировании основных полей с автоинкрементом и т.п.
14+Я проиллюстрирую, как программировать реляционные не-SQL базы данных в памяти, сосредоточив внимание на обеспечении целостности отношений и фильтрации, моделировании основных полей с автоинкрементом и т.п.
5515
56-Эта страница поделится с вами тем, что я узнал, экспериментируя с TMemDatasets. Возможно даже, что есть какой-то другой, более эффективный способ сделать это. Если это так, пожалуйста, не стесняйтесь вносить свой вклад в этот документ в интересах сообщества Lazarus/FPC.
16+Эта страница поделится с вами тем, что я узнал, экспериментируя с TMemDatasets. Возможно даже, что есть какой-то другой, более эффективный способ сделать это. Если это так, пожалуйста, не стесняйтесь вносить свой вклад в этот документ в интересах сообщества Lazarus/FPC.
5717
58-Модуль memds предоставляет TMemDataset, так что вам нужно будет добавить его в раздел uses вашего проекта.
18+Модуль memds предоставляет TMemDataset, так что вам нужно будет добавить его в раздел uses вашего проекта.
5919
6020## Сохранение MemDataset в постоянные файлы
6121
62-В [[Interface|интерфейсной]] части вашего кода объявите тип массива для хранения информации обо всех TMemDataSets, которые вы хотите сделать постоянными в конце сеанса и восстановить в начале следующего сеанса. Вы также должны объявить переменную типа TSaveTables.
22+В [[Interface|интерфейсной]] части вашего кода объявите тип массива для хранения информации обо всех TMemDataSets, которые вы хотите сделать постоянными в конце сеанса и восстановить в начале следующего сеанса. Вы также должны объявить переменную типа TSaveTables.
6323
64-Я также использую глобальную переменную vSuppressEvents типа boolean для подавления событий Dataset, используемых для обеспечения ссылочной целостности, во время восстановления данных.
24+Я также использую глобальную переменную vSuppressEvents типа boolean для подавления событий Dataset, используемых для обеспечения ссылочной целостности, во время восстановления данных.
6525
66-Вот, что у вас должно получиться:
67-```
26+Вот, что у вас должно получиться:
27+
28+``` pascal
6829type
69- TSaveTables=array[1..15] of TMemDataset;
70- var
71- //Глобальная переменная, которая хранит таблицы для сохранения/восстановления сеанса работы
72- vSaveTables:TSaveTables;
73- //Переменная-флаг подавления событий датасета. Используется при загрузке данных из файлов.
74- vSuppressEvents:Boolean;
30+ TSaveTables=array[1..15] of TMemDataset;
31+var
32+ //Глобальная переменная, которая хранит таблицы для сохранения/восстановления сеанса работы
33+ vSaveTables:TSaveTables;
34+ //Переменная-флаг подавления событий датасета. Используется при загрузке данных из файлов.
35+ vSuppressEvents:Boolean;
7536```
7637
77-Вместо того, чтобы использовать глобальные переменные, как это сделал, например, я, вы также можете сделать их свойством главной формы. TMemDataset имеет способ хранения данных в постоянном файле: метод SaveToFile. Но вы, возможно, захотите сохранить данные в файлы [[CSV]] для упрощения работы с ними в дальнейшем. Поэтому я объединю оба способа в одни и те же процедуры.
38+Вместо того, чтобы использовать глобальные переменные, как это сделал, например, я, вы также можете сделать их свойством главной формы. TMemDataset имеет способ хранения данных в постоянном файле: метод SaveToFile. Но вы, возможно, захотите сохранить данные в файлы [[CSV]] для упрощения работы с ними в дальнейшем. Поэтому я объединю оба способа в одни и те же процедуры.
7839
79-Я задаю константу cSaveRestore в интерфейсной части модуля, с помощью которой я могу определить, будут ли данные храниться и загружаться как нативные файлы MemDataset, или как файлы CSV.
80-```
40+Я задаю константу cSaveRestore в интерфейсной части модуля, с помощью которой я могу определить, будут ли данные храниться и загружаться как нативные файлы MemDataset, или как файлы CSV.
41+
42+``` pascal
8143const
82- //Константа cSaveRestore определяет способ сохранения и восстановления MemDataset в постоянные файлы.
83- cSaveRestore=0; //0=собственный формат MemDataset, 1=сохранение и восстановление из CSV
44+ //Константа cSaveRestore определяет способ сохранения и восстановления MemDataset в постоянные файлы.
45+ cSaveRestore=0; //0=собственный формат MemDataset, 1=сохранение и восстановление из CSV
8446```
8547
86-Теперь вы можете сохранить MemDataset'ы в событии OnFormClose и загрузить их в событие OnFormCreate. Заполнить элементы массива экземплярами MemDataset можно также в событии OnFormCreate.
87-```
48+Теперь вы можете сохранить MemDataset'ы в событии OnFormClose и загрузить их в событие OnFormCreate. Заполнить элементы массива экземплярами MemDataset можно также в событии OnFormCreate.
49+
50+``` pascal
8851procedure 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-```
52+begin
53+ //Список таблиц, которые будут сохранены/восстановлены для сеанса работы
54+ vSaveTables[1]:=Products;
55+ vSaveTables[2]:=Boms;
56+ vSaveTables[3]:=Stocks;
57+ vSaveTables[4]:=Orders;
58+ vSaveTables[5]:=BomCalculationProducts;
59+ vSaveTables[6]:=BomCalculationComponents;
60+ vSaveTables[7]:=BomCalculationFooter;
61+ vSaveTables[8]:=BomCalculationProductsMultiple;
62+ vSaveTables[9]:=BomCalculationComponentsMultiple;
63+ vSaveTables[10]:=BomCalculationFooterMultiple;
64+ vSaveTables[11]:=ImportVariants;
65+ vSaveTables[12]:=ImportToTables;
66+ vSaveTables[13]:=ImportToFields;
67+ vSaveTables[14]:=ImportFromTables;
68+ vSaveTables[15]:=ImportFromFields;
69+ //Восстанавливаем сеанс работы
70+ RestoreSession;
71+ GetAutoincrementPrimaryFields;
72+end;
11173```
74+
75+``` pascal
11276procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
113- begin
114- //Сохраняем наборы данных в файлы (чтобы сохранить текущий сеанс)
115- SaveSession;
116- end;
117-```
77+begin
78+ //Сохраняем наборы данных в файлы (чтобы сохранить текущий сеанс)
79+ SaveSession;
80+end;
11881```
82+
83+``` pascal
11984procedure RestoreSession;
120- var
121- I:Integer;
122- begin
85+var
86+ I:Integer;
87+begin
88+ try
89+ MemoMessages.Append(TimeToStr(Now())+' Начало восстановления ранее сохраненного сеанса.');
90+ vSuppressEvents:=True; //Подавляем события, используемые для обеспечения ссылочной целостности
91+ //Отключаем элементы управления и обновляем все наборы данных
92+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
93+ vSaveTables[I].DisableControls;
94+ vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован
95+ end;
96+ //Загружаем memdataset'ы из файлов (для восстановления предыдущего сеанса)
97+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
98+ vSaveTables[I].First;
99+ MemoMessages.Append(TimeToStr(Now())+' Начинаем восстановление таблицы: '+vSaveTables[I].Name);
123100 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; //Важный момент, если набор данных был отфильтрован
101+ //Если данные загружаются из CSV-файла, то сначала необходимо удалить таблицу.
102+ if cSaveRestore=1 then begin
103+ MemoMessages.Append(TimeToStr(Now())+' Начинаем удаление всех записей в таблице: '+vSaveTables[I].Name);
104+ //Этот способ удаления всех записей невероятно медленный.
105+ {while not vSaveTables[I].EOF do begin
106+ vSaveTables[I].Delete;
107+ end;}
108+ //Этот метод для удаления всех записей намного быстрее
109+ EmptyMemDataSet(vSaveTables[I]);
110+ MemoMessages.Append(TimeToStr(Now())+' Все записи из таблицы: '+vSaveTables[I].Name+' удалены.');
130111 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;
112+ except
113+ on E:Exception do begin
114+ MemoMessages.Append(TimeToStr(Now())+' Ошибка при удалении записей из таблицы: '+vSaveTables[I].Name +'. '+E.Message);
115+ end;
116+ end;
117+ try
118+ try
119+ MemoMessages.Append(TimeToStr(Now())+' Восстановление таблицы: '+vSaveTables[I].Name);
120+ //Проверяем константу для выбора способа сохранения/восстановления данных и загрузки сохраненного сеанса
121+ case cSaveRestore of
122+ 0:vSaveTables[I].LoadFromFile(vSaveTables[I].Name);
123+ 1:LoadFromCsv(vSaveTables[I]);
151124 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....
125+ except
126+ on E:Exception do begin
127+ MemoMessages.Append(TimeToStr(Now())+' Ошибка при восстановлении таблицы: '+vSaveTables[I].Name +'. '+E.Message);
167128 end;
168- MemoMessages.Append(TimeToStr(Now())+' Таблица: '+vSaveTables[I].Name+' восстановлена.');
169129 end;
170130 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())+' Все таблицы восстановлены из сохраненных файлов.');
131+ vSaveTables[I].Active:=True;//Требуется из-за метода LoadFromFile....
178132 end;
133+ MemoMessages.Append(TimeToStr(Now())+' Таблица: '+vSaveTables[I].Name+' восстановлена.');
179134 end;
180-```
135+ finally
136+ vSuppressEvents:=False;
137+ //Обновляем все наборы данных и включаем элементы управления
138+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
139+ vSaveTables[I].Refresh; //Необходимо для таблиц, которые фильтруются.
140+ vSaveTables[I].EnableControls;
141+ end;
142+ MemoMessages.Append(TimeToStr(Now())+' Все таблицы восстановлены из сохраненных файлов.');
143+ end;
144+end;
181145```
146+
147+``` pascal
182148procedure SaveSession;
183- var
184- I:Integer;
185- begin
149+var
150+ I:Integer;
151+begin
152+ try
153+ MemoMessages.Append(TimeToStr(Now())+' Начало сохранения сеанса в постоянные файлы.');
154+ vSuppressEvents:=True;
155+ //Отключаем элементы управления и обновляем все наборы данных
156+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
157+ vSaveTables[I].DisableControls;
158+ vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован
159+ end;
160+ //Сохраняем сеанс работы в файл
161+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
162+ vSaveTables[I].First;
163+ MemoMessages.Append(TimeToStr(Now())+' Сохранение таблицы: '+vSaveTables[I].Name);
186164 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+' сохранена.');
165+ //Проверяем константу для выбора способа сохранения/восстановления данных и загрузки сохраненного сеанса
166+ case cSaveRestore of
167+ 0:vSaveTables[I].SaveToFile(vSaveTables[I].Name);
168+ 1:SaveToCsv(vSaveTables[I]);
210169 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;
170+ except
171+ on E:Exception do begin
172+ MemoMessages.Append(TimeToStr(Now())+' Ошибка при сохранении таблицы: '+vSaveTables[I].Name +'. '+E.Message);
217173 end;
218- MemoMessages.Append(TimeToStr(Now())+' Все таблицы сохранены в файлы.');
219174 end;
175+ MemoMessages.Append(TimeToStr(Now())+' Таблица: '+vSaveTables[I].Name+' сохранена.');
220176 end;
221-```
177+ finally
178+ vSuppressEvents:=False;
179+ //Обновляем все наборы данных и включаем элементы управления
180+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
181+ vSaveTables[I].Refresh; //Необходимо для таблиц, которые фильтруются
182+ vSaveTables[I].EnableControls;
183+ end;
184+ MemoMessages.Append(TimeToStr(Now())+' Все таблицы сохранены в файлы.');
185+ end;
186+end;
222187```
188+
189+``` pascal
223190procedure 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;
191+var
192+ vTemporaryMemDataSet:TMemDataSet;
193+ vFieldDef:TFieldDef;
194+ I:Integer;
195+begin
196+ try
197+ //Создаем временный MemDataSet
198+ vTemporaryMemDataSet:=TMemDataSet.Create(nil);
199+ //Сохраняем FieldDefs во временном MemDataSet
200+ for I:=0 to DataSet.FieldDefs.Count-1 do begin
201+ vFieldDef:=vTemporaryMemDataSet.FieldDefs.AddFieldDef;
202+ with DataSet.FieldDefs[I] do begin
203+ vFieldDef.Name:=Name;
204+ vFieldDef.DataType:=DataType;
205+ vFieldDef.Size:=Size;
206+ vFieldDef.Required:=Required;
250207 end;
251208 end;
252-```
209+ //Очищаем существующие fielddefs
210+ DataSet.Clear;
211+ //Восстанавливаем fielddefs
212+ DataSet.FieldDefs:=vTemporaryMemDataSet.FieldDefs;
213+ DataSet.Active:=True;
214+ finally
215+ vTemporaryMemDataSet.Clear;
216+ vTemporaryMemDataSet.Free;
217+ end;
218+end;
253219```
220+
221+``` pascal
254222procedure 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;
223+var
224+ vFieldCount:Integer;
225+ I:Integer;
226+begin
227+ try
228+ //Назначаем SdfDataSetTemporary
229+ with SdfDataSetTemporary do begin
230+ Active:=False;
231+ ClearFields;
232+ FileName:=DataSet.Name+'.txt';
233+ FirstLineAsSchema:=True;
234+ Active:=True;
235+ //Определяем количество полей
236+ vFieldCount:=FieldDefs.Count;
237+ end;
238+ //Выполняем итерацию по SdfDataSetTeditional и вставляем записи в MemDataSet.
239+ SdfDataSetTemporary.First;
240+ while not SdfDataSetTemporary.EOF do begin
241+ DataSet.Append;
242+ //Итерация по FieldDefs
243+ for I:=0 to vFieldCount-1 do begin
244+ try
245+ DataSet.Fields[I].Value:=SdfDataSetTemporary.Fields[I].Value;
246+ except
247+ on E:Exception do begin
248+ MemoMessages.Append(TimeToStr(Now())+' Ошибка при установке значения для поля: '
249+ +DataSet.Name+'.'+DataSet.Fields[I].Name +'. '+E.Message);
292250 end;
293- SdfDataSetTemporary.Next;
294251 end;
295- finally
296- SdfDataSetTemporary.Active:=False;
297- SdfDataSetTemporary.ClearFields;
298252 end;
253+ try
254+ DataSet.Post;
255+ except
256+ on E:Exception do begin
257+ MemoMessages.Append(TimeToStr(Now())+' Ошибка при сохранении записи в таблицу: '
258+ +DataSet.Name+'.'+E.Message);
259+ end;
260+ end;
261+ SdfDataSetTemporary.Next;
299262 end;
300-```
263+ finally
264+ SdfDataSetTemporary.Active:=False;
265+ SdfDataSetTemporary.ClearFields;
266+ end;
267+end;
301268```
269+
270+``` pascal
302271procedure 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
272+var
273+ myFileName:string;
274+ myTextFile: TextFile;
275+ i: integer;
276+ s: string;
277+begin
278+ myFileName:=DataSet.Name+'.txt';
279+ //создаем новый файл
280+ AssignFile(myTextFile, myFileName);
281+ Rewrite(myTextFile);
282+ s := ''; //инициализируем пустую строку
283+ try
284+ //записываем имена полей (как заголовки столбцов)
285+ for i := 0 to DataSet.Fields.Count - 1 do
286+ begin
287+ s := s + Format('%s,', [DataSet.Fields[i].FieldName]);
288+ end;
289+ Writeln(myTextFile, s);
290+ DataSet.First;
291+ //записываем значения полей
292+ while not DataSet.Eof do
293+ begin
294+ s := '';
295+ for i := 0 to DataSet.FieldCount - 1 do
324296 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;
297+ //Числовые поля без кавычек, строковые поля с кавычками
298+ if ((DataSet.FieldDefs[i].DataType=ftInteger)
299+ or (DataSet.FieldDefs[i].DataType=ftFloat)) then
300+ s := s + Format('%s,', [DataSet.Fields[i].AsString])
301+ else
302+ s := s + Format('"%s",', [DataSet.Fields[i].AsString]);
337303 end;
338- finally
339- CloseFile(myTextFile);
304+ Writeln(myTextfile, s);
305+ DataSet.Next;
340306 end;
341- end;
307+ finally
308+ CloseFile(myTextFile);
309+ end;
310+end;
342311```
343312
344313## Автогенератор первичных ключей
345314
346-Тип поля Autoincrement не поддерживается MemDataset. Тем не менее, вы можете имитировать его, используя тип поля Integer и предоставляя калькулятор для полей автогенератора. Нам нужны глобальные переменные или открытые свойства для хранения текущего значения поля автогенератора. Я предпочитаю глобальные переменные, объявленные в интерфейсной части модуля.
347-```
315+Тип поля Autoincrement не поддерживается MemDataset. Тем не менее, вы можете имитировать его, используя тип поля Integer и предоставляя калькулятор для полей автогенератора. Нам нужны глобальные переменные или открытые свойства для хранения текущего значения поля автогенератора. Я предпочитаю глобальные переменные, объявленные в интерфейсной части модуля.
316+
317+``` pascal
348318var
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;
319+ //Глобальные переменные, используемые для вычисления полей автогенератора первичного ключа MemDatasets
320+ vCurrentId:Integer=0;
321+ vProductsId:Integer=0;
322+ vBomsId:Integer=0;
323+ vBomCalculationProductsId:Integer=0;
324+ vBomCalculationComponentsId:Integer=0;
325+ vBomCalculationFooterId:Integer=0;
326+ vBomCalculationProductsMultipleId:Integer=0;
327+ vBomCalculationComponentsMultipleId:Integer=0;
328+ vBomCalculationFooterMultipleId:Integer=0;
329+ vStocksId:Integer=0;
330+ vOrdersId:Integer=0;
331+ vImportVariantsId:Integer=0;
332+ vImportToTablesId:Integer=0;
333+ vImportToFieldsId:Integer=0;
334+ vImportFromTablesId:Integer=0;
335+ vImportFromFieldsId:Integer=0;
366336```
367337
368-Тогда у нас есть процедура для расчета значений полей автогенератора:
369-```
338+Тогда у нас есть процедура для расчета значений полей автогенератора:
339+
340+``` pascal
370341procedure 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;
342+var
343+ I:Integer;
344+ vId:^Integer;
345+begin
346+ try
347+ MemoMessages.Lines.Append(TimeToStr(Now())+' Получение информации о полях автогенератора');
348+ vSuppressEvents:=True;
349+ //Отключаем элементы управления и обновляем все наборы данных
350+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
351+ vSaveTables[I].DisableControls;
352+ vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован
353+ end;
354+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
355+ with vSaveTables[I] do begin
356+ //Используем соответствующую глобальную переменную
357+ case StringToCaseSelect(Name,
358+ ['Products','Boms','Stocks','Orders',
359+ 'BomCalculationProducts','BomCalculationComponents','BomCalculationFooter',
360+ 'BomCalculationProductsMultiple','BomCalculationComponentsMultiple','BomCalculationFooterMultiple',
361+ 'ImportVariants','ImportToTables','ImportToFields','ImportFromTables','ImportFromFields']) of
362+ 0:vId:=@vProductsId;
363+ 1:vId:=@vBomsId;
364+ 2:vId:=@vStocksId;
365+ 3:vId:=@vOrdersId;
366+ 4:vId:=@vBomCalculationProductsId;
367+ 5:vId:=@vBomCalculationComponentsId;
368+ 6:vId:=@vBomCalculationFooterId;
369+ 7:vId:=@vBomCalculationProductsMultipleId;
370+ 8:vId:=@vBomCalculationComponentsMultipleId;
371+ 9:vId:=@vBomCalculationFooterMultipleId;
372+ 10:vId:=@vImportVariantsId;
373+ 11:vId:=@vImportToTablesId;
374+ 12:vId:=@vImportToFieldsId;
375+ 13:vId:=@vImportFromTablesId;
376+ 14:vId:=@vImportFromFieldsId;
417377 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;
378+ try
379+ //Находим последнее значение ID и сохраняем его в глобальной переменной
380+ Last;
381+ vCurrentId:=FieldByName(Name+'Id').AsInteger;
382+ if (vCurrentId>vId^) then vId^:=vCurrentId;
383+ finally
384+ //Удаляем ссылку
385+ vId:=nil;
424386 end;
425- MemoMessages.Lines.Append(TimeToStr(Now())+' Автоинкрементные поля - готовы.');
426387 end;
427388 end;
428-```
389+ finally
390+ vSuppressEvents:=False;
391+ //Обновляем все наборы данных и включаем элементы управления
392+ for I:=Low(vSaveTables) to High(vSaveTables) do begin
393+ vSaveTables[I].Refresh;
394+ vSaveTables[I].EnableControls;
395+ end;
396+ MemoMessages.Lines.Append(TimeToStr(Now())+' Автоинкрементные поля - готовы.');
397+ end;
398+end;
429399```
400+
401+``` pascal
430402function StringToCaseSelect(Selector:string;CaseList:array of string):Integer;
431- var
432- cnt: integer;
403+var
404+ cnt: integer;
405+begin
406+ Result:=-1;
407+ for cnt:=0 to Length(CaseList)-1 do
408+ begin
409+ if CompareText(Selector, CaseList[cnt]) = 0 then
433410 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;
411+ Result:=cnt;
412+ Break;
443413 end;
414+ end;
415+end;
444416```
445417
446-Процедура `GetAutoincrementPrimaryFields` вызывается каждый раз после восстановления (загрузки) данных из постоянных файлов, чтобы загрузить последние значения автогенератора в глобальные переменные (или свойства, как вы предпочитаете). Автоинкрементация выполняется в событии OnNewRecord каждого MemDataset. Например, для таблицы Orders MemDataset:
447-```
418+Процедура `GetAutoincrementPrimaryFields` вызывается каждый раз после восстановления (загрузки) данных из постоянных файлов, чтобы загрузить последние значения автогенератора в глобальные переменные (или свойства, как вы предпочитаете). Автоинкрементация выполняется в событии OnNewRecord каждого MemDataset. Например, для таблицы Orders MemDataset:
419+
420+``` pascal
448421procedure TMainForm.OrdersNewRecord(DataSet: TDataSet);
449- begin
450- if vSuppressEvents then Exit;
451- //Устанавливаем новое значение автогенератора
452- vOrdersId:=vOrdersId+1;
453- DataSet.FieldByName('OrdersId').AsInteger:=vOrdersId;
454- end;
422+begin
423+ if vSuppressEvents then Exit;
424+ //Устанавливаем новое значение автогенератора
425+ vOrdersId:=vOrdersId+1;
426+ DataSet.FieldByName('OrdersId').AsInteger:=vOrdersId;
427+end;
455428```
456429
457-Как уже объяснялось, я использую глобальную переменную vSuppressEvents в качестве флага для случая восстановления данных из постоянных файлов.
430+Как уже объяснялось, я использую глобальную переменную vSuppressEvents в качестве флага для случая восстановления данных из постоянных файлов.
458431
459432## Обеспечение ссылочной целостности
460433
461-В компоненте MemDataset встроенная ссылочная целостность не реализована, поэтому вы должны сделать это самостоятельно.
434+В компоненте MemDataset встроенная ссылочная целостность не реализована, поэтому вы должны сделать это самостоятельно.
462435
463-Предположим, у нас есть две таблицы: MasterTable и DetailTable.
436+Предположим, у нас есть две таблицы: MasterTable и DetailTable.
464437
465-Существуют различные места, где необходимо использовать код ссылочной целостности:
438+Существуют различные места, где необходимо использовать код ссылочной целостности:
466439
467- * Код вставки/обновления находится в событии `BeforePost` DetailTable: перед сохранением новой/обновленной detail-записи ее необходимо проверить на соответствие требованиям ссылочной целостности
468- * Код удаления находится в событии `BeforeDelete` в MasterTable: перед удалением master-записи необходимо убедиться, что все дочерние записи соответствуют требованиям ссылочной целостности
440+- Код вставки/обновления находится в событии `BeforePost` DetailTable: перед сохранением новой/обновленной detail-записи ее необходимо проверить на соответствие требованиям ссылочной целостности
441+- Код удаления находится в событии `BeforeDelete` в MasterTable: перед удалением master-записи необходимо убедиться, что все дочерние записи соответствуют требованиям ссылочной целостности
469442
470-```
443+``` pascal
471444procedure 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;
445+begin
446+ if vSuppressEvents then Exit;
447+ try
448+ DetailTable.DisableControls;
449+ // Принудительное удаление ссылок («каскадное удаление») для таблицы «MasterTable»
450+ while not DetailTable.EOF do begin
451+ DetailTable.Delete;
484452 end;
485-```
453+ DetailTable.Refresh;
454+ finally
455+ DetailTable.EnableControls;
456+ end;
457+end;
486458```
459+
460+``` pascal
487461procedure 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;
462+begin
463+ if vSuppressEvents=True then Exit;
464+ // Принудительное использование ссылочной вставки/обновления для таблицы «DetailTable» с
465+ // внешним ключом «MasterTableID», ссылающимся на
466+ // поле первичного ключа идентификатора MasterTable ID
467+ DataSet.FieldByName('MasterTableId').AsInteger:=
468+ MasterTable.FieldByName('ID').AsInteger;
469+end;
496470```
497471
498-После того, как вы предоставили ссылочную вставку/обновление/удаление, все, что вам нужно сделать, это предоставить код для master/detail фильтрации данных. Это делается в событии `AfterScroll` в MasterTable и в событии `OnFilter` в DetailTable.
472+После того, как вы предоставили ссылочную вставку/обновление/удаление, все, что вам нужно сделать, это предоставить код для master/detail фильтрации данных. Это делается в событии `AfterScroll` в MasterTable и в событии `OnFilter` в DetailTable.
499473
500-Не забудьте установить для свойства `Filtered` DetailTable значение True.
501-```
474+Не забудьте установить для свойства `Filtered` DetailTable значение True.
475+
476+``` pascal
502477procedure TMainForm.MasterTableAfterScroll(DataSet: TDataSet);
503- begin
504- if vSuppressEvents=True then Exit;
505- DetailTable.Refresh;
506- end;
507-```
478+begin
479+ if vSuppressEvents=True then Exit;
480+ DetailTable.Refresh;
481+end;
508482```
483+
484+``` pascal
509485procedure 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;
486+ var Accept: Boolean);
487+begin
488+ if vSuppressEvents=True then Exit;
489+ // Показывем только дочерние поля, внешний ключ которых указывает на текущую
490+ // запись master таблицы
491+ Accept:=DataSet.FieldByName('MasterTableId').AsInteger=
492+ MasterTable.FieldByName('ID').AsInteger;
493+end;
518494```
519495
520496## Известные проблемы
521497
522-Есть несколько ограничений при использовании MemDatasets.
498+Есть несколько ограничений при использовании MemDatasets.
523499
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>.
500+- Метод locate не работает
501+- Фильтрация с использованием свойства Filter и Filtered не работает. Вы должны использовать жесткое кодирование в событии OnFilter.
502+- Повторное удаление записей кажется невероятно медленным. Поэтому я использую мою процедуру EmptyMemDataset вместо `while not EOF do Delete;`
503+- В FPC 2.6.x и более ранних версиях метод CopyFromDataSet копирует данные только с текущей позиции курсора в конец набора исходных данных. Итак, вы должны написать `MemDataset1.First;` перед `MemDataSet2.CopyFromDataSet(MemDataset1);`. Исправлено в транке ревизии FPC 26233.
504+ - Обратите внимание, что более старые версии FPC не имеют CopyFromDataset в Bufdataset, в то время как это - преимущество для MemDs.
505+ - См. багрепорт <http://bugs.freepascal.org/view.php?id=25426>.
530506
531507## TBufDataSet
532508
533-Как упоминалось ранее, в MemDataSet отсутствуют пользовательские фильтры, тип данных автоинкремента и метод Locate, поэтому взамен лучше использовать TBufDataSet. TBufDataset предоставляется модулем BufDataset.
509+Как упоминалось ранее, в MemDataSet отсутствуют пользовательские фильтры, тип данных автоинкремента и метод Locate, поэтому взамен лучше использовать TBufDataSet. TBufDataset предоставляется модулем BufDataset.
534510
535-Поскольку нет компонента для редактирования TBufDataSet во время разработки (но вы можете настроить определения полей во время разработки), вы можете создать пользовательский компонент-обертку или использовать его через код так же, как ClientDataSet в Delphi. Подробности смотрите в документации Delphi, касающейся наборов данных клиента для подробностей.
511+Поскольку нет компонента для редактирования TBufDataSet во время разработки (но вы можете настроить определения полей во время разработки), вы можете создать пользовательский компонент-обертку или использовать его через код так же, как ClientDataSet в Delphi. Подробности смотрите в документации Delphi, касающейся наборов данных клиента для подробностей.
536512
537-Вы можете использовать те же методы для обеспечения ссылочной целостности и первичных полей автоинкремента, как описано для MemDataSet.
513+Вы можете использовать те же методы для обеспечения ссылочной целостности и первичных полей автоинкремента, как описано для MemDataSet.
538514
539-Между MemDataSet и BufDataset есть только небольшие различия:
515+Между MemDataSet и BufDataset есть только небольшие различия:
540516
541-MemDataSet | BufDataset
542----|---
543-DataSet.ClearFields | DataSet.Fields.Clear
544-DataSet.CreateTable | DataSet.CreateDataSet
545-
517+| MemDataSet | BufDataset |
518+|---------------------|-----------------------|
519+| DataSet.ClearFields | DataSet.Fields.Clear |
520+| DataSet.CreateTable | DataSet.CreateDataSet |
521+
546522## Сортировка DBGrid по событию OnTitleClick для TBufDataSet
547523
548-Если вы хотите включить последовательную сортировку DBGrid по возрастанию и убыванию, показывающую некоторые данные из TBufDataSet, вы можете использовать следующий метод:
549-```
524+Если вы хотите включить последовательную сортировку DBGrid по возрастанию и убыванию, показывающую некоторые данные из TBufDataSet, вы можете использовать следующий метод:
525+
526+``` pascal
550527Uses
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;
528+ BufDataset, typinfo;
529+
530+function SortBufDataSet(DataSet: TBufDataSet;const FieldName: String): Boolean;
531+var
532+ i: Integer;
533+ IndexDefs: TIndexDefs;
534+ IndexName: String;
535+ IndexOptions: TIndexOptions;
536+ Field: TField;
537+begin
538+ Result := False;
539+ Field := DataSet.Fields.FindField(FieldName);
540+ //Если неверное имя поля, выйдем.
541+ if Field = nil then Exit;
542+ //Если неверный тип поля, выйдем.
543+ if {(Field is TObjectField) or} (Field is TBlobField) or
544+ {(Field is TAggregateField) or} (Field is TVariantField)
545+ or (Field is TBinaryField) then Exit;
546+ //Получаем IndexDefs и IndexName, используя RTTI
547+ if IsPublishedProp(DataSet, 'IndexDefs') then
548+ IndexDefs := GetObjectProp(DataSet, 'IndexDefs') as TIndexDefs
549+ else
550+ Exit;
551+ if IsPublishedProp(DataSet, 'IndexName') then
552+ IndexName := GetStrProp(DataSet, 'IndexName')
553+ else
554+ Exit;
555+ //Убедитесь, что IndexDefs об-нов-лен
556+ IndexDefs.Updated:=false; {<<<<---Эта строка имеет решающее значение, так как IndexDefs.Update ничего не будет делать при следующей сортировке, если она уже верна}
557+ IndexDefs.Update;
558+ //Если восходящий индекс уже используется,
559+ //переключаемся на нисходящий индекс
560+ if IndexName = FieldName + '__IdxA'
561+ then
560562 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);
563+ IndexName := FieldName + '__IdxD';
564+ IndexOptions := [ixDescending];
565+ end
566+ else
567+ begin
568+ IndexName := FieldName + '__IdxA';
569+ IndexOptions := [];
614570 end;
571+ //ищем существующий индекс
572+ for i := 0 to Pred(IndexDefs.Count) do
573+ begin
574+ if IndexDefs[i].Name = IndexName then
575+ begin
576+ Result := True;
577+ Break
578+ end; //if
579+ end; // for
580+ //Если существующий индекс не найден, создаем его
581+ if not Result then
582+ begin
583+ if IndexName=FieldName + '__IdxD' then
584+ DataSet.AddIndex(IndexName, FieldName, IndexOptions, FieldName)
585+ else
586+ DataSet.AddIndex(IndexName, FieldName, IndexOptions);
587+ Result := True;
588+ end; // if not
589+ //Устанавливаем индекс
590+ SetStrProp(DataSet, 'IndexName', IndexName);
591+end;
615592```
616593
617-Итак, вы можете вызвать эту функцию из DBGrid следующим образом:
618-```
594+Итак, вы можете вызвать эту функцию из DBGrid следующим образом:
595+
596+``` pascal
619597procedure TFormMain.DBGridProductsTitleClick(Column: TColumn);
620- begin
621- SortBufDataSet(Products, Column.FieldName);
622- end;
598+begin
599+ SortBufDataSet(Products, Column.FieldName);
600+end;
623601```
624602
625603## Сортировка нескольких столбцов в grid
626604
627-Я написал TDBGridHelper для сортировки grid по нескольким столбцам, удерживая клавишу Shift.
605+Я написал TDBGridHelper для сортировки grid по нескольким столбцам, удерживая клавишу Shift.
628606
629-![Light bulb](https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png) **Примечание:** MaxIndexesCount должен быть достаточно большим для TBufDataSet, потому что могут быть довольно большие комбинации возможных вариантов сортировки.
607+> **Note:** MaxIndexesCount должен быть достаточно большим для TBufDataSet, потому что могут быть довольно большие комбинации возможных вариантов сортировки.
630608
631-Но я думаю, что люди не будут использовать больше 10, поэтому установка 100 должна быть теоретически приемлемой.
632-```
609+Но я думаю, что люди не будут использовать больше 10, поэтому установка 100 должна быть теоретически приемлемой.
610+
611+``` pascal
612+ { TDBGridHelper }
613+
614+ TDBGridHelper = class helper for TDBGrid
615+ public const
616+ cMaxColCOunt = 3;
617+ private
618+ procedure Interbal_MakeNames(Fields: TStrings; out FieldsList, DescFields: String);
619+ procedure Internal_SetColumnsIcons(Fields: TStrings; AscIdx, DescIdx: Integer);
620+ function Internal_IndexNameExists(IndexDefs: TIndexDefs; IndexName: String): Boolean;
621+ public
622+ procedure Sort(const FieldName: String; AscIdx: Integer = -1; DescIdx: Integer = -1);
623+ procedure ClearSort;
624+ end;
625+
633626{ 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;
627+
628+procedure TDBGridHelper.Interbal_MakeNames(Fields: TStrings; out FieldsList, DescFields: String);
629+var
630+ FldList: TStringList;
631+ DscList: TStringList;
632+ FldDesc, FldName: String;
633+ i: Integer;
634+begin
635+ if Fields.Count = 0 then
636+ begin
637+ FieldsList := '';
638+ DescFields := '';
639+ Exit;
640+ end;
641+
642+ FldList := TStringList.Create;
643+ DscList := TStringList.Create;
644+ try
645+ FldList.Delimiter := ';';
646+ DscList.Delimiter := ';';
647+
648+ for i := 0 to Fields.Count - 1 do
708649 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
650+ Fields.GetNameValue(i, FldName, FldDesc);
651+ FldList.Add(FldName);
652+
653+ if FldDesc = 'D' then
654+ DscList.Add(FldName);
716655 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;
656+
657+ FieldsList := FldList.DelimitedText;
658+ DescFields := DscList.DelimitedText;
659+ finally
660+ FldList.Free;
661+ DscList.Free;
662+ end;
663+end;
664+
665+procedure TDBGridHelper.Internal_SetColumnsIcons(Fields: TStrings; AscIdx, DescIdx: Integer);
666+var
667+ i: Integer;
668+ FldDesc: String;
669+begin
670+ for i := 0 to Self.Columns.Count - 1 do
671+ begin
672+ FldDesc := Fields.Values[Self.Columns[i].Field.FieldName];
673+
674+ if FldDesc = 'A' then
675+ Self.Columns[i].Title.ImageIndex := AscIdx
676+ else
677+ if FldDesc = 'D' then
678+ Self.Columns[i].Title.ImageIndex := DescIdx
679+ else
680+ Self.Columns[i].Title.ImageIndex := -1
681+ end;
682+end;
683+
684+function TDBGridHelper.Internal_IndexNameExists(IndexDefs: TIndexDefs; IndexName: String): Boolean;
685+var
686+ i: Integer;
687+begin
688+ for i := 0 to IndexDefs.Count - 1 do
689+ begin
690+ if IndexDefs[i].Name = IndexName then
691+ Exit(True)
692+ end;
693+
694+ Result := False
695+end;
696+
697+procedure TDBGridHelper.Sort(const FieldName: String; AscIdx: Integer;
698+ DescIdx: Integer);
699+var
700+ Field: TField;
701+ DataSet: TBufDataset;
702+ IndexDefs: TIndexDefs;
703+ IndexName, Dir, DescFields, FieldsList: String;
704+ Fields: TStringList;
705+begin
706+ if not Assigned(DataSource.DataSet) or
707+ not DataSource.DataSet.Active or
708+ not (DataSource.DataSet is TBufDataset) then
709+ Exit;
710+ DataSet := DataSource.DataSet as TBufDataset;
711+
712+ Field := DataSet.FieldByName(FieldName);
713+ if (Field is TBlobField) or (Field is TVariantField) or (Field is TBinaryField) then
714+ Exit;
715+
716+ IndexDefs := DataSet.IndexDefs;
717+ IndexName := DataSet.IndexName;
718+
719+ if not IndexDefs.Updated then
720+ IndexDefs.Update;
721+
722+ Fields := TStringList.Create;
723+ try
724+ Fields.DelimitedText := IndexName;
725+ Dir := Fields.Values[FieldName];
726+
727+ if Dir = 'A' then
728+ Dir := 'D'
729+ else
730+ if Dir = 'D' then
731+ Dir := 'A'
732+ else
733+ Dir := 'A';
734+
735+ //Если нажата клавиша Shift, добавляем поле в список полей.
736+ if ssShift in GetKeyShiftState then
726737 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
738+ Fields.Values[FieldName] := Dir;
739+ //Мы не добавляем в сортировку больше полей, если общее количество полей превышает cMaxColCOunt
740+ if Fields.Count > cMaxColCOunt then
735741 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;
742+ end
743+ else
744+ begin
745+ Fields.Clear;
746+ Fields.Values[FieldName] := Dir;
782747 end;
783-
784- procedure TDBGridHelper.ClearSort;
785- var
786- DataSet: TBufDataset;
787- Fields: TStringList;
748+
749+ IndexName := Fields.DelimitedText;
750+ if not Internal_IndexNameExists(IndexDefs, IndexName) then
788751 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
752+ Interbal_MakeNames(Fields, FieldsList, DescFields);
753+ TBufDataset(DataSet).AddIndex(IndexName, FieldsList, [], DescFields, '');
803754 end;
804-```
805755
806-Чтобы использовать сортировку, нужно вызвать вспомогательные методы в OnCellClick и onTitleClick. OnTitleClick - если вы удерживаете клавишу shift, добавляется новый столбец в список сортировки, или меняется направление сортировки выбранного столбца, или просто сортируется один столбец. OnCellClick - если дважды щелкнуть ячейку [0, 0], сетка очищает ее сортировку.
756+ DataSet.IndexName := IndexName;
757+ Internal_SetColumnsIcons(Fields, AscIdx, DescIdx)
758+ finally
759+ Fields.Free;
760+ end;
761+end;
762+
763+procedure TDBGridHelper.ClearSort;
764+var
765+ DataSet: TBufDataset;
766+ Fields: TStringList;
767+begin
768+ if not Assigned(DataSource.DataSet) or
769+ not DataSource.DataSet.Active or
770+ not (DataSource.DataSet is TBufDataset) then
771+ Exit;
772+ DataSet := DataSource.DataSet as TBufDataset;
773+
774+ DataSet.IndexName := '';
775+
776+ Fields := TStringList.Create;
777+ try
778+ Internal_SetColumnsIcons(Fields, -1, -1)
779+ finally
780+ Fields.Free
781+ end
782+end;
807783```
784+
785+Чтобы использовать сортировку, нужно вызвать вспомогательные методы в OnCellClick и onTitleClick. OnTitleClick - если вы удерживаете клавишу shift, добавляется новый столбец в список сортировки, или меняется направление сортировки выбранного столбца, или просто сортируется один столбец. OnCellClick - если дважды щелкнуть ячейку \[0, 0\], сетка очищает ее сортировку.
786+
787+``` pascal
808788procedure 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;
789+begin
790+ if not Assigned(Column) then
791+ grdCountries.ClearSort
792+end;
793+
794+procedure TForm1.grdCountriesTitleClick(Column: TColumn);
795+begin
796+ grdCountries.Sort(Column.Field.FieldName, 0, 1);
797+end;
818798```
819799
820-Если вы назначили TitleImageList, вы можете указать, какое изображение использовать для восходящей, а какое для нисходящей сортировки.
800+Если вы назначили TitleImageList, вы можете указать, какое изображение использовать для восходящей, а какое для нисходящей сортировки.
821801
822802## ZMSQL
823803
824-Другой, часто лучший способ написания баз данных в памяти - это использование пакета ZMSQL:
804+Другой, часто лучший способ написания баз данных в памяти - это использование пакета ZMSQL:
825805
826- * [[ZMSQL]]
827- * <http://sourceforge.net/projects/lazarus-ccr/files/zmsql/>
828- * <http://www.lazarus.freepascal.org/index.php/topic,13821.30.html>
806+- [[ZMSQL]]
807+- [<http://sourceforge.net/projects/lazarus-ccr/files/zmsql/>](http://sourceforge.net/projects/lazarus-ccr/files/zmsql/)
808+- [<http://www.lazarus.freepascal.org/index.php/topic,13821.30.html>](http://www.lazarus.freepascal.org/index.php/topic,13821.30.html)
829809
830810## Авторство
831811
832-Оригинальный текст написан: Zlatko Matić (matalab@gmail.com)
812+Оригинальный текст написан: Zlatko Matić (matalab@gmail.com)
833813
834-Вклад других авторов, как показано на странице History.
814+Вклад других авторов, как показано на странице History.\
835815
836816---
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).*
817+*From the Free Pascal wiki, page "How to write in-memory database applications in Lazarus/FPC/ru", as it stood on 2019-10-19 after a change by Zoltanleo, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*

Back to history