home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / Chip_2003-01_cd1.bin / zkuste / delphi / kolekce / d567 / FLEXCEL.ZIP / FlexCel / UFlxMemTable.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-09-27  |  12.2 KB  |  474 lines

  1. unit UFlxMemTable;
  2.  
  3. interface
  4. {$R IFlxMemTable.res}
  5.  
  6. uses
  7.   {$IFDEF ConditionalExpressions}{$if CompilerVersion >= 14} variants,{$IFEND}{$ENDIF} //Delphi 6 or above
  8.   SysUtils, Classes, UXlsDB, UFlxMessages, Contnrs;
  9.  
  10. type
  11.   TFlxMemTable=class;
  12.   TFlxMemTableOnGetDataEvent=procedure (Sender: TObject; const FieldName: string; const RecordPos: integer; var Value: variant) of object;
  13.   TOnVirtualRecordCountEvent=procedure (Sender: TObject; var RecordCount: integer) of object;
  14.  
  15.   TFlxMemTableField=class(TInterfacedObject, IXlsField)
  16.   private
  17.     FMemTable: TFlxMemTable;
  18.     FieldIndex: integer;
  19.   public
  20.     constructor Create(const aMemTable: TFlxMemTable; const aFieldIndex: integer);
  21.     function Value: variant;
  22.     function DataSet: IXlsDataSet;
  23.     function IsTDateTimeField: boolean;
  24.     function IsTMemoField: boolean;
  25.     function AsFloat: extended;
  26.  
  27.     function DisplayName: string;
  28.   end;
  29.  
  30.   TFlxDbMemColumn = class (TCollectionItem)
  31.   private
  32.     FName: string;
  33.   protected
  34.     function GetDisplayName: string; override;
  35.     procedure SetDisplayName(const Value: string); override;
  36.   published
  37.     property Name: string read FName write SetDisplayName;
  38.   end;
  39.  
  40.   TFlxDbMemColumnList = class (TOwnedCollection)   //Items are TFlxDbMem
  41.   protected
  42.     procedure Update(Item: TCollectionItem); override;
  43.   public
  44.     function Find(const Name: string; var Index: integer): boolean;
  45.   end;
  46.  
  47.   TFlxRecord=class
  48.   public
  49.     Value: ArrayOfVariant;
  50.     constructor Create(const aValue: Array of Variant);
  51.   end;
  52.  
  53.   TFlxRecordList=class(TObjectList) //Items are TFlxRecord
  54.   {$INCLUDE TFlxRecordListHdr.inc}
  55.   private
  56.     FListName: string;
  57.     FPosition: integer;
  58.     function GetValue(FieldIndex: integer): variant;
  59.   public
  60.     constructor Create(const aListName: string);
  61.  
  62.     property Position: integer read FPosition;
  63.     procedure Clear; override;
  64.     property Value[FieldIndex: integer]: variant read GetValue;  //Don't allow modify...;
  65.  
  66.     property ListName:string read FListName;
  67.   end;
  68.  
  69.   TFlxMasterList=class(TObjectList)
  70.   private
  71.     function GetPosition(MasterCat: string): integer;
  72.     function GetValue(MasterCat: string; FieldIndex: integer): variant;
  73.     procedure SetPosition(MasterCat: string; const Value: integer);
  74.     function GetRecordCount(MasterCat: string): integer; //Records are TFlxRecordList
  75.   {$INCLUDE TFlxMasterListHdr.inc}
  76.   public
  77.     procedure AddRecord(const MasterCat: string; const Rec: TFlxRecord);
  78.     property Position[MasterCat:string]: integer read GetPosition write SetPosition;
  79.     property Value[MasterCat: string;FieldIndex: integer]: variant read GetValue;  //Don't allow modify...;
  80.     property RecordCount[MasterCat: string]: integer read GetRecordCount;
  81.   end;
  82.  
  83.   TFlxMemTable = class(TComponent, IUnknown, IXlsDataSet)
  84.   private
  85.     FOnLast: TNotifyEvent;
  86.     FOnNext: TNotifyEvent;
  87.     FOnFirst: TNotifyEvent;
  88.     FColumns: TFlxDbMemColumnList;
  89.     FData: TFlxMasterList;
  90.  
  91.     FActive: boolean;
  92.     FMasterTable: TFlxMemTable;
  93.     FMasterField: string;
  94.     FVirtualPos: integer;
  95.  
  96.  
  97.     FOnGetData: TFlxMemTableOnGetDataEvent;
  98.     FOnVirtualRecordCount: TOnVirtualRecordCountEvent;
  99.     function MastValue: variant;
  100.     procedure SetMasterField(const Value: string);
  101.     procedure SetMasterTable(const Value: TFlxMemTable);
  102.     function GetVirtualRecordCount: integer;
  103.     { Private declarations }
  104.   protected
  105.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  106.     { Protected declarations }
  107.   public
  108.     constructor Create(AOwner: TComponent);override;
  109.     destructor Destroy; override;
  110.  
  111.     procedure Clear;
  112.     procedure AddRecord(const aValues: Array of Variant);
  113.     { Public declarations }
  114.   published
  115.     property Columns: TFlxDbMemColumnList read FColumns write FColumns;
  116.     property MasterTable: TFlxMemTable read FMasterTable write SetMasterTable;
  117.     property MasterField: string read FMasterField write SetMasterField;
  118.  
  119.     //Events
  120.     property OnVirtualRecordCount: TOnVirtualRecordCountEvent read FOnVirtualRecordCount write FOnVirtualRecordCount;
  121.     property OnFirst: TNotifyEvent read FOnFirst write FOnFirst;
  122.     property OnNext: TNotifyEvent read FOnNext write FOnNext;
  123.     property OnLast: TNotifyEvent read FOnLast write FOnLast;
  124.     property OnGetData: TFlxMemTableOnGetDataEvent read FOnGetData write FOnGetData;
  125.     { Published declarations }
  126.  
  127.   //IXlsDataSet
  128.   public
  129.     function GetFields(index: integer): IXlsField;
  130.     function GetActive: boolean;
  131.  
  132.     procedure Open;
  133.     procedure Close;
  134.     property Active: boolean read GetActive;
  135.  
  136.     function RecordCount: integer;
  137.     procedure First;
  138.     procedure Next;
  139.     procedure Last;
  140.     function Eof: boolean;
  141.  
  142.     function DsName: string;
  143.  
  144.     function FieldByName(const Name: string): IXlsField;
  145.     function FieldCount: integer;
  146.   end;
  147.  
  148. procedure Register;
  149.  
  150. implementation
  151. {$INCLUDE TFlxRecordListImp.inc}
  152. {$INCLUDE TFlxMasterListImp.inc}
  153.  
  154. procedure Register;
  155. begin
  156.   RegisterComponents('FlexCel', [TFlxMemTable]);
  157. end;
  158.  
  159. { TFlxDbMemColumnList }
  160.  
  161.  
  162. function TFlxDbMemColumnList.Find(const Name: string;
  163.   var Index: integer): boolean;
  164. var
  165.   i: integer;
  166. begin
  167.   for i := 0 to Count - 1 do
  168.     if AnsiCompareText(TFlxDbMemColumn(Items[i]).Name, Name) = 0 then
  169.     begin
  170.       Result:=true;
  171.       Index:=i;
  172.       exit;
  173.     end;
  174.   Result:=false;
  175. end;
  176.  
  177. procedure TFlxDbMemColumnList.Update(Item: TCollectionItem);
  178. begin
  179.   inherited;
  180.   (GetOwner as TFlxMemTable).Clear;
  181. end;
  182.  
  183. { TFlxDbMemColumn }
  184.  
  185. function TFlxDbMemColumn.GetDisplayName: string;
  186. begin
  187.   Result:=FName;
  188. end;
  189.  
  190. procedure TFlxDbMemColumn.SetDisplayName(const Value: string);
  191. var
  192.   i: integer;
  193. begin
  194.   if (Collection as TFlxDbMemColumnList).Find(Value, i) and (i<>Index) then
  195.     raise Exception.CreateFmt(ErrDupField, [Value]);
  196.   FName:=Value;
  197. end;
  198.  
  199. { TFlxMemTable }
  200.  
  201. procedure TFlxMemTable.AddRecord(const aValues: Array of Variant);
  202. var
  203.   Index: integer;
  204.   Mv: variant;
  205. begin
  206.   if Length(aValues)<>Columns.Count then raise Exception.Create(ErrInvalidColumnCount);
  207.  
  208.   if not FColumns.Find(FMasterField, Index) then Mv:=unassigned else
  209.     Mv:=aValues[Index];
  210.  
  211.   FData.AddRecord(Mv, TFlxRecord.Create(aValues));
  212. end;
  213.  
  214. procedure TFlxMemTable.Clear;
  215. begin
  216.   FData.Clear;
  217.   FVirtualPos:=0;
  218. end;
  219.  
  220. procedure TFlxMemTable.Close;
  221. begin
  222.   FActive:=false;
  223. end;
  224.  
  225. constructor TFlxMemTable.Create(AOwner: TComponent);
  226. begin
  227.   inherited;
  228.   FColumns:= TFlxDbMemColumnList.Create(Self, TFlxDbMemColumn);
  229.   FData:=TFlxMasterList.Create;
  230.   FActive:=true;
  231.   FVirtualPos:=0;
  232. end;
  233.  
  234. destructor TFlxMemTable.Destroy;
  235. begin
  236.   FreeAndNil(FData);
  237.   FreeAndNil(FColumns);
  238.   inherited;
  239. end;
  240.  
  241. function TFlxMemTable.DsName: string;
  242. begin
  243.   Result:=Name;
  244. end;
  245.  
  246. function TFlxMemTable.Eof: boolean;
  247. begin
  248.   if Assigned(FOnGetData) then Result:=FVirtualPos>=GetVirtualRecordCount else
  249.     Result:=FData.Position[MastValue]>=FData.RecordCount[MastValue];
  250. end;
  251.  
  252. function TFlxMemTable.FieldByName(const Name: string): IXlsField;
  253. var
  254.   Index: integer;
  255. begin
  256.   if not FColumns.Find(Name, Index) then raise Exception.CreateFmt(ErrFieldNotFound, [Name]);
  257.   Result:=TFlxMemTableField.Create(Self, Index);
  258. end;
  259.  
  260. function TFlxMemTable.FieldCount: integer;
  261. begin
  262.   Result:=FColumns.Count;
  263. end;
  264.  
  265. procedure TFlxMemTable.First;
  266. begin
  267.   FVirtualPos:=0;
  268.   FData.Position[MastValue]:=0;
  269.   if Assigned(FOnFirst) then FOnFirst(Self);
  270. end;
  271.  
  272. function TFlxMemTable.GetActive: boolean;
  273. begin
  274.   Result:=FActive;
  275. end;
  276.  
  277. function TFlxMemTable.GetFields(index: integer): IXlsField;
  278. begin
  279.   Result:=TFlxMemTableField.Create(Self, Index);
  280. end;
  281.  
  282. function TFlxMemTable.GetVirtualRecordCount: integer;
  283. begin
  284.   Result:=0;
  285.   if Assigned(FOnVirtualRecordCount) then FOnVirtualRecordCount(Self, Result);
  286. end;
  287.  
  288. procedure TFlxMemTable.Last;
  289. begin
  290.   if FData.RecordCount[MastValue]>0 then FData.Position[MastValue]:=FData.RecordCount[MastValue]-1 else
  291.   FData.Position[MastValue]:=0;
  292.  
  293.   if GetVirtualRecordCount>0 then FVirtualPos:=GetVirtualRecordCount-1 else FVirtualPos:=0;
  294.  
  295.   if Assigned(FOnLast) then FOnLast(Self);
  296. end;
  297.  
  298. function TFlxMemTable.MastValue: variant;
  299. begin
  300.   if FMasterTable=nil then Result:=unassigned else
  301.     Result:=FMasterTable.FieldByName(FMasterField).Value;
  302. end;
  303.  
  304. procedure TFlxMemTable.Next;
  305. begin
  306.   FData.Position[MastValue]:=FData.Position[MastValue]+1;
  307.   inc(FVirtualPos);
  308.   if Assigned(FOnNext) then FOnNext(Self);
  309. end;
  310.  
  311. procedure TFlxMemTable.Notification(AComponent: TComponent;
  312.   Operation: TOperation);
  313. begin
  314.   inherited Notification(AComponent, Operation);
  315.   if Operation = opRemove then
  316.   begin
  317.     if AComponent = FMasterTable then FMasterTable:= nil;
  318.   end;
  319. end;
  320.  
  321. procedure TFlxMemTable.Open;
  322. begin
  323.   FActive:=True;
  324.   FVirtualPos:=0;
  325. end;
  326.  
  327. function TFlxMemTable.RecordCount: integer;
  328. begin
  329.   if Assigned(FOnGetData) then Result:=GetVirtualRecordCount else
  330.     Result:=FData.RecordCount[MastValue];
  331. end;
  332.  
  333. procedure TFlxMemTable.SetMasterField(const Value: string);
  334. var
  335.   Index: integer;
  336. begin
  337.   if Value<>'' then if not FColumns.Find(Value, Index) then raise Exception.CreateFmt(ErrFieldNotFound, [Value]);
  338.   if FMasterField<>Value then Clear;
  339.   FMasterField := Value;
  340. end;
  341.  
  342. procedure TFlxMemTable.SetMasterTable(const Value: TFlxMemTable);
  343. var
  344.   IDs: IXlsDataSet;
  345.   IValue:IUnknown;
  346. begin
  347.   if Value<>nil then
  348.   begin
  349.     IValue:=Value;
  350.     if not Supports(IValue, IXlsDataSet, IDs) then raise Exception.CreateFmt(ErrComponentIsNotXlsDataSet, [Value.Name]);
  351.   end;
  352.   FMasterTable := Value;
  353. end;
  354.  
  355. { TFlxRecordList }
  356.  
  357. procedure TFlxRecordList.Clear;
  358. begin
  359.   inherited;
  360.   FPosition:=0;
  361. end;
  362.  
  363. constructor TFlxRecordList.Create(const aListName: string);
  364. begin
  365.   inherited Create;
  366.   FListName:=aListName;
  367. end;
  368.  
  369. function TFlxRecordList.GetValue(FieldIndex: integer): variant;
  370. begin
  371.   if (Position<0)or (Position>=Count) then Result:=Unassigned else
  372.     Result:=Items[Position].Value[FieldIndex];
  373. end;
  374.  
  375. { TFlxMemTableField }
  376.  
  377. function TFlxMemTableField.AsFloat: extended;
  378. begin
  379.   Result:=Value;
  380. end;
  381.  
  382. constructor TFlxMemTableField.Create(const aMemTable: TFlxMemTable; const aFieldIndex: integer);
  383. begin
  384.   FMemTable:=aMemTable;
  385.   FIeldIndex:=aFieldIndex;
  386. end;
  387.  
  388. function TFlxMemTableField.DataSet: IXlsDataSet;
  389. begin
  390.   Result:=FMemTable;
  391. end;
  392.  
  393. function TFlxMemTableField.DisplayName: string;
  394. begin
  395.   Result:=(FMemTable.Columns.Items[FieldIndex] as TFlxDbMemColumn).Name;
  396. end;
  397.  
  398. function TFlxMemTableField.IsTDateTimeField: boolean;
  399. begin
  400.   Result:=VarType(Value) = VarDate;
  401. end;
  402.  
  403. function TFlxMemTableField.IsTMemoField: boolean;
  404. begin
  405.   Result:=false;
  406. end;
  407.  
  408. function TFlxMemTableField.Value: variant;
  409. var
  410.   aValue: variant;
  411. begin
  412.   if Assigned(FMemTable.FOnGetData) then
  413.   begin
  414.     aValue:=unassigned;
  415.     FMemTable.FOnGetData(FMemTable, DisplayName, FMemTable.FVirtualPos, aValue);
  416.     Result:=aValue;
  417.   end else
  418.     Result:=FMemTable.FData.Value[FMemTable.MastValue, FieldIndex];
  419. end;
  420.  
  421. { TFlxRecord }
  422.  
  423. constructor TFlxRecord.Create(const aValue: Array of Variant);
  424. var
  425.   i: integer;
  426. begin
  427.   inherited Create;
  428.   SetLength(Value, Length(aValue));
  429.   for i:=0 to Length(aValue)-1 do Value[i]:=aValue[i];
  430. end;
  431.  
  432. { TFlxMasterList }
  433.  
  434. procedure TFlxMasterList.AddRecord(const MasterCat: string;
  435.   const Rec: TFlxRecord);
  436. var
  437.   Index: integer;
  438. begin
  439.   if not Find(MasterCat, Index) then Insert(Index, TFlxRecordList.Create(MasterCat));
  440.   Items[Index].Add(Rec);
  441. end;
  442.  
  443. function TFlxMasterList.GetPosition(MasterCat: string): integer;
  444. var
  445.   Index: integer;
  446. begin
  447.   if not Find(MasterCat, Index) then Result:=0 else Result:= Items[Index].Position;
  448. end;
  449.  
  450. function TFlxMasterList.GetRecordCount(MasterCat: string): integer;
  451. var
  452.   Index: integer;
  453. begin
  454.   if not Find(MasterCat, Index) then Result:=0 else Result:= Items[Index].Count;
  455. end;
  456.  
  457. function TFlxMasterList.GetValue(MasterCat: string;
  458.   FieldIndex: integer): variant;
  459. var
  460.   Index: integer;
  461. begin
  462.   if not Find(MasterCat, Index) then Result:=unassigned else Result:= Items[Index].Value[FieldIndex];
  463. end;
  464.  
  465. procedure TFlxMasterList.SetPosition(MasterCat: string;
  466.   const Value: integer);
  467. var
  468.   Index: integer;
  469. begin
  470.   if Find(MasterCat, Index) then Items[Index].FPosition:=Value;
  471. end;
  472.  
  473. end.
  474.