home *** CD-ROM | disk | FTP | other *** search
- unit UXlsTDataSet;
-
- interface
- uses SysUtils, UXlsDB, DB, UFlxMessages;
- type
- TRecordCountProc= function (const DB: TDataSet): integer of object;
-
- TXlsTDataSet=class(TInterfacedObject , IXlsDataSet)
- private
- FDataSet: TDataSet;
- FRecordCount: TRecordCountProc;
- public
- constructor Create(const aDataSet: TDataSet; const aRecordCount: TRecordCountProc);
-
- function GetFields(index: integer): IXlsField;
- function GetActive: boolean;
-
- procedure Open;
- procedure Close;
- property Active: boolean read GetActive;
-
- function RecordCount: integer;
- procedure First;
- procedure Next;
- procedure Last;
- function Eof: boolean;
-
- function DsName: string;
-
- function FieldByName(const Name: string): IXlsField;
- function FieldCount: integer;
- end;
-
- TXlsTField = class (TInterfacedObject, IXlsField)
- private
- FField: TField;
- FParentDataSet: IXlsDataSet;
- public
- constructor Create(const aField: TField; const aParentDataSet: IXlsDataSet);
- function Value: variant;
- function DataSet: IXlsDataSet;
- function IsTDateTimeField: boolean;
- function IsTMemoField: boolean;
- function AsFloat: extended;
-
- function DisplayName: string;
- end;
-
- implementation
-
- { TXlsTDataSet }
-
- procedure TXlsTDataSet.Close;
- begin
- FDataSet.Close;
- end;
-
- constructor TXlsTDataSet.Create(const aDataSet: TDataSet; const aRecordCount: TRecordCountProc);
- begin
- inherited Create;
- if aDataSet=nil then Raise Exception.CreateFmt(ErrNoDataSet,['']);
- FDataSet:=aDataSet;
- FRecordCount:=aRecordCount;
- end;
-
- function TXlsTDataSet.DsName: string;
- begin
- Result:=FDataSet.Name;
- end;
-
- function TXlsTDataSet.Eof: boolean;
- begin
- Result:=FDataSet.Eof;
- end;
-
- function TXlsTDataSet.FieldByName(const Name: string): IXlsField;
- begin
- Result:=TXlsTField.Create(FDataSet.FieldByName(Name), Self);
- end;
-
- function TXlsTDataSet.FieldCount: integer;
- begin
- Result:= FDataSet.FieldCount;
- end;
-
- procedure TXlsTDataSet.First;
- begin
- FDataSet.First;
- end;
-
- function TXlsTDataSet.GetActive: boolean;
- begin
- Result:=FDataSet.Active;
- end;
-
- function TXlsTDataSet.GetFields(index: integer): IXlsField;
- begin
- Result:=TXlsTField.Create(FDataSet.Fields[Index], Self);
- end;
-
- procedure TXlsTDataSet.Last;
- begin
- FDataSet.Last;
- end;
-
- procedure TXlsTDataSet.Next;
- begin
- FDataSet.Next;
- end;
-
- procedure TXlsTDataSet.Open;
- begin
- FDataSet.Open;
- end;
-
- function TXlsTDataSet.RecordCount: integer;
- begin
- Result:=FRecordCount(FDataSet);
- end;
-
- { TXlsTField }
-
- function TXlsTField.AsFloat: extended;
- begin
- Result:=FField.AsFloat;
- end;
-
- constructor TXlsTField.Create(const aField: TField; const aParentDataSet: IXlsDataSet);
- begin
- if aField=nil then raise Exception.Create(ErrFieldNil);
- FField:=aField;
- FParentDataSet:=aParentDataSet;
- end;
-
- function TXlsTField.DataSet: IXlsDataSet;
- begin
- Result:=FParentDataSet;
- end;
-
- function TXlsTField.DisplayName: string;
- begin
- Result:=FField.DisplayName;
- end;
-
- function TXlsTField.IsTDateTimeField: boolean;
- begin
- Result:=FField is TDateTimeField;
- end;
-
- function TXlsTField.IsTMemoField: boolean;
- begin
- Result:=FField is TMemoField;
- end;
-
- function TXlsTField.Value: variant;
- begin
- Result:=FField.Value;
- end;
-
- end.
-