Mega Code Archive
Collection Dataset an object oriented database
<![CDATA[
Title: Collection Dataset an object oriented database
Question: Incapsulating a collection in a TDataset decendant.
Enabling to save and load diferent datasets bij loading and saving component resources
Answer:
I have writen a TDataset descendant that allows a collection to be set as property so it will do the deletes inserts and updates for you with a little help from the Data aware controls in delphi
I made an example that saves some master detail data .
In my example i'll show you how i use the dataset in design time so i can set the fields displaylength and it's displayLabel
For those cracks that do not need an example here's the compleet code of the object.
For those who do just download the sample .
And of course do not forget to vote or leave a message :) ..
Greatings all and keep up the good work.
unit CollectionDataSet;
interface
uses
DB, Classes, typinfo, dialogs;
type
PRecInfo = ^TRecInfo;
TRecInfo = packed record
Bookmark: Integer;
BookmarkFlag: TBookmarkFlag;
end;
{ TCollectionDataSet }
TCollectionDataSet = class(TDataSet)
private
FRecBufSize: Integer;
FRecInfoOfs: Integer;
FCurRec: Integer;
FFileName: string;
FLastBookmark: Integer;
FCollection: TCollection;
FCollectionCount: Integer;
procedure SetCollection(const Value: TCollection);
protected
function AllocRecordBuffer: PChar; override;
procedure FreeRecordBuffer(var Buffer: PChar); override;
procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
function GetRecordSize: Word; override;
procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
procedure InternalClose; override;
procedure InternalCancel; override;
procedure InternalDelete; override;
procedure InternalFirst; override;
procedure InternalGotoBookmark(Bookmark: Pointer); override;
procedure InternalHandleException; override;
procedure InternalInitFieldDefs; override;
procedure InternalInitRecord(Buffer: PChar); override;
procedure InternalLast; override;
procedure InternalOpen; override;
procedure InternalPost; override;
procedure InternalSetToRecord(Buffer: PChar); override;
function IsCursorOpen: Boolean; override;
procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
procedure SetFieldData(Field: TField; Buffer: Pointer); override;
function GetRecordCount: Integer; override;
function GetRecNo: Integer; override;
procedure SetRecNo(Value: Integer); override;
public
function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
property Collection: TCollection read FCollection write SetCollection;
published
property FileName: string read FFileName write FFileName;
property Active;
property AutoCalcFields;
property BeforeOpen;
property AfterOpen;
property BeforeClose;
property AfterClose;
property BeforeInsert;
property AfterInsert;
property BeforeEdit;
property AfterEdit;
property BeforePost;
property AfterPost;
property BeforeCancel;
property AfterCancel;
property BeforeDelete;
property AfterDelete;
property BeforeScroll;
property AfterScroll;
property BeforeRefresh;
property AfterRefresh;
property OnCalcFields;
property OnDeleteError;
property OnEditError;
property OnFilterRecord;
property OnNewRecord;
property OnPostError;
end;
procedure Register;
implementation
uses Windows, SysUtils, Forms;
{ TCollectionDataSet }
procedure TCollectionDataSet.InternalOpen;
begin
if Collection = nil then raise EDatabaseError.Create('Collection is niet gevult !');
FCurRec := -1;
FCollectionCount := Collection.Count;
FLastBookmark := Collection.Count;
FRecInfoOfs := SizeOf(Integer);
FRecBufSize := SizeOf(TRecInfo) + FRecInfoOfs;
BookmarkSize := SizeOf(Integer);
InternalInitFieldDefs;
if DefaultFields then CreateFields;
BindFields(True);
end;
procedure TCollectionDataSet.InternalClose;
begin
if DefaultFields then DestroyFields;
FLastBookmark := 0;
FCurRec := -1;
end;
function TCollectionDataSet.IsCursorOpen: Boolean;
begin
Result := Assigned(collection);
end;
procedure TCollectionDataSet.InternalInitFieldDefs;
var
PropList: PPropList;
PropCount: Integer;
ClassTypeInfo: PTypeInfo;
ClassTypeData: PTypeData;
i: integer;
begin
FieldDefs.Clear;
if Collection = nil then raise EInvalidPointer.create('Collection is nil');
ClassTypeInfo := Collection.ItemClass.ClassInfo;
ClassTypeData := GetTypeData(ClassTypeInfo);
PropCount := ClassTypeData.PropCount - 1;
// reserveer geheugen
GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
// Error trap
try
// Vul de prop list
GetPropList(Collection.ItemClass.ClassInfo, tkAny, PropList);
for i := 0 to PropCount do begin
try
case PropList[i]^.PropType^.Kind of
tkString, tkLString,
tkWString, tkWChar,
tkChar: begin
FieldDefs.Add(PropList[i]^.Name, ftString, 255, False);
end;
tkInteger,
tkEnumeration: begin
FieldDefs.Add(PropList[i]^.Name, ftInteger, 0, False);
end;
tkFloat: begin
FieldDefs.Add(PropList[i]^.Name, ftFloat, 0, False);
end;
tkClass: begin
end;
tkArray: begin
end;
end; // end case
except
on e: Exception do
end;
end;
finally
FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
end;
end;
procedure TCollectionDataSet.InternalHandleException;
begin
Application.HandleException(Self);
end;
procedure TCollectionDataSet.InternalGotoBookmark(Bookmark: Pointer);
var
Index: Integer;
begin
Index := PInteger(Bookmark)^ - 1;
if Index -1 then
FCurRec := Index else
DatabaseError('Bookmark not found');
end;
procedure TCollectionDataSet.InternalSetToRecord(Buffer: PChar);
begin
InternalGotoBookmark(@PRecInfo(Buffer + FRecInfoOfs).Bookmark);
end;
function TCollectionDataSet.GetBookmarkFlag(Buffer: PChar): TBookmarkFlag;
begin
Result := PRecInfo(Buffer + FRecInfoOfs).BookmarkFlag;
end;
procedure TCollectionDataSet.SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag);
begin
PRecInfo(Buffer + FRecInfoOfs).BookmarkFlag := Value;
end;
procedure TCollectionDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
begin
PInteger(Data)^ := PRecInfo(Buffer + FRecInfoOfs).Bookmark;
end;
procedure TCollectionDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
begin
PRecInfo(Buffer + FRecInfoOfs).Bookmark := PInteger(Data)^;
end;
function TCollectionDataSet.GetRecordSize: Word;
begin
Result := SizeOf(Integer); //MaxStrLen;
end;
function TCollectionDataSet.AllocRecordBuffer: PChar;
begin
GetMem(Result, FRecBufSize);
end;
procedure TCollectionDataSet.FreeRecordBuffer(var Buffer: PChar);
begin
FreeMem(Buffer, FRecBufSize);
end;
function TCollectionDataSet.GetRecord(Buffer: PChar; GetMode: TGetMode;
DoCheck: Boolean): TGetResult;
begin
if Collection.Count Result := grEOF else begin
Result := grOK;
case GetMode of
gmNext:
if FCurRec = RecordCount - 1 then
Result := grEOF else
Inc(FCurRec);
gmPrior:
if FCurRec Result := grBOF else
Dec(FCurRec);
gmCurrent:
if (FCurRec = RecordCount) then
Result := grError;
end;
if Result = grOK then begin
PInteger(Buffer)^ := Integer(FCollection.Items[FCurRec]);
with PRecInfo(Buffer + FRecInfoOfs)^ do begin
BookmarkFlag := bfCurrent;
Bookmark := FCurRec + 1;
end;
end else
if (Result = grError) and DoCheck then DatabaseError('No Records');
end;
end;
procedure TCollectionDataSet.InternalInitRecord(Buffer: PChar);
begin
PInteger(Buffer)^ := Integer(FCollection.Add);
end;
function TCollectionDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
var
Apropinfo: PPropinfo;
AString: string;
AInteger: Integer;
AFloat: Double;
AItem: TCollectionItem;
begin
Result := False;
if Collection.Count = 0 then exit;
AItem := TCollectionItem(PInteger(ActiveBuffer)^);
Apropinfo := typinfo.GetPropInfo(AItem, Field.FullName);
case Apropinfo.PropType^.Kind of
tkString, tkLString,
tkWString, tkWChar,
tkChar: begin
AString := GetStrProp(AItem, Apropinfo);
StrLCopy(Buffer, PChar(AString), Length(AString));
Result := PChar(Buffer)^ #0;
end;
tkInteger,
tkEnumeration: begin
AInteger := GetOrdProp(AItem, Apropinfo);
PInteger(Buffer)^ := AInteger;
Result := true;
end;
tkFloat: begin
AFloat := GetFloatProp(AItem, Apropinfo);
PDouble(Buffer)^ := AFloat;
Result := true;
end;
end; // end case
end;
procedure TCollectionDataSet.SetFieldData(Field: TField; Buffer: Pointer);
var
Apropinfo: PPropinfo;
AString: string;
AInteger: Integer;
AFloat: Double;
AItem: TCollectionItem;
begin
AItem := TCollectionItem(PInteger(ActiveBuffer)^);
Apropinfo := typinfo.GetPropInfo(AItem, Field.FullName);
case Apropinfo.PropType^.Kind of
tkString, tkLString,
tkWString, tkWChar,
tkChar: begin
AString := PChar(Buffer);
SetStrProp(AItem, Apropinfo, AString);
end;
tkInteger,
tkEnumeration: begin
AInteger := 0;
if Buffer nil then
AInteger := PInteger(Buffer)^;
SetOrdProp(AItem, Apropinfo, AInteger);
end;
tkFloat: begin
AFloat := 0;
if Buffer nil then
AFloat := PDouble(Buffer)^;
SetFloatProp(AItem, Apropinfo, AFloat);
end;
end; // end case
DataEvent(deFieldChange, Longint(Field));
end;
procedure TCollectionDataSet.InternalFirst;
begin
FCurRec := -1;
end;
procedure TCollectionDataSet.InternalLast;
begin
FCurRec := FCollectionCount;
end;
procedure TCollectionDataSet.InternalPost;
begin
if State = dsinsert then begin
Inc(FCollectionCount);
Inc(FLastBookmark);
if FCurRec -1 then
TCollectionItem(PInteger(ActiveBuffer)^).Index := FCurRec;
end;
end;
procedure TCollectionDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
begin
Inc(FLastBookmark);
if Append then InternalLast;
Inc(FCollectionCount);
end;
procedure TCollectionDataSet.InternalDelete;
begin
Collection.Delete(FCurRec);
Dec(FCollectionCount);
if FCurRec = Collection.Count then
Dec(FCurRec);
end;
function TCollectionDataSet.GetRecordCount: Longint;
begin
Result := FCollectionCount;
end;
function TCollectionDataSet.GetRecNo: Longint;
begin
UpdateCursorPos;
if (FCurRec 0) then
Result := 0 else
Result := FCurRec + 1;
end;
procedure TCollectionDataSet.SetRecNo(Value: Integer);
begin
if (Value = 0) and (Value FCurRec := Value - 1;
Resync([]);
end;
end;
procedure TCollectionDataSet.SetCollection(const Value: TCollection);
begin
FCollection := Value;
end;
procedure TCollectionDataSet.InternalCancel;
begin
Collection.Delete(Collection.Count - 1);
end;
end.
]]>