Использование DB Controls без базы данных
Falk0ner, вс, 06/07/2008 - 15:34.
С другой стороны, в случае, если операций вставки производится существенно больше, чем операций поиска по закладке (путем присваивания свойству Bookmark, т.е. не считая вызовов InternalSetToRecord), может оказаться выгоднее (и уж точно – проще) искать записи последовательным перебором, а InternalSetToRecord реализовать так, как описано ранее (DoBeforeInsert и InternalInsert). Разумеется, дилемма отпадает, если вставку всех записей производить как добавление в конец набора – тогда можно просто принять в качестве закладки значение физического курсора. Чуть не забыл! Insert и Append – не единственные методы для вставки записей. Если имеется буфер записи, в который уже записаны значения полей, то можно добавить в набор запись с такими значениями полей вызовом InsertRecord. Этот метод обращается к AddRecord, а тот, в свою очередь, к InternalInsertRecord. Такой способ добавления записи тоже нужно обрабатывать. Native-формат данных Приведу обещанное описание Native-формата данных:·Данные для поля (каждому полю соответствует экземпляр потомка TField), имеющего DataType=ftInteger или ftLargeint, в Native-формате представлены просто в виде числа типа longint (или, что то же самое, Integer); данные для ftSmallint – числом типа Smallint, ftWord – типа Word. ·Для полей с DataType=ftString данные хранятся в виде последовательности символов, завершающейся #0 (символом с кодом 0); длина последовательности вместе с #0 не должна превышать значение_поля_Size + 1. Если поле Transliterate данного экземпляра TStringField равно True, то потомок TDataSet должен предоставить метод Translate для преобразования данных из кодировки символов, используемой в конкретном наборе данных, в кодировку ANSI (и обратно). В том виде, как он реализован в TDataSet, метод Translate просто возвращает исходную строку. ·Для полей с DataType=ftWideString данные хранятся в формате WideString. ·Для полей ftFloat и ftCurrency – в виде числа типа double. ·Для полей ftBoolean – в виде WordBool. ·Для полей ftDateTime, ftDate и ftTime – в виде TDateTime. ·Для полей с DataType=ftTimeStamp – в виде TSQLTimeStamp (модуль SqlTimSt). ·Для полей ftBytes и ftVarBytes – в виде последовательности байтов. ·Для полей ftBCD и ftFMTBCD – в виде TBcd (модуль FMTBcd). ·Для полей ftBLOB, ftMemo, ftGraphic данные так же, как и для ftBytes, хранятся в виде последовательности байтов; потомок TDataSet обязан предоставить метод CreateBlobStream для создания объекта-потомка TStream, обеспечивающего доступ к данным. ·Для полей ftReference – в виде массива байтов. ·Для полей ftVariant – в любом виде, совместимом с одним из представлений данных в Variant (см. описание Variant в справочной системе Delphi; подробное описание доступно в MSDN (ключевые слова, например, – “VARIANT and VARIANTARG”). ·Для полей ftInterface, ftIDispatch – в виде указателя на интерфейс. ·Для полей ftGuid – в виде строки, которая может быть расшифрована вызовом StringToGuid. ·Для полей ftADT и ftArray – определяются типами содержащихся в них полей (каждое поле читается отдельно). ·Для полей ftDataSet – насколько я понял, формат хранимых данных не имеет значения; потомок TDataSet обязан предоставить метод CreateNestedDataset для создания экземпляра нужного потомка TDataSet на основе содержащейся в данном поле информации. Упрощение интерфейса Когда я только начинал писать эту статью, основной моей целью было показать, что интерфейс между DBGrid и, например, массивом можно наладить достаточно легко. Но, возможно, для таких простых ситуаций имеет смысл пойти дальше и разработать свой собственный интерфейс как надстройку над классом TDataSet, для обеспечения функционирования которого достаточно будет перекрыть всего десяток методов. Последовав советам, я решил вместо перекрывания методов ввести систему событий. С учетом сказанного, второй пример будет состоять из двух частей: TMyDataSet – переходник, обеспечивающий упрощенное взаимодействие с методами TDataSet, используя обычный для Delphi механизм событий, и TMyData – класс, содержащий собственно адресную книгу и методы работы с ней, которые и назначаются в качестве реакций на события TMyDataSet. Эту схему событий я решил основать на принципе обращения к записям по их последовательным номерам, отсчитываемым от единицы. На мой взгляд, это вполне оправданно, т.к. я адаптирую интерфейс TDataSet именно к простым наборам данных (таким, как списки или массивы), а для существенно более сложных наборов целесообразнее, возможно, работать с обычным интерфейсом TDataSet. Вот введенные мной события: FPerformOpenConnection: procedure(DS: TDataSet) of object; -Установление соединения с носителем набора данных FPerformCloseConnection: procedure(DS: TDataSet) of object; -Разрыв соединения FPerformFillFieldDefs: procedure(FieldDefsRef: TFieldDefs) of object; -Формирование списка определений полей(аргумент - объект - список полей) FPerformGetFieldData: procedure(Index: integer; Field: TField; out Data) of object; -Чтение значения поля Field записи с номером Index FPerformSetFieldData: procedure(Index: integer; Field: TField; var Data) of object; -Изменение значения поля PerformGetCanModify: function: boolean of object; -Определение того, можно ли вносить изменения в набор FPerformGetRecordCount: function: integer of object; -Определение количества записей в наборе FPerformDeleteRecord: procedure(Index: integer) of object; -Удаление записи FPerformClearFields: procedure(Index: integer) of object; -Очистка полей записи FPerformCreateFloatingRecord: function(SourceIndex: integer): integer of object; -Создание “плавающей” записи.Передается номер записи, значения полей которой нужно скопировать в “плавающую”(0, если копировать ничего не нужно) FPerformFreeFloatingRecord: procedure(Index: integer) of object; -Удаление “плавающей” записи с номером Index FPerformDefloatRecord: procedure(FlIndex, DestIndex: integer; DefloatMode: TDefloatMode) of object; -Помещение “плавающей” записи с номером Index в набор в позицию, занимаемую записью DestIndex.DefloatMode указывает, вставляется ли “плавающая” запись вместо DestIndex или перед ней FPerformGetBookmarkSize: function: integer of object; -Определение размера закладки FPerformGetBookmark: function(Index: integer): TBookmarkStr of object; -Опрос закладки FPerformSetBookmark: procedure(Index: integer; NewBookmark: TBookmarkStr) of object; -Установка закладки для записи FPerformFindBookmark: function(Bookmark: TBookmarkStr): integer of object; -Переход к записи по закладке Работа осуществляется таким образом: класс, поставляющий обработчики событий (будем называть его поставщиком), берет на себя хранение данных и закладок, а также операции с записями по их номерам. Предлагаемый же потомок TDataSet отвечает за поддержание взаимно однозначного соответствия записей и их номеров и за перевод обычных последовательностей операций TDataSet в вызовы вышеперечисленных событий. Особо следует пояснить понятие “плавающей” записи. Предполагается, что поставщик не считывает записи набора в какие-то свои кэш-буферы, а читает содержимое полей прямо из набора. В случае чтения это работает, но в случае редактирования записей производимые изменения следует где-то накапливать, то есть в этой ситуации временное хранилище создавать придется. Однако, есть способ упростить эту операцию. Хранилище можно (так как одновременно при таком подходе будет использоваться не более одного хранилища) реализовать в виде, например, какого-то зарезервированного элемента набора (массива, списка). Соответственно, можно сделать единообразным доступ как к записям набора, так и к этому хранилищу. Когда поступает запрос на начало редактирования существующей записи или на добавление новой, у поставщика запрашивается создание такого хранилища. В ответ поставщик возвра&;#1097;ает число – это может быть, например, номер зарезервированной записи, или вообще любой номер такой, что в дальнейшем поставщик будет в состоянии понять, что этот номер относится именно к хранилищу. Таким образом, роль хранилища с точки зрения нашего потомка TDataSet будет играть запись с этим номером – ее мы и назовем “плавающей записью”. Затем происходит либо очистка полей плавающей записи, либо (в случае редактирования существующей записи) копирование в эти поля значений полей исходной записи. В дальнейшем, пока изменения не будут подтверждены или отменены, вместо чтения и записи полей исходной будет производиться чтение и запись полей “плавающей”. При отмене изменений у поставщика запрашивается освобождение “плавающей” записи, при подтверждении – вызывается FPerformDefloatRecord (см. описание этого события). Отмечу небольшое затруднение с подменой чтения/записи исходной записи на чтение/запись плавающей. Как уже говорилось, некоторые элементы управления в цикле, в котором они опрашивают поля записей (что приводит к вызову GetFieldData), изменяют единственную реализацию логического курсора в TDataSet, указатель ActiveBuffer (присваивая ему затем прежнее значение). Поэтому для того, чтобы определить, потребовали ли от TDataSet доступ именно к редактируемой записи, адрес буфера редактируемой записи надо в момент начала редактирования сохранить в какой-либо переменной, а в GetFieldData сравнивать значение ActiveBuffer с этим сохраненным значением. Все вышесказанное естественным образом воплощается в примерно такой код: Листинг 3 TMyDataSet с возможностью редактирования
unit DataSet3;
interface
uses DB, Classes {for TComponent};
type
TDBCursor = integer; //Тип данных для физического курсора - номер записи
TDefloatMode = (dmInsert, dmOverwrite);
TRecordBuffer = packed record
RecordIndex: TDBCursor; //Номер записи (считая от 1)
BookmarkFlag: TBookmarkFlag;
end;
PRecordBuffer = ^TRecordBuffer;
TMyDataSet = class(TDataset)
private
FIsOpen: boolean;
FCursor: integer;
FInsertingBefore: integer;
FFloatingRecordIndex: integer;
FEditingBuffer: pchar; //Хранит адрес буфера для редактируемой записи
//При редактировании большую часть времени совпадает с ActiveBuffer,
//но в процессе отрисовки связанных элементов управления последний
//временно изменяется
protected
procedure InternalHandleException; override;
procedure InternalInitFieldDefs; override;
procedure InternalOpen; override;
function IsCursorOpen: Boolean; override;
procedure InternalClose; override;
procedure SetActive(Value: Boolean); override; //Вызывает Finalize при
// закрытии TDataSet
procedure Finalize; virtual; //логическое завершение текущих операций
//(вызов Close/Post и т.п.)
function GetRecord(Buffer: PChar; GetMode: TGetMode;
DoCheck: Boolean): TGetResult; override;
function AllocRecordBuffer: PChar; override;
procedure FreeRecordBuffer(var Buffer: PChar); override;
procedure InternalFirst; override;
procedure InternalLast; override;
procedure InternalSetToRecord(Buffer: PChar); override;
function GetCanModify: Boolean; override;
procedure InternalEdit; override;
procedure InternalCancel; override;
procedure DoBeforeInsert; override;
procedure InternalInsert; override;
procedure InternalInitRecord(Buffer: PChar); override;
procedure InternalPost; override;
procedure InternalDelete; override;
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
override;
procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
override;
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
procedure InternalGotoBookmark(Bookmark: Pointer); override;
function GetRecordCount: Integer; override;
procedure SetRecNo(Value: Integer); override;
function GetRecNo: Integer; override;
public
constructor Create(AOwner: TComponent); override;
function GetFieldData(Field: TField; Buffer: Pointer): Boolean;
override;
procedure SetFieldData(Field: TField; Buffer: Pointer); override;
function BookmarkValid(Bookmark: TBookmark): Boolean; override;
public //Конечно, это лучше реализовывать в виде свойств, но в целях
// экономии места я сделал эти процедурные переменные полями
FPerformOpenConnection: procedure(DS: TDataSet) of object;
FPerformCloseConnection: procedure(DS: TDataSet) of object;
FPerformFillFieldDefs: procedure(FieldDefsRef: TFieldDefs) of object;
FPerformGetFieldData: procedure(Index: integer; Field: TField; out Data)
of object;
FPerformSetFieldData: procedure(Index: integer; Field: TField; var Data)
of object;
FPerformGetCanModify: function: boolean of object;
FPerformGetRecordCount: function: integer of object;
FPerformDeleteRecord: procedure(Index: integer) of object;
FPerformClearFields: procedure(Index: integer) of object;
FPerformCreateFloatingRecord: function(SourceIndex: integer): integer
of object;
FPerformFreeFloatingRecord: procedure(Index: integer) of object;
FPerformDefloatRecord: procedure(FlIndex, DestIndex: integer;
DefloatMode: TDefloatMode) of object;
FPerformGetBookmarkSize: function: integer of object;
FPerformGetBookmark: function(Index: integer): TBookmarkStr of object;
FPerformSetBookmark: procedure(Index: integer; NewBookmark: TBookmarkStr)
of object;
FPerformFindBookmark: function(Bookmark: TBookmarkStr): integer
of object;
end;
implementation
uses SysUtils, forms;
procedure TMyDataSet.InternalHandleException;
begin
Application.HandleException(Self)
end;
procedure TMyDataSet.InternalInitFieldDefs;
begin
if Assigned(FPerformFillFieldDefs) then
FPerformFillFieldDefs(FieldDefs)
else
FieldDefs.Clear;
end;
procedure TMyDataSet.InternalOpen;
begin
InternalInitFieldDefs;
if DefaultFields then
CreateFields;
BindFields(true);
FIsOpen := true;
FCursor := 0;
if Assigned(FPerformGetBookmarkSize) then
BookmarkSize := FPerformGetBookmarkSize()
else
BookmarkSize := 0;
if Assigned(FPerformOpenConnection) then
FPerformOpenConnection(self);
end;
function TMyDataSet.IsCursorOpen: Boolean;
begin
result := FIsOpen
end;
procedure TMyDataSet.InternalClose;
begin
if Assigned(FPerformCloseConnection) then
FPerformCloseConnection(self);
BindFields(False);
if DefaultFields then
DestroyFields;
FIsOpen := false;
end;
procedure TMyDataSet.InternalFirst;
begin
FCursor := 0
end;
procedure TMyDataSet.InternalLast;
begin
FCursor := RecordCount + 1
end;
function TMyDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
DoCheck: Boolean): TGetResult;
begin
result := grOK;
case GetMode of
gmPrior: if FCursor <= 1 then
result := grBOF
else
Dec(FCursor);
gm: if FCursor >= RecordCount then
result := grEOF
else
Inc(FCursor);
gmCurrent: if (FCursor < 1) or (FCursor > RecordCount) then
Result := grError;
end;
if result = grOK then
with PRecordBuffer(Buffer)^ do
begin
RecordIndex := FCursor;
BookmarkFlag := bfCurrent;
end;
if (result = grError) and DoCheck then
DatabaseError('Ошибка в GetRecord()');
end;
function TMyDataSet.GetRecordCount: Integer;
begin
if Assigned(FPerformGetRecordCount) then
Result := FPerformGetRecordCount()
else
raise EDatabaseError.Create('Для работы с ' + ClassName
+ ' требуется задать обработчик события OnGetRecordCount!');
end;
procedure TMyDataSet.SetRecNo(Value: Integer);
begin
CheckBrowseMode;
if (Value < 1) or (Value >= RecordCount + 1) then
exit;
FCursor := Value;
Resync([])
end;
function TMyDataSet.GetRecNo: Integer;
begin
Result := PRecordBuffer(ActiveBuffer)^.RecordIndex + 1
end;
procedure TMyDataSet.InternalSetToRecord(Buffer: PChar);
begin
FCursor := PRecordBuffer(Buffer)^.RecordIndex;
end;
function TMyDataSet.AllocRecordBuffer: PChar;
begin
GetMem(result, sizeof(TRecordBuffer))
end;
procedure TMyDataSet.FreeRecordBuffer(var Buffer: PChar);
begin
FreeMem(Buffer)
end;
procedure TMyDataSet.InternalInitRecord(Buffer: PChar);
//Вообще-то, это просто операция очистки записи.
//Так как наш буфер не содержит указателей на динамически создаваемые
//структуры данных, то нам не нужно удалять структуры, связанные с
//предыдущим содержимым буфера. Но вот для поставщика это может быть
//необходимо, и его надо подробно уведомить о ситуации
begin
//Если это повторный вызов (когда TDataSet уже находится в одном из режимов
//редактирования) - такой выполняется при ClearFields - то надо просто
//очистить запись, в противном случае TDataSet мы хотим вставить новую
//запись, и поставщик должен сначала создать “плавающую” запись.
if not (State in dsEditModes) then
if Assigned(FPerformCreateFloatingRecord) then
FFloatingRecordIndex := FPerformCreateFloatingRecord(0);
if Assigned(FPerformClearFields) then
FPerformClearFields(PRecordBuffer(ActiveBuffer)^.RecordIndex);
end;
function TMyDataSet.GetCanModify: Boolean;
begin
if assigned(FPerformGetCanModify) then
result := FPerformGetCanModify
else
result := false
end;
function TMyDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
Index: integer;
begin
result := assigned(FPerformGetFieldData);
if (State in dsEditModes) and (ActiveBuffer = FEditingBuffer) then
Index := FFloatingRecordIndex //перенаправляем к “плавающей” записи
else
Index := PRecordBuffer(ActiveBuffer)^.RecordIndex;
if result then
FPerformGetFieldData(Index, Field, Buffer^);
end;
constructor TMyDataSet.Create(AOwner: TComponent);
begin
inherited;
FIsOpen := false;
if assigned(FPerformGetBookmarkSize) then
BookmarkSize := FPerformGetBookmarkSize()
else
BookmarkSize := 0;
end;
function TMyDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
begin
result := PRecordBuffer(Buffer)^.BookmarkFlag;
end;
procedure TMyDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
begin
PRecordBuffer(Buffer)^.BookmarkFlag := Value;
end;
procedure TMyDataSet.InternalPost;
begin
inherited; //=CheckRequiredFields
case State of
dsEdit:
if Assigned(FPerformDefloatRecord) then
FPerformDefloatRecord(FFloatingRecordIndex, FCursor, dmOverwrite);
dsInsert:
begin
if Assigned(FPerformDefloatRecord) then
FPerformDefloatRecord(FFloatingRecordIndex, FCursor, dmInsert);
PRecordBuffer(ActiveBuffer)^.RecordIndex := FCursor;
PRecordBuffer(ActiveBuffer)^.BookMarkFlag := bfCurrent;
end;
end;
end;
procedure TMyDataSet.SetFieldData(Field: TField; Buffer: Pointer);
begin
//Для этой операции Index всегда является индексом “плавающей” записи
//Перенаправляем изменения в Floating record
if Assigned(FPerformSetFieldData) then
FPerformSetFieldData(FFloatingRecordIndex, Field, Buffer^);
DataEvent(deFieldChange, cardinal(Field));
end;
procedure TMyDataSet.InternalDelete;
begin
if not Assigned(FPerformGetRecordCount) then
raise EDatabaseError.Create('Для работы с ' + ClassName
+ ' требуется задать обработчик события PerformGetRecordCount!');
if Assigned(FPerformDeleteRecord) then
FPerformDeleteRecord(PRecordBuffer(ActiveBuffer)^.RecordIndex);
if FCursor = FPerformGetRecordCount() then
Dec(FCursor);
end;
procedure TMyDataSet.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
//Согласно справке, при вызове InsertRecord активной становится вставленная
//запись. Причем можно отследить, что заботиться об этом должна
//InternalAddRecord. Поэтому в случае DoAppend просто прыгаем в конец
//(вернее, за конец)
begin
//В момент вызова уже создана Floating-запись, и в нее скопированы значения
if DoAppend then
InternalLast;
FPerformDefloatRecord(FFloatingRecordIndex, FCursor, dmInsert);
end;
procedure TMyDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
var
res: string;
begin
if BookmarkSize = 0 then
exit;
if Assigned(FPerformGetBookmark) then
res := FPerformGetBookmark(PRecordBuffer(Buffer)^.RecordIndex)
else
res := '';
strpcopy(Data, res);
end;
procedure TMyDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin
if Assigned(FPerformSetBookmark) then
FPerformSetBookmark(PRecordBuffer(Buffer)^.RecordIndex, string(pchar(Data)))
end;
procedure TMyDataSet.InternalGotoBookmark(Bookmark: Pointer);
var
Pos: integer;
begin
if not assigned(FPerformFindBookmark) then
exit;
Pos := FPerformFindBookmark(string(Bookmark));
if Pos > -1 then
FCursor := Pos;
end;
function TMyDataSet.BookmarkValid(Bookmark: TBookmark): Boolean;
begin
result := assigned(FPerformFindBookmark);
if result then
result := (-1 <> FPerformFindBookmark(string(Bookmark)))
end;
procedure TMyDataSet.DoBeforeInsert;
begin
inherited;
FInsertingBefore := PRecordBuffer(ActiveBuffer)^.RecordIndex;
end;
procedure TMyDataSet.InternalInsert;
begin
FEditingBuffer := ActiveBuffer;
//Чтобы InternalSetToRecord переходил на правильную позицию
with PRecordBuffer(ActiveBuffer)^ do
if BookmarkFlag = bfInserted then
RecordIndex := FInsertingBefore;
//А если bfEOF или bfBOF, то InternalSetToRecord и не будет вызываться
end;
procedure TMyDataSet.InternalCancel;
begin
if Assigned(FPerformFreeFloatingRecord) then
FPerformFreeFloatingRecord(FFloatingRecordIndex);
end;
procedure TMyDataSet.InternalEdit;
begin
FEditingBuffer := ActiveBuffer;
if Assigned(FPerformCreateFloatingRecord) then
FFloatingRecordIndex :=
FPerformCreateFloatingRecord(PRecordBuffer(ActiveBuffer)^.RecordIndex);
end;
procedure TMyDataSet.SetActive(Value: Boolean);
begin
if (Value <> Active) and (Value = false) then
Finalize;
inherited;
end;
procedure TMyDataSet.Finalize;
begin
Cancel; //вдруг что-то редактировалось
end;
end.
interface
uses DB, Classes {for TComponent};
type
TDBCursor = integer; //Тип данных для физического курсора - номер записи
TDefloatMode = (dmInsert, dmOverwrite);
TRecordBuffer = packed record
RecordIndex: TDBCursor; //Номер записи (считая от 1)
BookmarkFlag: TBookmarkFlag;
end;
PRecordBuffer = ^TRecordBuffer;
TMyDataSet = class(TDataset)
private
FIsOpen: boolean;
FCursor: integer;
FInsertingBefore: integer;
FFloatingRecordIndex: integer;
FEditingBuffer: pchar; //Хранит адрес буфера для редактируемой записи
//При редактировании большую часть времени совпадает с ActiveBuffer,
//но в процессе отрисовки связанных элементов управления последний
//временно изменяется
protected
procedure InternalHandleException; override;
procedure InternalInitFieldDefs; override;
procedure InternalOpen; override;
function IsCursorOpen: Boolean; override;
procedure InternalClose; override;
procedure SetActive(Value: Boolean); override; //Вызывает Finalize при
// закрытии TDataSet
procedure Finalize; virtual; //логическое завершение текущих операций
//(вызов Close/Post и т.п.)
function GetRecord(Buffer: PChar; GetMode: TGetMode;
DoCheck: Boolean): TGetResult; override;
function AllocRecordBuffer: PChar; override;
procedure FreeRecordBuffer(var Buffer: PChar); override;
procedure InternalFirst; override;
procedure InternalLast; override;
procedure InternalSetToRecord(Buffer: PChar); override;
function GetCanModify: Boolean; override;
procedure InternalEdit; override;
procedure InternalCancel; override;
procedure DoBeforeInsert; override;
procedure InternalInsert; override;
procedure InternalInitRecord(Buffer: PChar); override;
procedure InternalPost; override;
procedure InternalDelete; override;
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
override;
procedure InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
override;
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
procedure InternalGotoBookmark(Bookmark: Pointer); override;
function GetRecordCount: Integer; override;
procedure SetRecNo(Value: Integer); override;
function GetRecNo: Integer; override;
public
constructor Create(AOwner: TComponent); override;
function GetFieldData(Field: TField; Buffer: Pointer): Boolean;
override;
procedure SetFieldData(Field: TField; Buffer: Pointer); override;
function BookmarkValid(Bookmark: TBookmark): Boolean; override;
public //Конечно, это лучше реализовывать в виде свойств, но в целях
// экономии места я сделал эти процедурные переменные полями
FPerformOpenConnection: procedure(DS: TDataSet) of object;
FPerformCloseConnection: procedure(DS: TDataSet) of object;
FPerformFillFieldDefs: procedure(FieldDefsRef: TFieldDefs) of object;
FPerformGetFieldData: procedure(Index: integer; Field: TField; out Data)
of object;
FPerformSetFieldData: procedure(Index: integer; Field: TField; var Data)
of object;
FPerformGetCanModify: function: boolean of object;
FPerformGetRecordCount: function: integer of object;
FPerformDeleteRecord: procedure(Index: integer) of object;
FPerformClearFields: procedure(Index: integer) of object;
FPerformCreateFloatingRecord: function(SourceIndex: integer): integer
of object;
FPerformFreeFloatingRecord: procedure(Index: integer) of object;
FPerformDefloatRecord: procedure(FlIndex, DestIndex: integer;
DefloatMode: TDefloatMode) of object;
FPerformGetBookmarkSize: function: integer of object;
FPerformGetBookmark: function(Index: integer): TBookmarkStr of object;
FPerformSetBookmark: procedure(Index: integer; NewBookmark: TBookmarkStr)
of object;
FPerformFindBookmark: function(Bookmark: TBookmarkStr): integer
of object;
end;
implementation
uses SysUtils, forms;
procedure TMyDataSet.InternalHandleException;
begin
Application.HandleException(Self)
end;
procedure TMyDataSet.InternalInitFieldDefs;
begin
if Assigned(FPerformFillFieldDefs) then
FPerformFillFieldDefs(FieldDefs)
else
FieldDefs.Clear;
end;
procedure TMyDataSet.InternalOpen;
begin
InternalInitFieldDefs;
if DefaultFields then
CreateFields;
BindFields(true);
FIsOpen := true;
FCursor := 0;
if Assigned(FPerformGetBookmarkSize) then
BookmarkSize := FPerformGetBookmarkSize()
else
BookmarkSize := 0;
if Assigned(FPerformOpenConnection) then
FPerformOpenConnection(self);
end;
function TMyDataSet.IsCursorOpen: Boolean;
begin
result := FIsOpen
end;
procedure TMyDataSet.InternalClose;
begin
if Assigned(FPerformCloseConnection) then
FPerformCloseConnection(self);
BindFields(False);
if DefaultFields then
DestroyFields;
FIsOpen := false;
end;
procedure TMyDataSet.InternalFirst;
begin
FCursor := 0
end;
procedure TMyDataSet.InternalLast;
begin
FCursor := RecordCount + 1
end;
function TMyDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
DoCheck: Boolean): TGetResult;
begin
result := grOK;
case GetMode of
gmPrior: if FCursor <= 1 then
result := grBOF
else
Dec(FCursor);
gm: if FCursor >= RecordCount then
result := grEOF
else
Inc(FCursor);
gmCurrent: if (FCursor < 1) or (FCursor > RecordCount) then
Result := grError;
end;
if result = grOK then
with PRecordBuffer(Buffer)^ do
begin
RecordIndex := FCursor;
BookmarkFlag := bfCurrent;
end;
if (result = grError) and DoCheck then
DatabaseError('Ошибка в GetRecord()');
end;
function TMyDataSet.GetRecordCount: Integer;
begin
if Assigned(FPerformGetRecordCount) then
Result := FPerformGetRecordCount()
else
raise EDatabaseError.Create('Для работы с ' + ClassName
+ ' требуется задать обработчик события OnGetRecordCount!');
end;
procedure TMyDataSet.SetRecNo(Value: Integer);
begin
CheckBrowseMode;
if (Value < 1) or (Value >= RecordCount + 1) then
exit;
FCursor := Value;
Resync([])
end;
function TMyDataSet.GetRecNo: Integer;
begin
Result := PRecordBuffer(ActiveBuffer)^.RecordIndex + 1
end;
procedure TMyDataSet.InternalSetToRecord(Buffer: PChar);
begin
FCursor := PRecordBuffer(Buffer)^.RecordIndex;
end;
function TMyDataSet.AllocRecordBuffer: PChar;
begin
GetMem(result, sizeof(TRecordBuffer))
end;
procedure TMyDataSet.FreeRecordBuffer(var Buffer: PChar);
begin
FreeMem(Buffer)
end;
procedure TMyDataSet.InternalInitRecord(Buffer: PChar);
//Вообще-то, это просто операция очистки записи.
//Так как наш буфер не содержит указателей на динамически создаваемые
//структуры данных, то нам не нужно удалять структуры, связанные с
//предыдущим содержимым буфера. Но вот для поставщика это может быть
//необходимо, и его надо подробно уведомить о ситуации
begin
//Если это повторный вызов (когда TDataSet уже находится в одном из режимов
//редактирования) - такой выполняется при ClearFields - то надо просто
//очистить запись, в противном случае TDataSet мы хотим вставить новую
//запись, и поставщик должен сначала создать “плавающую” запись.
if not (State in dsEditModes) then
if Assigned(FPerformCreateFloatingRecord) then
FFloatingRecordIndex := FPerformCreateFloatingRecord(0);
if Assigned(FPerformClearFields) then
FPerformClearFields(PRecordBuffer(ActiveBuffer)^.RecordIndex);
end;
function TMyDataSet.GetCanModify: Boolean;
begin
if assigned(FPerformGetCanModify) then
result := FPerformGetCanModify
else
result := false
end;
function TMyDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
Index: integer;
begin
result := assigned(FPerformGetFieldData);
if (State in dsEditModes) and (ActiveBuffer = FEditingBuffer) then
Index := FFloatingRecordIndex //перенаправляем к “плавающей” записи
else
Index := PRecordBuffer(ActiveBuffer)^.RecordIndex;
if result then
FPerformGetFieldData(Index, Field, Buffer^);
end;
constructor TMyDataSet.Create(AOwner: TComponent);
begin
inherited;
FIsOpen := false;
if assigned(FPerformGetBookmarkSize) then
BookmarkSize := FPerformGetBookmarkSize()
else
BookmarkSize := 0;
end;
function TMyDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
begin
result := PRecordBuffer(Buffer)^.BookmarkFlag;
end;
procedure TMyDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
begin
PRecordBuffer(Buffer)^.BookmarkFlag := Value;
end;
procedure TMyDataSet.InternalPost;
begin
inherited; //=CheckRequiredFields
case State of
dsEdit:
if Assigned(FPerformDefloatRecord) then
FPerformDefloatRecord(FFloatingRecordIndex, FCursor, dmOverwrite);
dsInsert:
begin
if Assigned(FPerformDefloatRecord) then
FPerformDefloatRecord(FFloatingRecordIndex, FCursor, dmInsert);
PRecordBuffer(ActiveBuffer)^.RecordIndex := FCursor;
PRecordBuffer(ActiveBuffer)^.BookMarkFlag := bfCurrent;
end;
end;
end;
procedure TMyDataSet.SetFieldData(Field: TField; Buffer: Pointer);
begin
//Для этой операции Index всегда является индексом “плавающей” записи
//Перенаправляем изменения в Floating record
if Assigned(FPerformSetFieldData) then
FPerformSetFieldData(FFloatingRecordIndex, Field, Buffer^);
DataEvent(deFieldChange, cardinal(Field));
end;
procedure TMyDataSet.InternalDelete;
begin
if not Assigned(FPerformGetRecordCount) then
raise EDatabaseError.Create('Для работы с ' + ClassName
+ ' требуется задать обработчик события PerformGetRecordCount!');
if Assigned(FPerformDeleteRecord) then
FPerformDeleteRecord(PRecordBuffer(ActiveBuffer)^.RecordIndex);
if FCursor = FPerformGetRecordCount() then
Dec(FCursor);
end;
procedure TMyDataSet.InternalAddRecord(Buffer: Pointer; DoAppend: Boolean);
//Согласно справке, при вызове InsertRecord активной становится вставленная
//запись. Причем можно отследить, что заботиться об этом должна
//InternalAddRecord. Поэтому в случае DoAppend просто прыгаем в конец
//(вернее, за конец)
begin
//В момент вызова уже создана Floating-запись, и в нее скопированы значения
if DoAppend then
InternalLast;
FPerformDefloatRecord(FFloatingRecordIndex, FCursor, dmInsert);
end;
procedure TMyDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
var
res: string;
begin
if BookmarkSize = 0 then
exit;
if Assigned(FPerformGetBookmark) then
res := FPerformGetBookmark(PRecordBuffer(Buffer)^.RecordIndex)
else
res := '';
strpcopy(Data, res);
end;
procedure TMyDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin
if Assigned(FPerformSetBookmark) then
FPerformSetBookmark(PRecordBuffer(Buffer)^.RecordIndex, string(pchar(Data)))
end;
procedure TMyDataSet.InternalGotoBookmark(Bookmark: Pointer);
var
Pos: integer;
begin
if not assigned(FPerformFindBookmark) then
exit;
Pos := FPerformFindBookmark(string(Bookmark));
if Pos > -1 then
FCursor := Pos;
end;
function TMyDataSet.BookmarkValid(Bookmark: TBookmark): Boolean;
begin
result := assigned(FPerformFindBookmark);
if result then
result := (-1 <> FPerformFindBookmark(string(Bookmark)))
end;
procedure TMyDataSet.DoBeforeInsert;
begin
inherited;
FInsertingBefore := PRecordBuffer(ActiveBuffer)^.RecordIndex;
end;
procedure TMyDataSet.InternalInsert;
begin
FEditingBuffer := ActiveBuffer;
//Чтобы InternalSetToRecord переходил на правильную позицию
with PRecordBuffer(ActiveBuffer)^ do
if BookmarkFlag = bfInserted then
RecordIndex := FInsertingBefore;
//А если bfEOF или bfBOF, то InternalSetToRecord и не будет вызываться
end;
procedure TMyDataSet.InternalCancel;
begin
if Assigned(FPerformFreeFloatingRecord) then
FPerformFreeFloatingRecord(FFloatingRecordIndex);
end;
procedure TMyDataSet.InternalEdit;
begin
FEditingBuffer := ActiveBuffer;
if Assigned(FPerformCreateFloatingRecord) then
FFloatingRecordIndex :=
FPerformCreateFloatingRecord(PRecordBuffer(ActiveBuffer)^.RecordIndex);
end;
procedure TMyDataSet.SetActive(Value: Boolean);
begin
if (Value <> Active) and (Value = false) then
Finalize;
inherited;
end;
procedure TMyDataSet.Finalize;
begin
Cancel; //вдруг что-то редактировалось
end;
end.
А поставщик в нашем примере с адресной книгой может быть для такого упрощенного интерфейса реализован весьма несложно, например, так:
Листинг 4
unit MyData;
interface
uses Classes, DB, DataSet3, SysUtils;
type
TMyRecord = class
Name: string;
EMail: string;
Bookmark: pointer; //В нормальном состоянии - указатель на саму запись
constructor Create(sName, sEMail: string);
procedure Change(sName, sEMail: string);
end;
TMyData = class
List: TList;
constructor Create; reintroduce;
destructor Destroy; override;
procedure FillFieldDefs(FieldDefsRef: TFieldDefs);
procedure GetFieldData(Index: integer; Field: TField; out Data);
procedure SetFieldData(Index: integer; Field: TField; var Data);
function GetCanModify: boolean;
function GetRecordCount: integer;
procedure DeleteRecord(Index: integer);
procedure ClearFields(Index: integer);
function CreateFloatingRecord(SourceIndex: integer): integer;
procedure DefloatRecord(FlIndex, DestIndex: integer;
DefloatMode: TDefloatMode);
function GetBookmarkSize: integer;
function GetBookmark(Index: integer): TBookmarkStr;
procedure SetBookmark(Index: integer; NewBookmark: TBookmarkStr);
function FindBookmark(Bookmark: TBookmarkStr): integer;
end;
implementation
procedure TMyRecord.Change(sName, sEMail: string);
begin
Name := sName;
EMail := sEMail
end;
constructor TMyRecord.Create(sName, sEMail: string);
begin
inherited Create;
Change(sName, sEMail);
Bookmark := self;
end;
{ TMyData }
constructor TMyData.Create;
begin
List := TList.Create;
List.Add(TMyRecord.Create('Temporary', 'Temporary'));
//Первый элемент - место под “плавающую” запись
List.Add(TMyRecord.Create('Name1', 'email1'));
List.Add(TMyRecord.Create('Name2', 'email2'));
List.Add(TMyRecord.Create('Name3', 'email3'));
end;
destructor TMyData.Destroy;
var
i: integer;
begin
for i := 0 to List.Count - 1 do
TMyRecord(List[i]).free;
List.Free;
inherited;
end;
procedure TMyData.ClearFields(Index: integer);
begin
TMyRecord(List[0]).Name := '(name)';
TMyRecord(List[0]).EMail := '(email)';
end;
function TMyData.CreateFloatingRecord(SourceIndex: integer): integer;
begin
result := 0;
if SourceIndex <> 0 then
with TMyRecord(List[SourceIndex]) do
begin
TMyRecord(List[0]).Name := Name;
TMyRecord(List[0]).EMail := EMail
end;
end;
procedure TMyData.DefloatRecord(FlIndex, DestIndex: integer;
DefloatMode: TDefloatMode);
begin
if DefloatMode = dmInsert then
List.Insert(DestIndex, TMyRecord.Create(
TMyRecord(List[0]).Name, TMyRecord(List[0]).EMail))
//При этом автоматически ставится новый Bookmark
else
with TMyRecord(List[DestIndex]) do
begin
Name := TMyRecord(List[0]).Name;
Email := TMyRecord(List[0]).EMail
end;
end;
procedure TMyData.FillFieldDefs(FieldDefsRef: TFieldDefs);
begin
FieldDefsRef.Clear;
with FieldDefsRef.AddFieldDef do
begin
DataType := ftString;
FieldNo := 1;
Name := 'Имя';
Size := 40;
end;
with FieldDefsRef.AddFieldDef do
begin
DataType := ftString;
FieldNo := 2;
Name := 'E-Mail';
Size := 50;
end;
end;
procedure TMyData.DeleteRecord(Index: integer);
begin
List.Delete(Index)
end;
function TMyData.GetCanModify: boolean;
begin
result := true
end;
procedure TMyData.SetFieldData(Index: integer; Field: TField; var Data);
begin
case Field.FieldNo of
1: TMyRecord(List[Index]).Name := strpas(@Data);
2: TMyRecord(List[Index]).Email := strpas(@Data);
end;
end;
procedure TMyData.GetFieldData(Index: integer; Field: TField; out Data);
begin
case Field.FieldNo of
1: strpcopy(@Data, TMyRecord(List[Index]).Name);
2: strpcopy(@Data, TMyRecord(List[Index]).EMail);
end;
end;
function TMyData.GetRecordCount: integer;
begin
result := List.Count - 1; {0-й элемент не считаем}
end;
function TMyData.GetBookmarkSize: integer;
begin
result := 10; {'$xxxxxxxx'+NULL}
end;
procedure TMyData.SetBookmark(Index: integer; NewBookmark: TBookmarkStr);
begin
TMyRecord(List[Index]).BookMark := pointer(strtoint(NewBookmark))
end;
function TMyData.FindBookmark(Bookmark: TBookmarkStr): integer;
var
i: integer;
p: pointer;
begin
p := pointer(strtoint(pchar(Bookmark)));
result := -1;
for i := 1 to List.Count - 1 do
if TMyRecord(List[i]).Bookmark = p then
begin
result := i;
break
end;
end;
function TMyData.GetBookmark(Index: integer): TBookmarkStr;
begin
result := '$' + IntToHex(cardinal(TMyRecord(List[Index]).BookMark), 8)
end;
end.
interface
uses Classes, DB, DataSet3, SysUtils;
type
TMyRecord = class
Name: string;
EMail: string;
Bookmark: pointer; //В нормальном состоянии - указатель на саму запись
constructor Create(sName, sEMail: string);
procedure Change(sName, sEMail: string);
end;
TMyData = class
List: TList;
constructor Create; reintroduce;
destructor Destroy; override;
procedure FillFieldDefs(FieldDefsRef: TFieldDefs);
procedure GetFieldData(Index: integer; Field: TField; out Data);
procedure SetFieldData(Index: integer; Field: TField; var Data);
function GetCanModify: boolean;
function GetRecordCount: integer;
procedure DeleteRecord(Index: integer);
procedure ClearFields(Index: integer);
function CreateFloatingRecord(SourceIndex: integer): integer;
procedure DefloatRecord(FlIndex, DestIndex: integer;
DefloatMode: TDefloatMode);
function GetBookmarkSize: integer;
function GetBookmark(Index: integer): TBookmarkStr;
procedure SetBookmark(Index: integer; NewBookmark: TBookmarkStr);
function FindBookmark(Bookmark: TBookmarkStr): integer;
end;
implementation
procedure TMyRecord.Change(sName, sEMail: string);
begin
Name := sName;
EMail := sEMail
end;
constructor TMyRecord.Create(sName, sEMail: string);
begin
inherited Create;
Change(sName, sEMail);
Bookmark := self;
end;
{ TMyData }
constructor TMyData.Create;
begin
List := TList.Create;
List.Add(TMyRecord.Create('Temporary', 'Temporary'));
//Первый элемент - место под “плавающую” запись
List.Add(TMyRecord.Create('Name1', 'email1'));
List.Add(TMyRecord.Create('Name2', 'email2'));
List.Add(TMyRecord.Create('Name3', 'email3'));
end;
destructor TMyData.Destroy;
var
i: integer;
begin
for i := 0 to List.Count - 1 do
TMyRecord(List[i]).free;
List.Free;
inherited;
end;
procedure TMyData.ClearFields(Index: integer);
begin
TMyRecord(List[0]).Name := '(name)';
TMyRecord(List[0]).EMail := '(email)';
end;
function TMyData.CreateFloatingRecord(SourceIndex: integer): integer;
begin
result := 0;
if SourceIndex <> 0 then
with TMyRecord(List[SourceIndex]) do
begin
TMyRecord(List[0]).Name := Name;
TMyRecord(List[0]).EMail := EMail
end;
end;
procedure TMyData.DefloatRecord(FlIndex, DestIndex: integer;
DefloatMode: TDefloatMode);
begin
if DefloatMode = dmInsert then
List.Insert(DestIndex, TMyRecord.Create(
TMyRecord(List[0]).Name, TMyRecord(List[0]).EMail))
//При этом автоматически ставится новый Bookmark
else
with TMyRecord(List[DestIndex]) do
begin
Name := TMyRecord(List[0]).Name;
Email := TMyRecord(List[0]).EMail
end;
end;
procedure TMyData.FillFieldDefs(FieldDefsRef: TFieldDefs);
begin
FieldDefsRef.Clear;
with FieldDefsRef.AddFieldDef do
begin
DataType := ftString;
FieldNo := 1;
Name := 'Имя';
Size := 40;
end;
with FieldDefsRef.AddFieldDef do
begin
DataType := ftString;
FieldNo := 2;
Name := 'E-Mail';
Size := 50;
end;
end;
procedure TMyData.DeleteRecord(Index: integer);
begin
List.Delete(Index)
end;
function TMyData.GetCanModify: boolean;
begin
result := true
end;
procedure TMyData.SetFieldData(Index: integer; Field: TField; var Data);
begin
case Field.FieldNo of
1: TMyRecord(List[Index]).Name := strpas(@Data);
2: TMyRecord(List[Index]).Email := strpas(@Data);
end;
end;
procedure TMyData.GetFieldData(Index: integer; Field: TField; out Data);
begin
case Field.FieldNo of
1: strpcopy(@Data, TMyRecord(List[Index]).Name);
2: strpcopy(@Data, TMyRecord(List[Index]).EMail);
end;
end;
function TMyData.GetRecordCount: integer;
begin
result := List.Count - 1; {0-й элемент не считаем}
end;
function TMyData.GetBookmarkSize: integer;
begin
result := 10; {'$xxxxxxxx'+NULL}
end;
procedure TMyData.SetBookmark(Index: integer; NewBookmark: TBookmarkStr);
begin
TMyRecord(List[Index]).BookMark := pointer(strtoint(NewBookmark))
end;
function TMyData.FindBookmark(Bookmark: TBookmarkStr): integer;
var
i: integer;
p: pointer;
begin
p := pointer(strtoint(pchar(Bookmark)));
result := -1;
for i := 1 to List.Count - 1 do
if TMyRecord(List[i]).Bookmark = p then
begin
result := i;
break
end;
end;
function TMyData.GetBookmark(Index: integer): TBookmarkStr;
begin
result := '$' + IntToHex(cardinal(TMyRecord(List[Index]).BookMark), 8)
end;
end.
Для проверки работы можно использова&;#1090;ь все тот же небольшой проект, включив в Uses модуль DataSet3 вместо DataSet0, а также модуль MyData, и добавив подключение к нашему экземпляру TMyDataSet определенных в модуле MyData обработчиков событий. Для этого, конечно, потребуется создать экземпляр TMyData.
Заключение
Необходимо заметить, что приведенные примеры имеют своей целью лишь показать в минимальном объеме возможную реализацию потомка TDataSet и один из способов его адаптации к простым задачам, и ни в коей мере не претендуют на качественное решение возникающих задач (например, приведенный способ поиска записи по закладке на практике при больших объемах данных может оказаться непомерно медленным). Тем не менее, примеры рабочие.
Приведенной информации, на мой взгляд, достаточно, чтобы адаптировать свои структуры данных для работы с TDataSource и DB-Aware элементами управления. Конечно, на практике могут встретиться ситуации, требующие дополнительных усилий и реализации еще каких-либо действий (например, поиска записи по значению части ее полей, фильтрации записей и т.п.); смею надеяться, однако, что выполненная мною работа поможет и в этом, несколько развеяв туман вокруг внутренних взаимосвязей методов TDataSet и восполнив катастрофических масштабов недостаток документации по этой теме.
Отправить комментарий