Difference between revisions of "How to write in-memory database applications in Lazarus/FPC/ru"

From Lazarus wiki
Jump to navigationJump to search
(Created page with "{{How_to_write_in-memory_database_applications_in_Lazarus/FPC}} {{Infobox databases/ru}} == Introduction == There are certain circumstances when in-memory datasets make sense....")
 
 
(21 intermediate revisions by 2 users not shown)
Line 1: Line 1:
 
{{How_to_write_in-memory_database_applications_in_Lazarus/FPC}}
 
{{How_to_write_in-memory_database_applications_in_Lazarus/FPC}}
{{Infobox databases/ru}}
+
{{Infobox databases}}
== Introduction ==
+
== Введение ==
There are certain circumstances when in-memory datasets make sense. If you need a fast, single-user, non mission-critical, non SQL database, without need for transactions, [[TMemDataset]] could suit your needs.
+
Существуют определенные обстоятельства, когда наборы данных в памяти имеют смысл. Если вам нужна быстрая, однопользовательская, не критически важная база данных, отличная от SQL, без транзакций, [[TMemDataset]] может удовлетворить ваши потребности.
  
Some benefits are:  
+
Некоторые преимущества:  
* Fast execution. Since all processing is done in memory, no data is saved on hard disk until explicitly asked. Memory is surely faster than hard disk.
+
* Быстрое выполнение. Поскольку вся обработка выполняется в памяти, данные не сохраняются на жестком диске до тех пор, пока это не будет задано явно. Память, безусловно, быстрее, чем жесткий диск.  
* No need for external libraries (no .so or .dll files), no need for server installation
+
* Нет необходимости во внешних библиотеках (нет файлов .so или .dll), нет необходимости в установке сервера.
* Code is multiplatform and can be compiled on any OS instantly
+
* Код является мультиплатформенным и может быть скомпилирован в любой ОС.
* Since all programming is done in Lazarus/FPC, such applications are easier for maintenance. Instead of constantly switching from back-end programming to front-end programming, by using MemDatasets you can concentrate on your Pascal code.
+
* Поскольку все программирование выполняется в Lazarus/FPC, такие приложения проще в обслуживании. Вместо того, чтобы постоянно переключаться с внутреннего программирования на внешнее, используя MemDatasets, вы можете сосредоточиться на своем коде Pascal.
  
{{Note|later on in this article, BufDataset is introduced. [[TBufDataset]] often is a better choice than [[TMemDataset]] }}
+
{{Note|позже в этой статье будет представлен BufDataset. [[TBufDataset]] часто является лучшим выбором, чем [[TMemDataset]]}}
  
I will illustrate how to program relational non-SQL memory databases, focusing on enforcing relation integrity and filtering, simulating auto-increment primary fields and similar.  
+
Я проиллюстрирую, как программировать реляционные не-SQL базы данных в памяти, сосредоточив внимание на обеспечении целостности отношений и фильтрации, моделировании основных полей с автоинкрементом и т.п.  
  
This page shares with you what I have learned experimenting with TMemDatasets. There might be some other, more efficient way to do this. If so, please, feel free to contribute to this document for the benefit of the Lazarus/FPC community.
+
Эта страница поделится с вами тем, что я узнал, экспериментируя с TMemDatasets. Возможно даже, что есть какой-то другой, более эффективный способ сделать это. Если это так, пожалуйста, не стесняйтесь вносить свой вклад в этот документ в интересах сообщества Lazarus/FPC.  
  
The memds unit provides TMemDataset, so you will need to add that to your uses clause.
+
Модуль memds предоставляет TMemDataset, так что вам нужно будет добавить его в раздел uses вашего проекта.
  
== Saving MemDatasets to persistent files ==
+
== Сохранение MemDataset в постоянные файлы ==
In the [[Interface|interface]] part of your code, declare an array type for storing information about all the TMemDataSets that you want to make persistent at the end of a session and restore at the beginning of the next session. You have to declare a variable of type TSaveTables, too.
+
В [[Interface|интерфейсной]] части вашего кода объявите тип массива для хранения информации обо всех TMemDataSets, которые вы хотите сделать постоянными в конце сеанса и восстановить в начале следующего сеанса. Вы также должны объявить переменную типа TSaveTables.
  
I also use a global variable vSuppressEvents of type boolean, for suppressing Dataset events used for referential integrity enforcement, during data restore.
+
Я также использую глобальную переменную vSuppressEvents типа boolean для подавления событий Dataset, используемых для обеспечения ссылочной целостности, во время восстановления данных.  
  
You get this:
+
Вот, что у вас должно получиться:
<syntaxhighlight>type
+
<syntaxhighlight lang=pascal>type
 
   TSaveTables=array[1..15] of TMemDataset;     
 
   TSaveTables=array[1..15] of TMemDataset;     
 
var
 
var
   //Global variable that holds tables for saving/restoring session
+
   //Глобальная переменная, которая хранит таблицы для сохранения/восстановления сеанса работы
 
   vSaveTables:TSaveTables;                   
 
   vSaveTables:TSaveTables;                   
   //Suppress events flag variables. Used during data loading from files.
+
   //Переменная-флаг подавления событий датасета. Используется при загрузке данных из файлов.
 
   vSuppressEvents:Boolean;</syntaxhighlight>   
 
   vSuppressEvents:Boolean;</syntaxhighlight>   
  
Instead of using global variables like I did, you could make them a property of the main form, also.
+
Вместо того, чтобы использовать глобальные переменные, как это сделал, например, я, вы также можете сделать их свойством главной формы. TMemDataset имеет способ хранения данных в постоянном файле: метод SaveToFile. Но вы, возможно, захотите сохранить данные в файлы [[CSV]] для упрощения работы с ними в дальнейшем. Поэтому я объединю оба способа в одни и те же процедуры.
TMemDataset has a way to natively store data to persistent file: the SaveToFile method. But, you could rather choose to save data to [[CSV]] files for easier external post processing. Therefore, I will combine both ways into same procedures.
+
 
I define a constant cSaveRestore in the Interface part, by which I can define whether data will be stored and loaded as native MemDataset files or CSV files.
+
Я задаю константу cSaveRestore в интерфейсной части модуля, с помощью которой я могу определить, будут ли данные храниться и загружаться как нативные файлы MemDataset, или как файлы CSV.
<syntaxhighlight>const
+
<syntaxhighlight lang=pascal>const
   //Constant cSaveRestore determines the way for saving and restoring of MemDatasets to persistent files
+
   //Константа cSaveRestore определяет способ сохранения и восстановления MemDataset в постоянные файлы.
   cSaveRestore=0; //0=MemDataset native way, 1=saving and restoring from CSV                              
+
   cSaveRestore=0; //0=собственный формат MemDataset, 1=сохранение и восстановление из CSV                            
 
</syntaxhighlight>
 
</syntaxhighlight>
 
    
 
    
Now, you can save MemDatasets on FormClose event and load them on FormCreate event. Instantiate elements of the array of MemDatasets on the FormCreate event, too.
+
Теперь вы можете сохранить MemDataset'ы в событии OnFormClose и загрузить их в событие OnFormCreate. Заполнить элементы массива экземплярами MemDataset можно также в событии OnFormCreate.
  
<syntaxhighlight>procedure TMainForm.FormCreate(Sender: TObject);
+
<syntaxhighlight lang=pascal>procedure TMainForm.FormCreate(Sender: TObject);
 
begin
 
begin
   //List of tables to be saved/restored for a session
+
   //Список таблиц, которые будут сохранены/восстановлены для сеанса работы
 
   vSaveTables[1]:=Products;
 
   vSaveTables[1]:=Products;
 
   vSaveTables[2]:=Boms;
 
   vSaveTables[2]:=Boms;
Line 60: Line 60:
 
   vSaveTables[14]:=ImportFromTables;
 
   vSaveTables[14]:=ImportFromTables;
 
   vSaveTables[15]:=ImportFromFields;
 
   vSaveTables[15]:=ImportFromFields;
   //Restore session
+
   //Восстанавливаем сеанс работы
 
   RestoreSession;
 
   RestoreSession;
 
   GetAutoincrementPrimaryFields;
 
   GetAutoincrementPrimaryFields;
 
end;</syntaxhighlight>
 
end;</syntaxhighlight>
  
<syntaxhighlight>procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
+
<syntaxhighlight lang=pascal>procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
 
begin
 
begin
  //Save memdatasets to files (to save current session)
+
  //Сохраняем наборы данных в файлы (чтобы сохранить текущий сеанс)
 
  SaveSession;
 
  SaveSession;
 
end;</syntaxhighlight>
 
end;</syntaxhighlight>
  
<syntaxhighlight>procedure RestoreSession;
+
<syntaxhighlight lang=pascal>procedure RestoreSession;
 
var
 
var
 
   I:Integer;
 
   I:Integer;
 
begin
 
begin
 
   try
 
   try
     MemoMessages.Append(TimeToStr(Now())+' Starting restoration of previously saved session.');
+
     MemoMessages.Append(TimeToStr(Now())+' Начало восстановления ранее сохраненного сеанса.');
     vSuppressEvents:=True; //Supress events used for referential integrity enforcing
+
     vSuppressEvents:=True; //Подавляем события, используемые для обеспечения ссылочной целостности
     //Disable controls and refresh all datasets
+
     //Отключаем элементы управления и обновляем все наборы данных
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
 
       vSaveTables[I].DisableControls;
 
       vSaveTables[I].DisableControls;
       vSaveTables[I].Refresh; //Important if dataset was filtered
+
       vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован
 
     end;
 
     end;
     //Load memdatasets from files (to restore previous session)
+
     //Загружаем memdataset'ы из файлов (для восстановления предыдущего сеанса)
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
 
       vSaveTables[I].First;
 
       vSaveTables[I].First;
       MemoMessages.Append(TimeToStr(Now())+' Starting restoration of table: '+vSaveTables[I].Name);
+
       MemoMessages.Append(TimeToStr(Now())+' Начинаем восстановление таблицы: '+vSaveTables[I].Name);
 
       try
 
       try
         //If data is loaded from a csv file, then table must be deleted first.
+
         //Если данные загружаются из CSV-файла, то сначала необходимо удалить таблицу.
 
         if cSaveRestore=1 then begin
 
         if cSaveRestore=1 then begin
           MemoMessages.Append(TimeToStr(Now())+' Starting delete of all records in table: '+vSaveTables[I].Name);
+
           MemoMessages.Append(TimeToStr(Now())+' Начинаем удаление всех записей в таблице: '+vSaveTables[I].Name);
           //This way of deleting all records is incredibly slow.
+
           //Этот способ удаления всех записей невероятно медленный.
 
           {while not vSaveTables[I].EOF do begin
 
           {while not vSaveTables[I].EOF do begin
 
             vSaveTables[I].Delete;
 
             vSaveTables[I].Delete;
 
           end;}
 
           end;}
           //This method for deleting of all records is much faster
+
           //Этот метод для удаления всех записей намного быстрее
 
           EmptyMemDataSet(vSaveTables[I]);
 
           EmptyMemDataSet(vSaveTables[I]);
           MemoMessages.Append(TimeToStr(Now())+' All records from table: '+vSaveTables[I].Name+' deleted.');
+
           MemoMessages.Append(TimeToStr(Now())+' Все записи из таблицы: '+vSaveTables[I].Name+' удалены.');
 
         end;
 
         end;
 
       except
 
       except
 
         on E:Exception do begin
 
         on E:Exception do begin
           MemoMessages.Append(TimeToStr(Now())+' Error while deleteing records from table: '+vSaveTables[I].Name +'. '+E.Message);
+
           MemoMessages.Append(TimeToStr(Now())+' Ошибка при удалении записей из таблицы: '+vSaveTables[I].Name +'. '+E.Message);
 
         end;
 
         end;
 
       end;
 
       end;
 
       try
 
       try
 
         try
 
         try
           MemoMessages.Append(TimeToStr(Now())+' Restoring table: '+vSaveTables[I].Name);
+
           MemoMessages.Append(TimeToStr(Now())+' Восстановление таблицы: '+vSaveTables[I].Name);
           //Check constant for way of saving/restoring data and load saved session
+
           //Проверяем константу для выбора способа сохранения/восстановления данных и загрузки сохраненного сеанса
 
           case cSaveRestore of
 
           case cSaveRestore of
 
             0:vSaveTables[I].LoadFromFile(vSaveTables[I].Name);
 
             0:vSaveTables[I].LoadFromFile(vSaveTables[I].Name);
Line 114: Line 114:
 
         except
 
         except
 
           on E:Exception do begin
 
           on E:Exception do begin
             MemoMessages.Append(TimeToStr(Now())+' Error while restoring table: '+vSaveTables[I].Name +'. '+E.Message);
+
             MemoMessages.Append(TimeToStr(Now())+' Ошибка при восстановлении таблицы: '+vSaveTables[I].Name +'. '+E.Message);
 
           end;
 
           end;
 
         end;
 
         end;
 
       finally
 
       finally
         vSaveTables[I].Active:=True;//Needed because of LoadFromFile method....
+
         vSaveTables[I].Active:=True;//Требуется из-за метода LoadFromFile....
 
       end;
 
       end;
       MemoMessages.Append(TimeToStr(Now())+' Table: '+vSaveTables[I].Name+' restored.');
+
       MemoMessages.Append(TimeToStr(Now())+' Таблица: '+vSaveTables[I].Name+' восстановлена.');
 
     end;
 
     end;
 
   finally
 
   finally
 
     vSuppressEvents:=False;
 
     vSuppressEvents:=False;
     //Refresh all datasets  and enable controls
+
     //Обновляем все наборы данных и включаем элементы управления
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
       vSaveTables[I].Refresh; //Needed for tables that are filtered.
+
       vSaveTables[I].Refresh; //Необходимо для таблиц, которые фильтруются.
 
       vSaveTables[I].EnableControls;
 
       vSaveTables[I].EnableControls;
 
     end;
 
     end;
     MemoMessages.Append(TimeToStr(Now())+' All tables restored from saved files.');
+
     MemoMessages.Append(TimeToStr(Now())+' Все таблицы восстановлены из сохраненных файлов.');
 
   end;
 
   end;
 
end;</syntaxhighlight>
 
end;</syntaxhighlight>
  
<syntaxhighlight>procedure SaveSession;
+
<syntaxhighlight lang=pascal>procedure SaveSession;
 
var
 
var
 
   I:Integer;
 
   I:Integer;
 
begin
 
begin
 
   try
 
   try
     MemoMessages.Append(TimeToStr(Now())+' Starting saving session to persistent files.');
+
     MemoMessages.Append(TimeToStr(Now())+' Начало сохранения сеанса в постоянные файлы.');
 
     vSuppressEvents:=True;
 
     vSuppressEvents:=True;
     //Disable controls and refresh all datasets
+
     //Отключаем элементы управления и обновляем все наборы данных
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
 
       vSaveTables[I].DisableControls;
 
       vSaveTables[I].DisableControls;
       vSaveTables[I].Refresh; //Important if dataset was filtered
+
       vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован
 
     end;
 
     end;
     //Save session to file
+
     //Сохраняем сеанс работы в файл
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
 
       vSaveTables[I].First;
 
       vSaveTables[I].First;
       MemoMessages.Append(TimeToStr(Now())+' Saving table: '+vSaveTables[I].Name);
+
       MemoMessages.Append(TimeToStr(Now())+' Сохранение таблицы: '+vSaveTables[I].Name);
 
       try
 
       try
         //Check constant for way of saving/restoring data and save session
+
         //Проверяем константу для выбора способа сохранения/восстановления данных и загрузки сохраненного сеанса
 
         case cSaveRestore of
 
         case cSaveRestore of
 
           0:vSaveTables[I].SaveToFile(vSaveTables[I].Name);
 
           0:vSaveTables[I].SaveToFile(vSaveTables[I].Name);
Line 157: Line 157:
 
       except
 
       except
 
         on E:Exception do begin
 
         on E:Exception do begin
           MemoMessages.Append(TimeToStr(Now())+' Error while saving table: '+vSaveTables[I].Name +'. '+E.Message);
+
           MemoMessages.Append(TimeToStr(Now())+' Ошибка при сохранении таблицы: '+vSaveTables[I].Name +'. '+E.Message);
 
         end;
 
         end;
 
       end;
 
       end;
       MemoMessages.Append(TimeToStr(Now())+' Table: '+vSaveTables[I].Name+' saved.');
+
       MemoMessages.Append(TimeToStr(Now())+' Таблица: '+vSaveTables[I].Name+' сохранена.');
 
     end;
 
     end;
 
   finally
 
   finally
 
     vSuppressEvents:=False;
 
     vSuppressEvents:=False;
     //Refresh all datasets  and enable controls
+
     //Обновляем все наборы данных и включаем элементы управления
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
       vSaveTables[I].Refresh; //Needed for tables that are filtered
+
       vSaveTables[I].Refresh; //Необходимо для таблиц, которые фильтруются
 
       vSaveTables[I].EnableControls;
 
       vSaveTables[I].EnableControls;
 
     end;
 
     end;
     MemoMessages.Append(TimeToStr(Now())+' All tables saved to files.');
+
     MemoMessages.Append(TimeToStr(Now())+' Все таблицы сохранены в файлы.');
 
   end;
 
   end;
 
end;</syntaxhighlight>     
 
end;</syntaxhighlight>     
  
<syntaxhighlight>procedure EmptyMemDataSet(DataSet:TMemDataSet);
+
<syntaxhighlight lang=pascal>procedure EmptyMemDataSet(DataSet:TMemDataSet);
 
var
 
var
 
   vTemporaryMemDataSet:TMemDataSet;
 
   vTemporaryMemDataSet:TMemDataSet;
Line 180: Line 180:
 
begin
 
begin
 
   try
 
   try
     //Create temporary MemDataSet
+
     //Создаем временный MemDataSet
 
     vTemporaryMemDataSet:=TMemDataSet.Create(nil);
 
     vTemporaryMemDataSet:=TMemDataSet.Create(nil);
     //Store FieldDefs to Temporary MemDataSet
+
     //Сохраняем FieldDefs во временном MemDataSet
 
     for I:=0 to DataSet.FieldDefs.Count-1 do begin
 
     for I:=0 to DataSet.FieldDefs.Count-1 do begin
 
       vFieldDef:=vTemporaryMemDataSet.FieldDefs.AddFieldDef;
 
       vFieldDef:=vTemporaryMemDataSet.FieldDefs.AddFieldDef;
Line 192: Line 192:
 
       end;
 
       end;
 
     end;
 
     end;
     //Clear existing fielddefs
+
     //Очищаем существующие fielddefs
 
     DataSet.Clear;
 
     DataSet.Clear;
     //Restore fielddefs
+
     //Восстанавливаем fielddefs
 
     DataSet.FieldDefs:=vTemporaryMemDataSet.FieldDefs;
 
     DataSet.FieldDefs:=vTemporaryMemDataSet.FieldDefs;
 
     DataSet.Active:=True;
 
     DataSet.Active:=True;
Line 203: Line 203:
 
end;</syntaxhighlight>
 
end;</syntaxhighlight>
  
<syntaxhighlight>procedure LoadFromCsv(DataSet:TDataSet);
+
<syntaxhighlight lang=pascal>procedure LoadFromCsv(DataSet:TDataSet);
 
var
 
var
 
   vFieldCount:Integer;
 
   vFieldCount:Integer;
Line 209: Line 209:
 
begin
 
begin
 
   try
 
   try
     //Assign SdfDataSetTemporary
+
     //Назначаем SdfDataSetTemporary
 
     with SdfDataSetTemporary do begin
 
     with SdfDataSetTemporary do begin
 
       Active:=False;
 
       Active:=False;
Line 216: Line 216:
 
       FirstLineAsSchema:=True;
 
       FirstLineAsSchema:=True;
 
       Active:=True;
 
       Active:=True;
       //Determine number of fields
+
       //Определяем количество полей
 
       vFieldCount:=FieldDefs.Count;
 
       vFieldCount:=FieldDefs.Count;
 
     end;
 
     end;
     //Iterate through SdfDataSetTemporary and insert records into MemDataSet
+
     //Выполняем итерацию по SdfDataSetTeditional и вставляем записи в MemDataSet.
 
     SdfDataSetTemporary.First;
 
     SdfDataSetTemporary.First;
 
     while not SdfDataSetTemporary.EOF do begin
 
     while not SdfDataSetTemporary.EOF do begin
 
       DataSet.Append;
 
       DataSet.Append;
       //Iterate through FieldDefs
+
       //Итерация по FieldDefs
 
       for I:=0 to vFieldCount-1 do begin
 
       for I:=0 to vFieldCount-1 do begin
 
         try
 
         try
Line 229: Line 229:
 
         except
 
         except
 
           on E:Exception do begin
 
           on E:Exception do begin
             MemoMessages.Append(TimeToStr(Now())+' Error while setting value for field: '
+
             MemoMessages.Append(TimeToStr(Now())+' Ошибка при установке значения для поля: '
 
             +DataSet.Name+'.'+DataSet.Fields[I].Name +'. '+E.Message);
 
             +DataSet.Name+'.'+DataSet.Fields[I].Name +'. '+E.Message);
 
           end;
 
           end;
Line 238: Line 238:
 
       except
 
       except
 
         on E:Exception do begin
 
         on E:Exception do begin
           MemoMessages.Append(TimeToStr(Now())+' Error while posting record to table: '
+
           MemoMessages.Append(TimeToStr(Now())+' Ошибка при сохранении записи в таблицу: '
 
           +DataSet.Name+'.'+E.Message);
 
           +DataSet.Name+'.'+E.Message);
 
         end;
 
         end;
Line 250: Line 250:
 
end;</syntaxhighlight>
 
end;</syntaxhighlight>
  
<syntaxhighlight>procedure SaveToCsv(DataSet:TDataSet);
+
<syntaxhighlight lang=pascal>procedure SaveToCsv(DataSet:TDataSet);
 
var
 
var
 
   myFileName:string;
 
   myFileName:string;
Line 258: Line 258:
 
begin
 
begin
 
   myFileName:=DataSet.Name+'.txt';
 
   myFileName:=DataSet.Name+'.txt';
   //create a new file
+
   //создаем новый файл
 
   AssignFile(myTextFile, myFileName);
 
   AssignFile(myTextFile, myFileName);
 
   Rewrite(myTextFile);
 
   Rewrite(myTextFile);
   s := ''; //initialize empty string
+
   s := ''; //инициализируем пустую строку
 
   try
 
   try
     //write field names (as column headers)
+
     //записываем имена полей (как заголовки столбцов)
 
     for i := 0 to DataSet.Fields.Count - 1 do
 
     for i := 0 to DataSet.Fields.Count - 1 do
 
       begin
 
       begin
Line 270: Line 270:
 
     Writeln(myTextFile, s);
 
     Writeln(myTextFile, s);
 
     DataSet.First;
 
     DataSet.First;
     //write field values
+
     //записываем значения полей
 
     while not DataSet.Eof do
 
     while not DataSet.Eof do
 
       begin
 
       begin
Line 276: Line 276:
 
         for i := 0 to DataSet.FieldCount - 1 do
 
         for i := 0 to DataSet.FieldCount - 1 do
 
           begin
 
           begin
             //Numerical fields without quotes, string fields with quotes
+
             //Числовые поля без кавычек, строковые поля с кавычками
 
             if ((DataSet.FieldDefs[i].DataType=ftInteger)
 
             if ((DataSet.FieldDefs[i].DataType=ftInteger)
 
             or (DataSet.FieldDefs[i].DataType=ftFloat)) then
 
             or (DataSet.FieldDefs[i].DataType=ftFloat)) then
Line 291: Line 291:
 
end;</syntaxhighlight>
 
end;</syntaxhighlight>
  
== Autoincrement Primary Keys ==
+
== Автогенератор первичных ключей ==
  
Autoincrement field type is not supported by MemDataset. Nevertheless, you can imitate it by using Integer field type and providing a calculator for autoincrement fields.
+
Тип поля Autoincrement не поддерживается MemDataset. Тем не менее, вы можете имитировать его, используя тип поля Integer и предоставляя калькулятор для полей автогенератора. Нам нужны глобальные переменные или открытые свойства для хранения текущего значения поля автогенератора. Я предпочитаю глобальные переменные, объявленные в интерфейсной части модуля.
We need global variables or public properties for storing current autoincrement field value. I prefer global variables, declared in Interface part.
+
<syntaxhighlight lang=pascal>var
<syntaxhighlight>var
+
   //Глобальные переменные, используемые для вычисления полей автогенератора первичного ключа MemDatasets
   //Global variables used for calculation of autoincrement primary key fields of MemDatasets
 
 
   vCurrentId:Integer=0;
 
   vCurrentId:Integer=0;
 
   vProductsId:Integer=0;
 
   vProductsId:Integer=0;
Line 313: Line 312:
 
   vImportFromTablesId:Integer=0;
 
   vImportFromTablesId:Integer=0;
 
   vImportFromFieldsId:Integer=0;</syntaxhighlight>
 
   vImportFromFieldsId:Integer=0;</syntaxhighlight>
Then we have a procedure for autoincrement field values calculation:
+
Тогда у нас есть процедура для расчета значений полей автогенератора:
  
<syntaxhighlight>procedure GetAutoincrementPrimaryFields;
+
<syntaxhighlight lang=pascal>procedure GetAutoincrementPrimaryFields;
 
var
 
var
 
   I:Integer;
 
   I:Integer;
Line 321: Line 320:
 
begin
 
begin
 
   try
 
   try
     MemoMessages.Lines.Append(TimeToStr(Now())+' Getting information about autoincrement fields');
+
     MemoMessages.Lines.Append(TimeToStr(Now())+' Получение информации о полях автогенератора');
 
     vSuppressEvents:=True;
 
     vSuppressEvents:=True;
     //Disable controls and refresh all datasets
+
     //Отключаем элементы управления и обновляем все наборы данных
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
 
       vSaveTables[I].DisableControls;
 
       vSaveTables[I].DisableControls;
       vSaveTables[I].Refresh; //Important if dataset was filtered
+
       vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован
 
     end;
 
     end;
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
 
       with vSaveTables[I] do begin
 
       with vSaveTables[I] do begin
         //Use appropriate global variable
+
         //Используем соответствующую глобальную переменную
 
         case StringToCaseSelect(Name,
 
         case StringToCaseSelect(Name,
 
           ['Products','Boms','Stocks','Orders',
 
           ['Products','Boms','Stocks','Orders',
Line 353: Line 352:
 
         end;
 
         end;
 
         try
 
         try
           //Find last value of Id and save it to global variable
+
           //Находим последнее значение ID и сохраняем его в глобальной переменной
 
           Last;
 
           Last;
 
           vCurrentId:=FieldByName(Name+'Id').AsInteger;
 
           vCurrentId:=FieldByName(Name+'Id').AsInteger;
 
           if (vCurrentId>vId^) then vId^:=vCurrentId;
 
           if (vCurrentId>vId^) then vId^:=vCurrentId;
 
         finally
 
         finally
           //Remove reference;
+
           //Удаляем ссылку
 
           vId:=nil;
 
           vId:=nil;
 
         end;
 
         end;
Line 365: Line 364:
 
   finally
 
   finally
 
     vSuppressEvents:=False;
 
     vSuppressEvents:=False;
     //Refresh all datasets  and enable controls
+
     //Обновляем все наборы данных и включаем элементы управления
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
 
     for I:=Low(vSaveTables) to High(vSaveTables) do begin
 
       vSaveTables[I].Refresh;
 
       vSaveTables[I].Refresh;
 
       vSaveTables[I].EnableControls;
 
       vSaveTables[I].EnableControls;
 
     end;
 
     end;
     MemoMessages.Lines.Append(TimeToStr(Now())+' Autoincrement fields - done.');
+
     MemoMessages.Lines.Append(TimeToStr(Now())+' Автоинкрементные поля - готовы.');
 
   end;
 
   end;
 
end;</syntaxhighlight>
 
end;</syntaxhighlight>
  
<syntaxhighlight>function StringToCaseSelect(Selector:string;CaseList:array of string):Integer;
+
<syntaxhighlight lang=pascal>function StringToCaseSelect(Selector:string;CaseList:array of string):Integer;
 
var  
 
var  
 
   cnt: integer;
 
   cnt: integer;
Line 389: Line 388:
 
end;</syntaxhighlight>
 
end;</syntaxhighlight>
  
The GetAutoincrementPrimaryFields procedure is called every time after you restore (load) data from persistent files, in order to load last autoincrement values into global variables (or properties, as you prefer).
+
Процедура <tt>GetAutoincrementPrimaryFields</tt> вызывается каждый раз после восстановления (загрузки) данных из постоянных файлов, чтобы загрузить последние значения автогенератора в глобальные переменные (или свойства, как вы предпочитаете). Автоинкрементация выполняется в событии OnNewRecord каждого MemDataset. Например, для таблицы Orders MemDataset:
Autoincrementing is done in OnNewRecord event of every MemDataset. For example, for MemDataset Orders:
 
  
<syntaxhighlight>procedure TMainForm.OrdersNewRecord(DataSet: TDataSet);
+
<syntaxhighlight lang=pascal>procedure TMainForm.OrdersNewRecord(DataSet: TDataSet);
 
begin
 
begin
   if vSuppressEvents=True then Exit;
+
   if vSuppressEvents then Exit;
   //Set new autoincrement value
+
   //Устанавливаем новое значение автогенератора
 
   vOrdersId:=vOrdersId+1;
 
   vOrdersId:=vOrdersId+1;
 
   DataSet.FieldByName('OrdersId').AsInteger:=vOrdersId;
 
   DataSet.FieldByName('OrdersId').AsInteger:=vOrdersId;
 
end;</syntaxhighlight>
 
end;</syntaxhighlight>
  
As already explained, I use vSuppressEvents global variable as flag for the case of restoring data from persistent files.
+
Как уже объяснялось, я использую глобальную переменную vSuppressEvents в качестве флага для случая восстановления данных из постоянных файлов.
  
== Enforcing Referential Integrity ==
+
== Обеспечение ссылочной целостности ==
There is no enforced referential integrity implemented in MemDataset component, so you have to do it on your own.
+
В компоненте MemDataset встроенная ссылочная целостность не реализована, поэтому вы должны сделать это самостоятельно.
  
Let's assume we have two tables: MasterTable and DetailTable.
+
Предположим, у нас есть две таблицы: MasterTable и DetailTable.  
  
There are various places where referential integrity code needs to be used:
+
Существуют различные места, где необходимо использовать код ссылочной целостности:
* Insert/Update code is located in the <code>BeforePost</code> event of the DetailTable: before a new/updated detail record is posted/saved, it needs to be checked for meeting referential integrity requirements
+
* Код вставки/обновления находится в событии <code>BeforePost</code> DetailTable: перед сохранением новой/обновленной detail-записи ее необходимо проверить на соответствие требованиям ссылочной целостности
* Delete code is located in the <code>BeforeDelete</code> event of the MasterTable: before a master record is deleted, it needs to make sure any child records meet referential integrity requirements
+
* Код удаления находится в событии <code>BeforeDelete</code> в MasterTable: перед удалением master-записи необходимо убедиться, что все дочерние записи соответствуют требованиям ссылочной целостности
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
procedure TMainForm.MasterTableBeforeDelete(DataSet: TDataSet);
 
procedure TMainForm.MasterTableBeforeDelete(DataSet: TDataSet);
 
begin
 
begin
   if vSuppressEvents=True then Exit;
+
   if vSuppressEvents then Exit;
 
   try
 
   try
 
     DetailTable.DisableControls;
 
     DetailTable.DisableControls;
     // Enforce referential delete ("cascade delete") for table "MasterTable"
+
     // Принудительное удаление ссылок («каскадное удаление») для таблицы «MasterTable»
 
     while not DetailTable.EOF do begin
 
     while not DetailTable.EOF do begin
 
       DetailTable.Delete;
 
       DetailTable.Delete;
Line 428: Line 426:
 
</syntaxhighlight>
 
</syntaxhighlight>
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
procedure TMainForm.DetailTableBeforePost(DataSet: TDataSet);
 
procedure TMainForm.DetailTableBeforePost(DataSet: TDataSet);
 
begin
 
begin
 
   if vSuppressEvents=True then Exit;
 
   if vSuppressEvents=True then Exit;
   // Enforce referential insert/update for table "DetailTable" with
+
   // Принудительное использование ссылочной вставки/обновления для таблицы «DetailTable» с
   // foreign key "MasterTableID" linking to
+
   // внешним ключом «MasterTableID», ссылающимся на
   // the MasterTable ID primary key field
+
   // поле первичного ключа идентификатора MasterTable ID
 
   DataSet.FieldByName('MasterTableId').AsInteger:=
 
   DataSet.FieldByName('MasterTableId').AsInteger:=
 
     MasterTable.FieldByName('ID').AsInteger;
 
     MasterTable.FieldByName('ID').AsInteger;
Line 440: Line 438:
 
</syntaxhighlight>
 
</syntaxhighlight>
  
After you provided referential Insert/Update/Delete, all you must do is provide code for master/detail filtering of data. You do it in the <code>AfterScroll</code> event of the MasterTable and in the <code>OnFilter</code> event of the DetailTable.
+
После того, как вы предоставили ссылочную вставку/обновление/удаление, все, что вам нужно сделать, это предоставить код для master/detail фильтрации данных. Это делается в событии <code>AfterScroll</code> в MasterTable и в событии <code>OnFilter</code> в DetailTable.  
  
Don't forget to set the <code>Filtered</code> property of DetailTable to True.
+
Не забудьте установить для свойства <code>Filtered</code> DetailTable значение True.
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
procedure TMainForm.MasterTableAfterScroll(DataSet: TDataSet);
 
procedure TMainForm.MasterTableAfterScroll(DataSet: TDataSet);
 
begin
 
begin
Line 452: Line 450:
 
</syntaxhighlight>
 
</syntaxhighlight>
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
procedure TMainForm.DetailTableFilterRecord(DataSet: TDataSet;
 
procedure TMainForm.DetailTableFilterRecord(DataSet: TDataSet;
 
   var Accept: Boolean);
 
   var Accept: Boolean);
 
begin
 
begin
 
   if vSuppressEvents=True then Exit;
 
   if vSuppressEvents=True then Exit;
   // Show only child fields whose foreign key points to current
+
   // Показывем только дочерние поля, внешний ключ которых указывает на текущую
   // master table record
+
   // запись master таблицы
 
   Accept:=DataSet.FieldByName('MasterTableId').AsInteger=
 
   Accept:=DataSet.FieldByName('MasterTableId').AsInteger=
 
     MasterTable.FieldByName('ID').AsInteger;
 
     MasterTable.FieldByName('ID').AsInteger;
Line 464: Line 462:
 
</syntaxhighlight>
 
</syntaxhighlight>
  
== Known problems ==
+
== Известные проблемы ==
There are several limitations when using MemDatasets.
+
Есть несколько ограничений при использовании MemDatasets.  
*Locate method does not work
+
*Метод locate не работает
*Filtering by using Filter and Filtered property does not work. You must use hardcoding in the OnFilter event.
+
*Фильтрация с использованием свойства Filter и Filtered не работает. Вы должны использовать жесткое кодирование в событии OnFilter.  
*Looping deletion of records seems to be incredibly slow. Therefore I use my EmptyMemDataset procedure instead of while not EOF do Delete;
+
*Повторное удаление записей кажется невероятно медленным. Поэтому я использую мою процедуру EmptyMemDataset вместо <code>while not EOF do Delete;</code>
* In FPC 2.6.x and earlier, CopyFromDataSet method copies data only from the current cursor position to the end of the source dataset. So, you have to write MemDataset1.First; before MemDataSet2.CopyFromDataSet(MemDataset1);. Fixed in FPC trunk revision 26233.
+
*В FPC 2.6.x и более ранних версиях метод CopyFromDataSet копирует данные только с текущей позиции курсора в конец набора исходных данных. Итак, вы должны написать <code>MemDataset1.First;</code> перед <code>MemDataSet2.CopyFromDataSet(MemDataset1);</code>. Исправлено в транке ревизии FPC 26233.  
** Note that older versions of FPC has no CopyFromDataset in Bufdataset, at the time an advantage for MemDs.
+
** Обратите внимание, что более старые версии FPC не имеют CopyFromDataset в Bufdataset, в то время как это - преимущество для MemDs.  
** See bug report http://bugs.freepascal.org/view.php?id=25426.
+
** См. багрепорт http://bugs.freepascal.org/view.php?id=25426.
  
 
== TBufDataSet ==
 
== TBufDataSet ==
As previously mentioned, MemDataSet lacks custom filters, autoincrement data type and the Locate method, so it is better to use TBufDataSet instead.
+
Как упоминалось ранее, в MemDataSet отсутствуют пользовательские фильтры, тип данных автоинкремента и метод Locate, поэтому взамен лучше использовать TBufDataSet. TBufDataset предоставляется модулем BufDataset.  
TBufDataset is provided by the BufDataset unit.
 
  
Since there is no component for design-time editing of TBufDataSet (but you can set up field definitions at design time), you could create a custom wrapper component or use it through code, in the same way as ClientDataSet in Delphi. Look at the Delphi documentation relating to client datasets for details.  
+
Поскольку нет компонента для редактирования TBufDataSet во время разработки (но вы можете настроить определения полей во время разработки), вы можете создать пользовательский компонент-обертку или использовать его через код так же, как ClientDataSet в Delphi. Подробности смотрите в документации Delphi, касающейся наборов данных клиента для подробностей.
  
You can use the same methods for enforcing referential integrity and primary autoincrement fields as explained for MemDataSet.  
+
Вы можете использовать те же методы для обеспечения ссылочной целостности и первичных полей автоинкремента, как описано для MemDataSet.
  
There are only small differences between MemDataSet and BufDataset:
+
Между MemDataSet и BufDataset есть только небольшие различия:
 
{| class="wikitable sortable"
 
{| class="wikitable sortable"
 
! MemDataSet
 
! MemDataSet
Line 491: Line 488:
 
|}
 
|}
  
== Sorting DBGrid on TitleClick event for TBufDataSet ==
+
== Сортировка DBGrid по событию OnTitleClick для TBufDataSet ==
If you wish to enable consecutive ascending and descending sorting of a DBGrid showing some data from TBufDataSet, you could use the following method:
+
Если вы хотите включить последовательную сортировку DBGrid по возрастанию и убыванию, показывающую некоторые данные из TBufDataSet, вы можете использовать следующий метод:
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
Uses
 
Uses
 
   BufDataset, typinfo;
 
   BufDataset, typinfo;
Line 508: Line 505:
 
   Result := False;
 
   Result := False;
 
   Field := DataSet.Fields.FindField(FieldName);
 
   Field := DataSet.Fields.FindField(FieldName);
   //If invalid field name, exit.
+
   //Если неверное имя поля, выйдем.
 
   if Field = nil then Exit;
 
   if Field = nil then Exit;
   //if invalid field type, exit.
+
   //Если неверный тип поля, выйдем.
 
   if {(Field is TObjectField) or} (Field is TBlobField) or
 
   if {(Field is TObjectField) or} (Field is TBlobField) or
 
     {(Field is TAggregateField) or} (Field is TVariantField)
 
     {(Field is TAggregateField) or} (Field is TVariantField)
 
     or (Field is TBinaryField) then Exit;
 
     or (Field is TBinaryField) then Exit;
   //Get IndexDefs and IndexName using RTTI
+
   //Получаем IndexDefs и IndexName, используя RTTI
 
   if IsPublishedProp(DataSet, 'IndexDefs') then
 
   if IsPublishedProp(DataSet, 'IndexDefs') then
 
     IndexDefs := GetObjectProp(DataSet, 'IndexDefs') as TIndexDefs
 
     IndexDefs := GetObjectProp(DataSet, 'IndexDefs') as TIndexDefs
Line 523: Line 520:
 
   else
 
   else
 
     Exit;
 
     Exit;
   //Ensure IndexDefs is up-to-date
+
   //Убедитесь, что IndexDefs об-нов-лен
   IndexDefs.Updated:=false; {<<<<---This line is critical as IndexDefs.Update will do nothing on the next sort if it's already true}
+
   IndexDefs.Updated:=false; {<<<<---Эта строка имеет решающее значение, так как IndexDefs.Update ничего не будет делать при следующей сортировке, если она уже верна}
 
   IndexDefs.Update;
 
   IndexDefs.Update;
   //If an ascending index is already in use,
+
   //Если восходящий индекс уже используется,  
   //switch to a descending index
+
   //переключаемся на нисходящий индекс
 
   if IndexName = FieldName + '__IdxA'
 
   if IndexName = FieldName + '__IdxA'
 
   then
 
   then
Line 539: Line 536:
 
       IndexOptions := [];
 
       IndexOptions := [];
 
     end;
 
     end;
   //Look for existing index
+
   //ищем существующий индекс
 
   for i := 0 to Pred(IndexDefs.Count) do
 
   for i := 0 to Pred(IndexDefs.Count) do
 
   begin
 
   begin
Line 548: Line 545:
 
       end;  //if
 
       end;  //if
 
   end; // for
 
   end; // for
   //If existing index not found, create one
+
   //Если существующий индекс не найден, создаем его
 
   if not Result then
 
   if not Result then
 
       begin
 
       begin
Line 557: Line 554:
 
         Result := True;
 
         Result := True;
 
       end; // if not
 
       end; // if not
   //Set the index
+
   //Устанавливаем индекс
 
   SetStrProp(DataSet, 'IndexName', IndexName);
 
   SetStrProp(DataSet, 'IndexName', IndexName);
 
end;</syntaxhighlight>
 
end;</syntaxhighlight>
  
So, you can call this function from a DBGrid in this way:
+
Итак, вы можете вызвать эту функцию из DBGrid следующим образом:
<syntaxhighlight>procedure TFormMain.DBGridProductsTitleClick(Column: TColumn);
+
<syntaxhighlight lang=pascal>procedure TFormMain.DBGridProductsTitleClick(Column: TColumn);
 
begin
 
begin
 
   SortBufDataSet(Products, Column.FieldName);
 
   SortBufDataSet(Products, Column.FieldName);
 
end;</syntaxhighlight>
 
end;</syntaxhighlight>
  
 +
== Сортировка нескольких столбцов в grid ==
 +
Я написал TDBGridHelper для сортировки grid по нескольким столбцам, удерживая клавишу Shift.
 +
{{Note| MaxIndexesCount должен быть достаточно большим для TBufDataSet, потому что могут быть довольно большие комбинации возможных вариантов сортировки.}}
  
== Sorting multiple columns in grid ==
+
Но я думаю, что люди не будут использовать больше 10, поэтому установка 100 должна быть теоретически приемлемой.
I have written TDBGridHelper for sorting grid by multiple columns while holding shift key.
 
Note MaxIndexesCount must be set quite large for TBufDataSet because there can be quite large combinations of possible sorting options. But I think people would not use more than 10 so setting it 100 should be teoretically Ok.
 
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
   { TDBGridHelper }
 
   { TDBGridHelper }
  
Line 696: Line 694:
 
       Dir := 'A';
 
       Dir := 'A';
  
     //If shift is presed then add field to field list
+
     //Если нажата клавиша Shift, добавляем поле в список полей.
 
     if ssShift in GetKeyShiftState then
 
     if ssShift in GetKeyShiftState then
 
     begin
 
     begin
 
       Fields.Values[FieldName] := Dir;
 
       Fields.Values[FieldName] := Dir;
       //We do not add to sor any more field if total field count exids cMaxColCOunt
+
       //Мы не добавляем в сортировку больше полей, если общее количество полей превышает cMaxColCOunt
 
       if Fields.Count > cMaxColCOunt then
 
       if Fields.Count > cMaxColCOunt then
 
         Exit;
 
         Exit;
Line 746: Line 744:
 
</syntaxhighlight>
 
</syntaxhighlight>
  
To use sorting you need to call helper methods in OnCellClick and onTitleClick.
+
Чтобы использовать сортировку, нужно вызвать вспомогательные методы в OnCellClick и onTitleClick.
OnTitleClick - If you hold shift ads new column to sot list ore changes direction to selected column or just sorts one column
+
OnTitleClick - если вы удерживаете клавишу shift, добавляется новый столбец в список сортировки, или меняется направление сортировки выбранного столбца, или просто сортируется один столбец.
OnCellClick - If you double click on cell[0, 0] grid clears its sorting
+
OnCellClick - если дважды щелкнуть ячейку [0, 0], сетка очищает ее сортировку.
  
<syntaxhighlight>
+
<syntaxhighlight lang=pascal>
 
procedure TForm1.grdCountriesCellClick(Column: TColumn);
 
procedure TForm1.grdCountriesCellClick(Column: TColumn);
 
begin
 
begin
Line 762: Line 760:
 
end;   
 
end;   
 
</syntaxhighlight>
 
</syntaxhighlight>
If you have assigned TitleImageList then you can specify which image use for ascending and which for descending operations.
+
Если вы назначили TitleImageList, вы можете указать, какое изображение использовать для восходящей, а какое для нисходящей сортировки.
  
 
== ZMSQL==
 
== ZMSQL==
Another, often better way to write in-memory databases is to use the ZMSQL package:
+
Другой, часто лучший способ написания баз данных в памяти - это использование пакета ZMSQL:
  
 
* [[ZMSQL]]
 
* [[ZMSQL]]
Line 771: Line 769:
 
* [http://www.lazarus.freepascal.org/index.php/topic,13821.30.html http://www.lazarus.freepascal.org/index.php/topic,13821.30.html]
 
* [http://www.lazarus.freepascal.org/index.php/topic,13821.30.html http://www.lazarus.freepascal.org/index.php/topic,13821.30.html]
  
== Contributors ==
+
== Авторство ==
Original text written by: Zlatko Matić (matalab@gmail.com)
+
Оригинальный текст написан: Zlatko Matić (matalab@gmail.com)
  
Other contributions by contributors as shown in the page History.
+
Вклад других авторов, как показано на странице History.
 
<br/>
 
<br/>

Latest revision as of 21:20, 19 October 2019

English (en) français (fr) русский (ru)

Databases portal

References:

Tutorials/practical articles:

Databases

Advantage - MySQL - MSSQL - Postgres - Interbase - Firebird - Oracle - ODBC - Paradox - SQLite - dBASE - MS Access - Zeos

Введение

Существуют определенные обстоятельства, когда наборы данных в памяти имеют смысл. Если вам нужна быстрая, однопользовательская, не критически важная база данных, отличная от SQL, без транзакций, TMemDataset может удовлетворить ваши потребности.

Некоторые преимущества:

  • Быстрое выполнение. Поскольку вся обработка выполняется в памяти, данные не сохраняются на жестком диске до тех пор, пока это не будет задано явно. Память, безусловно, быстрее, чем жесткий диск.
  • Нет необходимости во внешних библиотеках (нет файлов .so или .dll), нет необходимости в установке сервера.
  • Код является мультиплатформенным и может быть скомпилирован в любой ОС.
  • Поскольку все программирование выполняется в Lazarus/FPC, такие приложения проще в обслуживании. Вместо того, чтобы постоянно переключаться с внутреннего программирования на внешнее, используя MemDatasets, вы можете сосредоточиться на своем коде Pascal.
Note-icon.png

Примечание: позже в этой статье будет представлен BufDataset. TBufDataset часто является лучшим выбором, чем TMemDataset

Я проиллюстрирую, как программировать реляционные не-SQL базы данных в памяти, сосредоточив внимание на обеспечении целостности отношений и фильтрации, моделировании основных полей с автоинкрементом и т.п.

Эта страница поделится с вами тем, что я узнал, экспериментируя с TMemDatasets. Возможно даже, что есть какой-то другой, более эффективный способ сделать это. Если это так, пожалуйста, не стесняйтесь вносить свой вклад в этот документ в интересах сообщества Lazarus/FPC.

Модуль memds предоставляет TMemDataset, так что вам нужно будет добавить его в раздел uses вашего проекта.

Сохранение MemDataset в постоянные файлы

В интерфейсной части вашего кода объявите тип массива для хранения информации обо всех TMemDataSets, которые вы хотите сделать постоянными в конце сеанса и восстановить в начале следующего сеанса. Вы также должны объявить переменную типа TSaveTables.

Я также использую глобальную переменную vSuppressEvents типа boolean для подавления событий Dataset, используемых для обеспечения ссылочной целостности, во время восстановления данных.

Вот, что у вас должно получиться:

type
  TSaveTables=array[1..15] of TMemDataset;    
var
  //Глобальная переменная, которая хранит таблицы для сохранения/восстановления сеанса работы
  vSaveTables:TSaveTables;                  
  //Переменная-флаг подавления событий датасета. Используется при загрузке данных из файлов.
  vSuppressEvents:Boolean;

Вместо того, чтобы использовать глобальные переменные, как это сделал, например, я, вы также можете сделать их свойством главной формы. TMemDataset имеет способ хранения данных в постоянном файле: метод SaveToFile. Но вы, возможно, захотите сохранить данные в файлы CSV для упрощения работы с ними в дальнейшем. Поэтому я объединю оба способа в одни и те же процедуры.

Я задаю константу cSaveRestore в интерфейсной части модуля, с помощью которой я могу определить, будут ли данные храниться и загружаться как нативные файлы MemDataset, или как файлы CSV.

const
  //Константа cSaveRestore определяет способ сохранения и восстановления MemDataset в постоянные файлы.
  cSaveRestore=0; //0=собственный формат MemDataset, 1=сохранение и восстановление из CSV

Теперь вы можете сохранить MemDataset'ы в событии OnFormClose и загрузить их в событие OnFormCreate. Заполнить элементы массива экземплярами MemDataset можно также в событии OnFormCreate.

procedure TMainForm.FormCreate(Sender: TObject);
begin
  //Список таблиц, которые будут сохранены/восстановлены для сеанса работы
  vSaveTables[1]:=Products;
  vSaveTables[2]:=Boms;
  vSaveTables[3]:=Stocks;
  vSaveTables[4]:=Orders;
  vSaveTables[5]:=BomCalculationProducts;
  vSaveTables[6]:=BomCalculationComponents;
  vSaveTables[7]:=BomCalculationFooter;
  vSaveTables[8]:=BomCalculationProductsMultiple;
  vSaveTables[9]:=BomCalculationComponentsMultiple;
  vSaveTables[10]:=BomCalculationFooterMultiple;
  vSaveTables[11]:=ImportVariants;
  vSaveTables[12]:=ImportToTables;
  vSaveTables[13]:=ImportToFields;
  vSaveTables[14]:=ImportFromTables;
  vSaveTables[15]:=ImportFromFields;
  //Восстанавливаем сеанс работы
  RestoreSession;
  GetAutoincrementPrimaryFields;
end;
procedure TMainForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
begin
 //Сохраняем наборы данных в файлы (чтобы сохранить текущий сеанс)
 SaveSession;
end;
procedure RestoreSession;
var
  I:Integer;
begin
  try
    MemoMessages.Append(TimeToStr(Now())+' Начало восстановления ранее сохраненного сеанса.');
    vSuppressEvents:=True; //Подавляем события, используемые для обеспечения ссылочной целостности
    //Отключаем элементы управления и обновляем все наборы данных
    for I:=Low(vSaveTables) to High(vSaveTables) do begin
      vSaveTables[I].DisableControls;
      vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован
    end;
    //Загружаем memdataset'ы из файлов (для восстановления предыдущего сеанса)
    for I:=Low(vSaveTables) to High(vSaveTables) do begin
      vSaveTables[I].First;
      MemoMessages.Append(TimeToStr(Now())+' Начинаем восстановление таблицы: '+vSaveTables[I].Name);
      try
        //Если данные загружаются из CSV-файла, то сначала необходимо удалить таблицу.
        if cSaveRestore=1 then begin
          MemoMessages.Append(TimeToStr(Now())+' Начинаем удаление всех записей в таблице: '+vSaveTables[I].Name);
          //Этот способ удаления всех записей невероятно медленный.
          {while not vSaveTables[I].EOF do begin
            vSaveTables[I].Delete;
          end;}
          //Этот метод для удаления всех записей намного быстрее
          EmptyMemDataSet(vSaveTables[I]);
          MemoMessages.Append(TimeToStr(Now())+' Все записи из таблицы: '+vSaveTables[I].Name+' удалены.');
        end;
      except
        on E:Exception do begin
          MemoMessages.Append(TimeToStr(Now())+' Ошибка при удалении записей из таблицы: '+vSaveTables[I].Name +'. '+E.Message);
        end;
      end;
      try
        try
          MemoMessages.Append(TimeToStr(Now())+' Восстановление таблицы: '+vSaveTables[I].Name);
          //Проверяем константу для выбора способа сохранения/восстановления данных и загрузки сохраненного сеанса
          case cSaveRestore of
            0:vSaveTables[I].LoadFromFile(vSaveTables[I].Name);
            1:LoadFromCsv(vSaveTables[I]);
          end;
        except
          on E:Exception do begin
            MemoMessages.Append(TimeToStr(Now())+' Ошибка при восстановлении таблицы: '+vSaveTables[I].Name +'. '+E.Message);
          end;
        end;
      finally
        vSaveTables[I].Active:=True;//Требуется из-за метода LoadFromFile....
      end;
      MemoMessages.Append(TimeToStr(Now())+' Таблица: '+vSaveTables[I].Name+' восстановлена.');
    end;
  finally
    vSuppressEvents:=False;
    //Обновляем все наборы данных и включаем элементы управления
    for I:=Low(vSaveTables) to High(vSaveTables) do begin
      vSaveTables[I].Refresh; //Необходимо для таблиц, которые фильтруются.
      vSaveTables[I].EnableControls;
    end;
     MemoMessages.Append(TimeToStr(Now())+' Все таблицы восстановлены из сохраненных файлов.');
  end;
end;
procedure SaveSession;
var
  I:Integer;
begin
  try
    MemoMessages.Append(TimeToStr(Now())+' Начало сохранения сеанса в постоянные файлы.');
    vSuppressEvents:=True;
    //Отключаем элементы управления и обновляем все наборы данных
    for I:=Low(vSaveTables) to High(vSaveTables) do begin
      vSaveTables[I].DisableControls;
      vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован
    end;
    //Сохраняем сеанс работы в файл
    for I:=Low(vSaveTables) to High(vSaveTables) do begin
      vSaveTables[I].First;
      MemoMessages.Append(TimeToStr(Now())+' Сохранение таблицы: '+vSaveTables[I].Name);
      try
        //Проверяем константу для выбора способа сохранения/восстановления данных и загрузки сохраненного сеанса
        case cSaveRestore of
          0:vSaveTables[I].SaveToFile(vSaveTables[I].Name);
          1:SaveToCsv(vSaveTables[I]);
        end;
      except
        on E:Exception do begin
          MemoMessages.Append(TimeToStr(Now())+' Ошибка при сохранении таблицы: '+vSaveTables[I].Name +'. '+E.Message);
        end;
      end;
      MemoMessages.Append(TimeToStr(Now())+' Таблица: '+vSaveTables[I].Name+' сохранена.');
    end;
  finally
    vSuppressEvents:=False;
    //Обновляем все наборы данных и включаем элементы управления
    for I:=Low(vSaveTables) to High(vSaveTables) do begin
      vSaveTables[I].Refresh; //Необходимо для таблиц, которые фильтруются
      vSaveTables[I].EnableControls;
    end;
     MemoMessages.Append(TimeToStr(Now())+' Все таблицы сохранены в файлы.');
  end;
end;
procedure EmptyMemDataSet(DataSet:TMemDataSet);
var
  vTemporaryMemDataSet:TMemDataSet;
  vFieldDef:TFieldDef;
  I:Integer;
begin
  try
    //Создаем временный MemDataSet
    vTemporaryMemDataSet:=TMemDataSet.Create(nil);
    //Сохраняем FieldDefs во временном MemDataSet
    for I:=0 to DataSet.FieldDefs.Count-1 do begin
      vFieldDef:=vTemporaryMemDataSet.FieldDefs.AddFieldDef;
      with DataSet.FieldDefs[I] do begin
        vFieldDef.Name:=Name;
        vFieldDef.DataType:=DataType;
        vFieldDef.Size:=Size;
        vFieldDef.Required:=Required;
      end;
    end;
    //Очищаем существующие fielddefs
    DataSet.Clear;
    //Восстанавливаем fielddefs
    DataSet.FieldDefs:=vTemporaryMemDataSet.FieldDefs;
    DataSet.Active:=True;
  finally
  vTemporaryMemDataSet.Clear;
  vTemporaryMemDataSet.Free;
  end;
end;
procedure LoadFromCsv(DataSet:TDataSet);
var
  vFieldCount:Integer;
  I:Integer;
begin
  try
    //Назначаем SdfDataSetTemporary
    with SdfDataSetTemporary do begin
      Active:=False;
      ClearFields;
      FileName:=DataSet.Name+'.txt';
      FirstLineAsSchema:=True;
      Active:=True;
      //Определяем количество полей
      vFieldCount:=FieldDefs.Count;
    end;
    //Выполняем итерацию по SdfDataSetTeditional и вставляем записи в MemDataSet.
    SdfDataSetTemporary.First;
    while not SdfDataSetTemporary.EOF do begin
      DataSet.Append;
      //Итерация по FieldDefs
      for I:=0 to vFieldCount-1 do begin
        try
          DataSet.Fields[I].Value:=SdfDataSetTemporary.Fields[I].Value;
        except
          on E:Exception do begin
            MemoMessages.Append(TimeToStr(Now())+' Ошибка при установке значения для поля: '
             +DataSet.Name+'.'+DataSet.Fields[I].Name +'. '+E.Message);
          end;
        end;
      end;
      try
        DataSet.Post;
      except
        on E:Exception do begin
          MemoMessages.Append(TimeToStr(Now())+' Ошибка при сохранении записи в таблицу: '
           +DataSet.Name+'.'+E.Message);
        end;
      end;
      SdfDataSetTemporary.Next;
    end;
  finally
    SdfDataSetTemporary.Active:=False;
    SdfDataSetTemporary.ClearFields;
  end;
end;
procedure SaveToCsv(DataSet:TDataSet);
var
  myFileName:string;
  myTextFile: TextFile;
  i: integer;
  s: string;
begin
  myFileName:=DataSet.Name+'.txt';
  //создаем новый файл
  AssignFile(myTextFile, myFileName);
  Rewrite(myTextFile);
  s := ''; //инициализируем пустую строку
  try
    //записываем имена полей (как заголовки столбцов)
    for i := 0 to DataSet.Fields.Count - 1 do
      begin
        s := s + Format('%s,', [DataSet.Fields[i].FieldName]);
      end;
    Writeln(myTextFile, s);
    DataSet.First;
    //записываем значения полей
    while not DataSet.Eof do
      begin
        s := '';
        for i := 0 to DataSet.FieldCount - 1 do
          begin
            //Числовые поля без кавычек, строковые поля с кавычками
            if ((DataSet.FieldDefs[i].DataType=ftInteger)
             or (DataSet.FieldDefs[i].DataType=ftFloat)) then
              s := s + Format('%s,', [DataSet.Fields[i].AsString])
            else
              s := s + Format('"%s",', [DataSet.Fields[i].AsString]);
          end;
        Writeln(myTextfile, s);
        DataSet.Next;
      end;
  finally
    CloseFile(myTextFile);
  end;
end;

Автогенератор первичных ключей

Тип поля Autoincrement не поддерживается MemDataset. Тем не менее, вы можете имитировать его, используя тип поля Integer и предоставляя калькулятор для полей автогенератора. Нам нужны глобальные переменные или открытые свойства для хранения текущего значения поля автогенератора. Я предпочитаю глобальные переменные, объявленные в интерфейсной части модуля.

var
  //Глобальные переменные, используемые для вычисления полей автогенератора первичного ключа MemDatasets
  vCurrentId:Integer=0;
  vProductsId:Integer=0;
  vBomsId:Integer=0;
  vBomCalculationProductsId:Integer=0;
  vBomCalculationComponentsId:Integer=0;
  vBomCalculationFooterId:Integer=0;
  vBomCalculationProductsMultipleId:Integer=0;
  vBomCalculationComponentsMultipleId:Integer=0;
  vBomCalculationFooterMultipleId:Integer=0;
  vStocksId:Integer=0;
  vOrdersId:Integer=0;
  vImportVariantsId:Integer=0;
  vImportToTablesId:Integer=0;
  vImportToFieldsId:Integer=0;
  vImportFromTablesId:Integer=0;
  vImportFromFieldsId:Integer=0;

Тогда у нас есть процедура для расчета значений полей автогенератора:

procedure GetAutoincrementPrimaryFields;
var
  I:Integer;
  vId:^Integer;
begin
  try
    MemoMessages.Lines.Append(TimeToStr(Now())+' Получение информации о полях автогенератора');
    vSuppressEvents:=True;
    //Отключаем элементы управления и обновляем все наборы данных
    for I:=Low(vSaveTables) to High(vSaveTables) do begin
      vSaveTables[I].DisableControls;
      vSaveTables[I].Refresh; //Важный момент, если набор данных был отфильтрован
    end;
    for I:=Low(vSaveTables) to High(vSaveTables) do begin
      with vSaveTables[I] do begin
        //Используем соответствующую глобальную переменную
        case StringToCaseSelect(Name,
          ['Products','Boms','Stocks','Orders',
            'BomCalculationProducts','BomCalculationComponents','BomCalculationFooter',
            'BomCalculationProductsMultiple','BomCalculationComponentsMultiple','BomCalculationFooterMultiple',
            'ImportVariants','ImportToTables','ImportToFields','ImportFromTables','ImportFromFields']) of
          0:vId:=@vProductsId;
          1:vId:=@vBomsId;
          2:vId:=@vStocksId;
          3:vId:=@vOrdersId;
          4:vId:=@vBomCalculationProductsId;
          5:vId:=@vBomCalculationComponentsId;
          6:vId:=@vBomCalculationFooterId;
          7:vId:=@vBomCalculationProductsMultipleId;
          8:vId:=@vBomCalculationComponentsMultipleId;
          9:vId:=@vBomCalculationFooterMultipleId;
          10:vId:=@vImportVariantsId;
          11:vId:=@vImportToTablesId;
          12:vId:=@vImportToFieldsId;
          13:vId:=@vImportFromTablesId;
          14:vId:=@vImportFromFieldsId;
        end;
        try
          //Находим последнее значение ID и сохраняем его в глобальной переменной
          Last;
          vCurrentId:=FieldByName(Name+'Id').AsInteger;
          if (vCurrentId>vId^) then vId^:=vCurrentId;
        finally
          //Удаляем ссылку
          vId:=nil;
        end;
      end;
    end;
  finally
    vSuppressEvents:=False;
    //Обновляем все наборы данных и включаем элементы управления
    for I:=Low(vSaveTables) to High(vSaveTables) do begin
      vSaveTables[I].Refresh;
      vSaveTables[I].EnableControls;
    end;
     MemoMessages.Lines.Append(TimeToStr(Now())+' Автоинкрементные поля - готовы.');
  end;
end;
function StringToCaseSelect(Selector:string;CaseList:array of string):Integer;
var 
  cnt: integer;
begin
  Result:=-1;
  for cnt:=0 to Length(CaseList)-1 do
  begin
    if CompareText(Selector, CaseList[cnt]) = 0 then
    begin
      Result:=cnt;
      Break;
    end;
  end;
end;

Процедура GetAutoincrementPrimaryFields вызывается каждый раз после восстановления (загрузки) данных из постоянных файлов, чтобы загрузить последние значения автогенератора в глобальные переменные (или свойства, как вы предпочитаете). Автоинкрементация выполняется в событии OnNewRecord каждого MemDataset. Например, для таблицы Orders MemDataset:

procedure TMainForm.OrdersNewRecord(DataSet: TDataSet);
begin
  if vSuppressEvents then Exit;
  //Устанавливаем новое значение автогенератора
  vOrdersId:=vOrdersId+1;
  DataSet.FieldByName('OrdersId').AsInteger:=vOrdersId;
end;

Как уже объяснялось, я использую глобальную переменную vSuppressEvents в качестве флага для случая восстановления данных из постоянных файлов.

Обеспечение ссылочной целостности

В компоненте MemDataset встроенная ссылочная целостность не реализована, поэтому вы должны сделать это самостоятельно.

Предположим, у нас есть две таблицы: MasterTable и DetailTable.

Существуют различные места, где необходимо использовать код ссылочной целостности:

  • Код вставки/обновления находится в событии BeforePost DetailTable: перед сохранением новой/обновленной detail-записи ее необходимо проверить на соответствие требованиям ссылочной целостности
  • Код удаления находится в событии BeforeDelete в MasterTable: перед удалением master-записи необходимо убедиться, что все дочерние записи соответствуют требованиям ссылочной целостности
procedure TMainForm.MasterTableBeforeDelete(DataSet: TDataSet);
begin
  if vSuppressEvents then Exit;
  try
    DetailTable.DisableControls;
    // Принудительное удаление ссылок («каскадное удаление») для таблицы «MasterTable»
    while not DetailTable.EOF do begin
      DetailTable.Delete;
    end;
    DetailTable.Refresh;
  finally
    DetailTable.EnableControls;
  end;
end;
procedure TMainForm.DetailTableBeforePost(DataSet: TDataSet);
begin
  if vSuppressEvents=True then Exit;
  // Принудительное использование ссылочной вставки/обновления для таблицы «DetailTable» с 
  // внешним ключом «MasterTableID», ссылающимся на 
  // поле первичного ключа идентификатора MasterTable ID
  DataSet.FieldByName('MasterTableId').AsInteger:=
    MasterTable.FieldByName('ID').AsInteger;
end;

После того, как вы предоставили ссылочную вставку/обновление/удаление, все, что вам нужно сделать, это предоставить код для master/detail фильтрации данных. Это делается в событии AfterScroll в MasterTable и в событии OnFilter в DetailTable.

Не забудьте установить для свойства Filtered DetailTable значение True.

procedure TMainForm.MasterTableAfterScroll(DataSet: TDataSet);
begin
  if vSuppressEvents=True then Exit;
  DetailTable.Refresh;
end;
procedure TMainForm.DetailTableFilterRecord(DataSet: TDataSet;
  var Accept: Boolean);
begin
  if vSuppressEvents=True then Exit;
  // Показывем только дочерние поля, внешний ключ которых указывает на текущую 
  // запись master таблицы
  Accept:=DataSet.FieldByName('MasterTableId').AsInteger=
    MasterTable.FieldByName('ID').AsInteger;
end;

Известные проблемы

Есть несколько ограничений при использовании MemDatasets.

  • Метод locate не работает
  • Фильтрация с использованием свойства Filter и Filtered не работает. Вы должны использовать жесткое кодирование в событии OnFilter.
  • Повторное удаление записей кажется невероятно медленным. Поэтому я использую мою процедуру EmptyMemDataset вместо while not EOF do Delete;
  • В FPC 2.6.x и более ранних версиях метод CopyFromDataSet копирует данные только с текущей позиции курсора в конец набора исходных данных. Итак, вы должны написать MemDataset1.First; перед MemDataSet2.CopyFromDataSet(MemDataset1);. Исправлено в транке ревизии FPC 26233.
    • Обратите внимание, что более старые версии FPC не имеют CopyFromDataset в Bufdataset, в то время как это - преимущество для MemDs.
    • См. багрепорт http://bugs.freepascal.org/view.php?id=25426.

TBufDataSet

Как упоминалось ранее, в MemDataSet отсутствуют пользовательские фильтры, тип данных автоинкремента и метод Locate, поэтому взамен лучше использовать TBufDataSet. TBufDataset предоставляется модулем BufDataset.

Поскольку нет компонента для редактирования TBufDataSet во время разработки (но вы можете настроить определения полей во время разработки), вы можете создать пользовательский компонент-обертку или использовать его через код так же, как ClientDataSet в Delphi. Подробности смотрите в документации Delphi, касающейся наборов данных клиента для подробностей.

Вы можете использовать те же методы для обеспечения ссылочной целостности и первичных полей автоинкремента, как описано для MemDataSet.

Между MemDataSet и BufDataset есть только небольшие различия:

MemDataSet BufDataset
DataSet.ClearFields DataSet.Fields.Clear
DataSet.CreateTable DataSet.CreateDataSet

Сортировка DBGrid по событию OnTitleClick для TBufDataSet

Если вы хотите включить последовательную сортировку DBGrid по возрастанию и убыванию, показывающую некоторые данные из TBufDataSet, вы можете использовать следующий метод:

Uses
  BufDataset, typinfo;

function SortBufDataSet(DataSet: TBufDataSet;const FieldName: String): Boolean;
var
  i: Integer;
  IndexDefs: TIndexDefs;
  IndexName: String;
  IndexOptions: TIndexOptions;
  Field: TField;
begin
  Result := False;
  Field := DataSet.Fields.FindField(FieldName);
  //Если неверное имя поля, выйдем.
  if Field = nil then Exit;
  //Если неверный тип поля, выйдем.
  if {(Field is TObjectField) or} (Field is TBlobField) or
    {(Field is TAggregateField) or} (Field is TVariantField)
     or (Field is TBinaryField) then Exit;
  //Получаем IndexDefs и IndexName, используя RTTI
  if IsPublishedProp(DataSet, 'IndexDefs') then
    IndexDefs := GetObjectProp(DataSet, 'IndexDefs') as TIndexDefs
  else
    Exit;
  if IsPublishedProp(DataSet, 'IndexName') then
    IndexName := GetStrProp(DataSet, 'IndexName')
  else
    Exit;
  //Убедитесь, что IndexDefs об-нов-лен
  IndexDefs.Updated:=false; {<<<<---Эта строка имеет решающее значение, так как IndexDefs.Update ничего не будет делать при следующей сортировке, если она уже верна}
  IndexDefs.Update;
  //Если восходящий индекс уже используется, 
  //переключаемся на нисходящий индекс
  if IndexName = FieldName + '__IdxA'
  then
    begin
      IndexName := FieldName + '__IdxD';
      IndexOptions := [ixDescending];
    end
  else
    begin
      IndexName := FieldName + '__IdxA';
      IndexOptions := [];
    end;
  //ищем существующий индекс
  for i := 0 to Pred(IndexDefs.Count) do
  begin
    if IndexDefs[i].Name = IndexName then
      begin
        Result := True;
        Break
      end;  //if
  end; // for
  //Если существующий индекс не найден, создаем его
  if not Result then
      begin
        if IndexName=FieldName + '__IdxD' then
          DataSet.AddIndex(IndexName, FieldName, IndexOptions, FieldName)
        else
          DataSet.AddIndex(IndexName, FieldName, IndexOptions);
        Result := True;
      end; // if not
  //Устанавливаем индекс
  SetStrProp(DataSet, 'IndexName', IndexName);
end;

Итак, вы можете вызвать эту функцию из DBGrid следующим образом:

procedure TFormMain.DBGridProductsTitleClick(Column: TColumn);
begin
  SortBufDataSet(Products, Column.FieldName);
end;

Сортировка нескольких столбцов в grid

Я написал TDBGridHelper для сортировки grid по нескольким столбцам, удерживая клавишу Shift.

Note-icon.png

Примечание: MaxIndexesCount должен быть достаточно большим для TBufDataSet, потому что могут быть довольно большие комбинации возможных вариантов сортировки.

Но я думаю, что люди не будут использовать больше 10, поэтому установка 100 должна быть теоретически приемлемой.

  { TDBGridHelper }

  TDBGridHelper = class helper for TDBGrid
  public const
    cMaxColCOunt = 3;
  private
    procedure Interbal_MakeNames(Fields: TStrings; out FieldsList, DescFields: String);
    procedure Internal_SetColumnsIcons(Fields: TStrings; AscIdx, DescIdx: Integer);
    function Internal_IndexNameExists(IndexDefs: TIndexDefs; IndexName: String): Boolean;
  public
    procedure Sort(const FieldName: String; AscIdx: Integer = -1; DescIdx: Integer = -1);
    procedure ClearSort;
  end;  

{ TDBGridHelper }

procedure TDBGridHelper.Interbal_MakeNames(Fields: TStrings; out FieldsList, DescFields: String);
var
  FldList: TStringList;
  DscList: TStringList;
  FldDesc, FldName: String;
  i: Integer;
begin
  if Fields.Count = 0 then
  begin
    FieldsList := '';
    DescFields := '';
    Exit;
  end;

  FldList := TStringList.Create;
  DscList := TStringList.Create;
  try
    FldList.Delimiter := ';';
    DscList.Delimiter := ';';

    for i := 0 to Fields.Count - 1 do
    begin
      Fields.GetNameValue(i, FldName, FldDesc);
      FldList.Add(FldName);

      if FldDesc = 'D' then
        DscList.Add(FldName);
    end;

    FieldsList := FldList.DelimitedText;
    DescFields := DscList.DelimitedText;
  finally
    FldList.Free;
    DscList.Free;
  end;
end;

procedure TDBGridHelper.Internal_SetColumnsIcons(Fields: TStrings; AscIdx, DescIdx: Integer);
var
  i: Integer;
  FldDesc: String;
begin
  for i := 0 to Self.Columns.Count - 1 do
  begin
    FldDesc := Fields.Values[Self.Columns[i].Field.FieldName];

    if FldDesc = 'A' then
      Self.Columns[i].Title.ImageIndex := AscIdx
    else
    if FldDesc = 'D' then
      Self.Columns[i].Title.ImageIndex := DescIdx
    else
      Self.Columns[i].Title.ImageIndex := -1
  end;
end;

function TDBGridHelper.Internal_IndexNameExists(IndexDefs: TIndexDefs; IndexName: String): Boolean;
var
  i: Integer;
begin
  for i := 0 to IndexDefs.Count - 1 do
  begin
    if IndexDefs[i].Name = IndexName then
      Exit(True)
  end;

  Result := False
end;

procedure TDBGridHelper.Sort(const FieldName: String; AscIdx: Integer;
  DescIdx: Integer);
var
  Field: TField;
  DataSet: TBufDataset;
  IndexDefs: TIndexDefs;
  IndexName, Dir, DescFields, FieldsList: String;
  Fields: TStringList;
begin
  if not Assigned(DataSource.DataSet) or
     not DataSource.DataSet.Active or
     not (DataSource.DataSet is TBufDataset) then
    Exit;
  DataSet := DataSource.DataSet as TBufDataset;

  Field := DataSet.FieldByName(FieldName);
  if (Field is TBlobField) or (Field is TVariantField) or (Field is TBinaryField) then
    Exit;

  IndexDefs := DataSet.IndexDefs;
  IndexName := DataSet.IndexName;

  if not IndexDefs.Updated then
    IndexDefs.Update;

  Fields := TStringList.Create;
  try
    Fields.DelimitedText := IndexName;
    Dir := Fields.Values[FieldName];

    if Dir = 'A' then
      Dir := 'D'
    else
    if Dir = 'D' then
      Dir := 'A'
    else
      Dir := 'A';

    //Если нажата клавиша Shift, добавляем поле в список полей.
    if ssShift in GetKeyShiftState then
    begin
      Fields.Values[FieldName] := Dir;
      //Мы не добавляем в сортировку больше полей, если общее количество полей превышает cMaxColCOunt
      if Fields.Count > cMaxColCOunt then
        Exit;
    end
    else
    begin
      Fields.Clear;
      Fields.Values[FieldName] := Dir;
    end;

    IndexName := Fields.DelimitedText;
    if not Internal_IndexNameExists(IndexDefs, IndexName) then
    begin
      Interbal_MakeNames(Fields, FieldsList, DescFields);
      TBufDataset(DataSet).AddIndex(IndexName, FieldsList, [], DescFields, '');
    end;

    DataSet.IndexName := IndexName;
    Internal_SetColumnsIcons(Fields, AscIdx, DescIdx)
  finally
    Fields.Free;
  end;
end;

procedure TDBGridHelper.ClearSort;
var
  DataSet: TBufDataset;
  Fields: TStringList;
begin
  if not Assigned(DataSource.DataSet) or
     not DataSource.DataSet.Active or
     not (DataSource.DataSet is TBufDataset) then
    Exit;
  DataSet := DataSource.DataSet as TBufDataset;

  DataSet.IndexName := '';

  Fields := TStringList.Create;
  try
    Internal_SetColumnsIcons(Fields, -1, -1)
  finally
    Fields.Free
  end
end;

Чтобы использовать сортировку, нужно вызвать вспомогательные методы в OnCellClick и onTitleClick. OnTitleClick - если вы удерживаете клавишу shift, добавляется новый столбец в список сортировки, или меняется направление сортировки выбранного столбца, или просто сортируется один столбец. OnCellClick - если дважды щелкнуть ячейку [0, 0], сетка очищает ее сортировку.

procedure TForm1.grdCountriesCellClick(Column: TColumn);
begin
  if not Assigned(Column) then
    grdCountries.ClearSort
end;

procedure TForm1.grdCountriesTitleClick(Column: TColumn);
begin
  grdCountries.Sort(Column.Field.FieldName, 0, 1);
end;

Если вы назначили TitleImageList, вы можете указать, какое изображение использовать для восходящей, а какое для нисходящей сортировки.

ZMSQL

Другой, часто лучший способ написания баз данных в памяти - это использование пакета ZMSQL:

Авторство

Оригинальный текст написан: Zlatko Matić (matalab@gmail.com)

Вклад других авторов, как показано на странице History.