* При перепечатке материалов ссылка на www.SeoLiga.ru обязательна!
Упрощение интерфейса
31 марта 2009
Когда я только начинал писать эту статью, основной моей целью было показать, что интерфейс между 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 в вызовы вышеперечисленных событий. Особо следует пояснить понятие “плавающей” записи. Предполагается, что поставщик не считывает записи набора в какие-то свои кэш-буферы, а читает содержимое полей прямо из набора. В случае чтения это работает, но в случае редактирования записей производимые изменения следует где-то накапливать, то есть в этой ситуации временное хранилище создавать придется. Однако, есть способ упростить эту операцию. Хранилище можно (так как одновременно при таком подходе будет использоваться не более одного хранилища) реализовать в виде, например, какого-то зарезервированного элемента набора (массива, списка). Соответственно, можно сделать единообразным доступ как к записям набора, так и к этому хранилищу. Когда поступает запрос на начало редактирования существующей записи или на добавление новой, у поставщика запрашивается создание такого хранилища. В ответ поставщик возвращает число – это может быть, например, номер зарезервированной записи, или вообще любой номер такой, что в дальнейшем поставщик будет в состоянии понять, что этот номер относится именно к хранилищу. Таким образом, роль хранилища с точки зрения нашего потомка 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); gmNext: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; //Спасибо Александру Калабухову (kavlad) за предложенную им коррекцию // поведения класса при пустом наборе данных var Index: Integer; begin Result := not Self.IsEmpty and Assigned(FPerformGetFieldData); //Если набор пустой, то просматривается фиктивная «пустая» запись //В этом случае сигнализируем, что никакие данные не прочитаны if Result then //Если же все в порядке, то ... begin if (State in dsEditModes) and (ActiveBuffer = FEditingBuffer) then Index := FFloatingRecordIndex //перенаправляем к “плавающей” записи else Index := PRecordBuffer(ActiveBuffer)^.RecordIndex; FPerformGetFieldData(Index, Field, Buffer^); end; 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 FCursor:=FPerformGetRecordCount(); 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;
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. Для проверки работы можно использовать все тот же небольшой проект, включив в Uses модуль DataSet3 вместо DataSet0, а также модуль MyData, и добавив подключение к нашему экземпляру TMyDataSet определенных в модуле MyData обработчиков событий. Для этого, конечно, потребуется создать экземпляр TMyData.
