home *** CD-ROM | disk | FTP | other *** search
- unit UFlxMemTable;
-
- interface
- {$R IFlxMemTable.res}
-
- uses
- {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants,{$IFEND}{$ENDIF} //Delphi 6 or above
- SysUtils, Classes, UXlsDB, UFlxMessages, Contnrs;
-
- type
- TFlxMemTable=class;
- TFlxMemTableOnGetDataEvent=procedure (Sender: TObject; const FieldName: string; const RecordPos: integer; var Value: variant) of object;
- TOnVirtualRecordCountEvent=procedure (Sender: TObject; var RecordCount: integer) of object;
-
- TFlxMemTableField=class(TInterfacedObject, IXlsField)
- private
- FMemTable: TFlxMemTable;
- FieldIndex: integer;
- public
- constructor Create(const aMemTable: TFlxMemTable; const aFieldIndex: integer);
- function Value: variant;
- function DataSet: IXlsDataSet;
- function IsTDateTimeField: boolean;
- function IsTMemoField: boolean;
- function AsFloat: extended;
-
- function DisplayName: string;
- end;
-
- TFlxDbMemColumn = class (TCollectionItem)
- private
- FName: string;
- protected
- function GetDisplayName: string; override;
- procedure SetDisplayName(const Value: string); override;
- published
- property Name: string read FName write SetDisplayName;
- end;
-
- TFlxDbMemColumnList = class (TOwnedCollection) //Items are TFlxDbMem
- protected
- procedure Update(Item: TCollectionItem); override;
- public
- function Find(const Name: string; var Index: integer): boolean;
- end;
-
- TFlxRecord=class
- public
- Value: ArrayOfVariant;
- constructor Create(const aValue: Array of Variant);
- end;
-
- TFlxRecordList=class(TObjectList) //Items are TFlxRecord
- {$INCLUDE TFlxRecordListHdr.inc}
- private
- FListName: string;
- FPosition: integer;
- function GetValue(FieldIndex: integer): variant;
- public
- constructor Create(const aListName: string);
-
- property Position: integer read FPosition;
- procedure Clear; override;
- property Value[FieldIndex: integer]: variant read GetValue; //Don't allow modify...;
-
- property ListName:string read FListName;
- end;
-
- TFlxMasterList=class(TObjectList)
- private
- function GetPosition(MasterCat: string): integer;
- function GetValue(MasterCat: string; FieldIndex: integer): variant;
- procedure SetPosition(MasterCat: string; const Value: integer);
- function GetRecordCount(MasterCat: string): integer; //Records are TFlxRecordList
- {$INCLUDE TFlxMasterListHdr.inc}
- public
- procedure AddRecord(const MasterCat: string; const Rec: TFlxRecord);
- property Position[MasterCat:string]: integer read GetPosition write SetPosition;
- property Value[MasterCat: string;FieldIndex: integer]: variant read GetValue; //Don't allow modify...;
- property RecordCount[MasterCat: string]: integer read GetRecordCount;
- end;
-
- TFlxMemTable = class(TComponent, IUnknown, IXlsDataSet)
- private
- FOnLast: TNotifyEvent;
- FOnNext: TNotifyEvent;
- FOnFirst: TNotifyEvent;
- FColumns: TFlxDbMemColumnList;
- FData: TFlxMasterList;
-
- FActive: boolean;
- FMasterTable: TFlxMemTable;
- FMasterField: string;
- FVirtualPos: integer;
-
-
- FOnGetData: TFlxMemTableOnGetDataEvent;
- FOnVirtualRecordCount: TOnVirtualRecordCountEvent;
- function MastValue: variant;
- procedure SetMasterField(const Value: string);
- procedure SetMasterTable(const Value: TFlxMemTable);
- function GetVirtualRecordCount: integer;
- { Private declarations }
- protected
- procedure Notification(AComponent: TComponent; Operation: TOperation); override;
- { Protected declarations }
- public
- constructor Create(AOwner: TComponent);override;
- destructor Destroy; override;
-
- procedure Clear;
- procedure AddRecord(const aValues: Array of Variant);
- { Public declarations }
- published
- property Columns: TFlxDbMemColumnList read FColumns write FColumns;
- property MasterTable: TFlxMemTable read FMasterTable write SetMasterTable;
- property MasterField: string read FMasterField write SetMasterField;
-
- //Events
- property OnVirtualRecordCount: TOnVirtualRecordCountEvent read FOnVirtualRecordCount write FOnVirtualRecordCount;
- property OnFirst: TNotifyEvent read FOnFirst write FOnFirst;
- property OnNext: TNotifyEvent read FOnNext write FOnNext;
- property OnLast: TNotifyEvent read FOnLast write FOnLast;
- property OnGetData: TFlxMemTableOnGetDataEvent read FOnGetData write FOnGetData;
- { Published declarations }
-
- //IXlsDataSet
- public
- 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;
-
- procedure Register;
-
- implementation
- {$INCLUDE TFlxRecordListImp.inc}
- {$INCLUDE TFlxMasterListImp.inc}
-
- procedure Register;
- begin
- RegisterComponents('FlexCel', [TFlxMemTable]);
- end;
-
- { TFlxDbMemColumnList }
-
-
- function TFlxDbMemColumnList.Find(const Name: string;
- var Index: integer): boolean;
- var
- i: integer;
- begin
- for i := 0 to Count - 1 do
- if AnsiCompareText(TFlxDbMemColumn(Items[i]).Name, Name) = 0 then
- begin
- Result:=true;
- Index:=i;
- exit;
- end;
- Result:=false;
- end;
-
- procedure TFlxDbMemColumnList.Update(Item: TCollectionItem);
- begin
- inherited;
- (GetOwner as TFlxMemTable).Clear;
- end;
-
- { TFlxDbMemColumn }
-
- function TFlxDbMemColumn.GetDisplayName: string;
- begin
- Result:=FName;
- end;
-
- procedure TFlxDbMemColumn.SetDisplayName(const Value: string);
- var
- i: integer;
- begin
- if (Collection as TFlxDbMemColumnList).Find(Value, i) and (i<>Index) then
- raise Exception.CreateFmt(ErrDupField, [Value]);
- FName:=Value;
- end;
-
- { TFlxMemTable }
-
- procedure TFlxMemTable.AddRecord(const aValues: Array of Variant);
- var
- Index: integer;
- Mv: variant;
- begin
- if Length(aValues)<>Columns.Count then raise Exception.Create(ErrInvalidColumnCount);
-
- if not FColumns.Find(FMasterField, Index) then Mv:=unassigned else
- Mv:=aValues[Index];
-
- FData.AddRecord(Mv, TFlxRecord.Create(aValues));
- end;
-
- procedure TFlxMemTable.Clear;
- begin
- FData.Clear;
- FVirtualPos:=0;
- end;
-
- procedure TFlxMemTable.Close;
- begin
- FActive:=false;
- end;
-
- constructor TFlxMemTable.Create(AOwner: TComponent);
- begin
- inherited;
- FColumns:= TFlxDbMemColumnList.Create(Self, TFlxDbMemColumn);
- FData:=TFlxMasterList.Create;
- FActive:=true;
- FVirtualPos:=0;
- end;
-
- destructor TFlxMemTable.Destroy;
- begin
- FreeAndNil(FData);
- FreeAndNil(FColumns);
- inherited;
- end;
-
- function TFlxMemTable.DsName: string;
- begin
- Result:=Name;
- end;
-
- function TFlxMemTable.Eof: boolean;
- begin
- if Assigned(FOnGetData) then Result:=FVirtualPos>=GetVirtualRecordCount else
- Result:=FData.Position[MastValue]>=FData.RecordCount[MastValue];
- end;
-
- function TFlxMemTable.FieldByName(const Name: string): IXlsField;
- var
- Index: integer;
- begin
- if not FColumns.Find(Name, Index) then raise Exception.CreateFmt(ErrFieldNotFound, [Name]);
- Result:=TFlxMemTableField.Create(Self, Index);
- end;
-
- function TFlxMemTable.FieldCount: integer;
- begin
- Result:=FColumns.Count;
- end;
-
- procedure TFlxMemTable.First;
- begin
- FVirtualPos:=0;
- FData.Position[MastValue]:=0;
- if Assigned(FOnFirst) then FOnFirst(Self);
- end;
-
- function TFlxMemTable.GetActive: boolean;
- begin
- Result:=FActive;
- end;
-
- function TFlxMemTable.GetFields(index: integer): IXlsField;
- begin
- Result:=TFlxMemTableField.Create(Self, Index);
- end;
-
- function TFlxMemTable.GetVirtualRecordCount: integer;
- begin
- Result:=0;
- if Assigned(FOnVirtualRecordCount) then FOnVirtualRecordCount(Self, Result);
- end;
-
- procedure TFlxMemTable.Last;
- begin
- if FData.RecordCount[MastValue]>0 then FData.Position[MastValue]:=FData.RecordCount[MastValue]-1 else
- FData.Position[MastValue]:=0;
-
- if GetVirtualRecordCount>0 then FVirtualPos:=GetVirtualRecordCount-1 else FVirtualPos:=0;
-
- if Assigned(FOnLast) then FOnLast(Self);
- end;
-
- function TFlxMemTable.MastValue: variant;
- begin
- if FMasterTable=nil then Result:=unassigned else
- Result:=FMasterTable.FieldByName(FMasterField).Value;
- end;
-
- procedure TFlxMemTable.Next;
- begin
- FData.Position[MastValue]:=FData.Position[MastValue]+1;
- inc(FVirtualPos);
- if Assigned(FOnNext) then FOnNext(Self);
- end;
-
- procedure TFlxMemTable.Notification(AComponent: TComponent;
- Operation: TOperation);
- begin
- inherited Notification(AComponent, Operation);
- if Operation = opRemove then
- begin
- if AComponent = FMasterTable then FMasterTable:= nil;
- end;
- end;
-
- procedure TFlxMemTable.Open;
- begin
- FActive:=True;
- FVirtualPos:=0;
- end;
-
- function TFlxMemTable.RecordCount: integer;
- begin
- if Assigned(FOnGetData) then Result:=GetVirtualRecordCount else
- Result:=FData.RecordCount[MastValue];
- end;
-
- procedure TFlxMemTable.SetMasterField(const Value: string);
- var
- Index: integer;
- begin
- if Value<>'' then if not FColumns.Find(Value, Index) then raise Exception.CreateFmt(ErrFieldNotFound, [Value]);
- if FMasterField<>Value then Clear;
- FMasterField := Value;
- end;
-
- procedure TFlxMemTable.SetMasterTable(const Value: TFlxMemTable);
- var
- IDs: IXlsDataSet;
- IValue:IUnknown;
- begin
- if Value<>nil then
- begin
- IValue:=Value;
- if not Supports(IValue, IXlsDataSet, IDs) then raise Exception.CreateFmt(ErrComponentIsNotXlsDataSet, [Value.Name]);
- end;
- FMasterTable := Value;
- end;
-
- { TFlxRecordList }
-
- procedure TFlxRecordList.Clear;
- begin
- inherited;
- FPosition:=0;
- end;
-
- constructor TFlxRecordList.Create(const aListName: string);
- begin
- inherited Create;
- FListName:=aListName;
- end;
-
- function TFlxRecordList.GetValue(FieldIndex: integer): variant;
- begin
- if (Position<0)or (Position>=Count) then Result:=Unassigned else
- Result:=Items[Position].Value[FieldIndex];
- end;
-
- { TFlxMemTableField }
-
- function TFlxMemTableField.AsFloat: extended;
- begin
- Result:=Value;
- end;
-
- constructor TFlxMemTableField.Create(const aMemTable: TFlxMemTable; const aFieldIndex: integer);
- begin
- FMemTable:=aMemTable;
- FIeldIndex:=aFieldIndex;
- end;
-
- function TFlxMemTableField.DataSet: IXlsDataSet;
- begin
- Result:=FMemTable;
- end;
-
- function TFlxMemTableField.DisplayName: string;
- begin
- Result:=(FMemTable.Columns.Items[FieldIndex] as TFlxDbMemColumn).Name;
- end;
-
- function TFlxMemTableField.IsTDateTimeField: boolean;
- begin
- Result:=VarType(Value) = VarDate;
- end;
-
- function TFlxMemTableField.IsTMemoField: boolean;
- begin
- Result:=false;
- end;
-
- function TFlxMemTableField.Value: variant;
- var
- aValue: variant;
- begin
- if Assigned(FMemTable.FOnGetData) then
- begin
- aValue:=unassigned;
- FMemTable.FOnGetData(FMemTable, DisplayName, FMemTable.FVirtualPos, aValue);
- Result:=aValue;
- end else
- Result:=FMemTable.FData.Value[FMemTable.MastValue, FieldIndex];
- end;
-
- { TFlxRecord }
-
- constructor TFlxRecord.Create(const aValue: Array of Variant);
- var
- i: integer;
- begin
- inherited Create;
- SetLength(Value, Length(aValue));
- for i:=0 to Length(aValue)-1 do Value[i]:=aValue[i];
- end;
-
- { TFlxMasterList }
-
- procedure TFlxMasterList.AddRecord(const MasterCat: string;
- const Rec: TFlxRecord);
- var
- Index: integer;
- begin
- if not Find(MasterCat, Index) then Insert(Index, TFlxRecordList.Create(MasterCat));
- Items[Index].Add(Rec);
- end;
-
- function TFlxMasterList.GetPosition(MasterCat: string): integer;
- var
- Index: integer;
- begin
- if not Find(MasterCat, Index) then Result:=0 else Result:= Items[Index].Position;
- end;
-
- function TFlxMasterList.GetRecordCount(MasterCat: string): integer;
- var
- Index: integer;
- begin
- if not Find(MasterCat, Index) then Result:=0 else Result:= Items[Index].Count;
- end;
-
- function TFlxMasterList.GetValue(MasterCat: string;
- FieldIndex: integer): variant;
- var
- Index: integer;
- begin
- if not Find(MasterCat, Index) then Result:=unassigned else Result:= Items[Index].Value[FieldIndex];
- end;
-
- procedure TFlxMasterList.SetPosition(MasterCat: string;
- const Value: integer);
- var
- Index: integer;
- begin
- if Find(MasterCat, Index) then Items[Index].FPosition:=Value;
- end;
-
- end.
-