Chip 2003 January/Chip_2003-01_cd1.bin/zkuste/delphi/kolekce/d567/FLEXCEL.ZIP/FlexCel/UFlxMemTable.pas

Pascal/Delphi Source File | 2002-09-27 | 12.2 KB | 474 lines

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.