home *** CD-ROM | disk | FTP | other *** search
/ Chip 2003 January / Chip_2003-01_cd1.bin / zkuste / delphi / kolekce / d567 / FLEXCEL.ZIP / XLSAdapter / UXlsDBTemplateStore.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-09-26  |  3.5 KB  |  148 lines
  1. unit UXlsDBTemplateStore;
  2.  
  3. interface
  4.  
  5. uses
  6.   DB, SysUtils, Classes, XlsBaseTemplateStore, contnrs, XlsMessages;
  7.  
  8. type
  9.   TNamedStorageList= class
  10.     Name: string;
  11.     StList: TXlsStorageList;
  12.     constructor Create( const aName: string; const aStList: TXlsStorageList);
  13.     destructor Destroy;override;
  14.   end;
  15.  
  16.   TStorageListCache = class(TObjectList)
  17.     {$INCLUDE TStorageListCacheHdr.inc}
  18.   end;
  19.  
  20.   TXlsDBTemplateStore = class(TXlsBaseTemplateStore)
  21.   private
  22.     FDataSet: TDataSet;
  23.     FNameField: TField;
  24.     FDataField: TBlobField;
  25.  
  26.     StorageCache: TStorageListCache;
  27.     { Private declarations }
  28.   protected
  29.     function GetStorages(Name: string): TXlsStorageList;override;
  30.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  31.     { Protected declarations }
  32.   public
  33.     constructor Create(AOwner: TComponent);override;
  34.     destructor Destroy;override;
  35.     procedure ClearCache;
  36.     { Public declarations }
  37.   published
  38.     property DataSet: TDataSet read FDataSet write FDataSet;
  39.     property NameField: TField read FNameField write FNameField;
  40.     property DataField: TBlobField read FDataField write FDataField;
  41.     { Published declarations }
  42.   end;
  43.  
  44. procedure Register;
  45. implementation
  46. {$R XlsDBTemplateStore.res}
  47.  
  48. {$INCLUDE TStorageListCacheImp.inc}
  49.  
  50. procedure Register;
  51. begin
  52.   RegisterComponents('FlexCel', [TXlsDBTemplateStore]);
  53. end;
  54.  
  55. constructor TNamedStorageList.Create( const aName: string; const aStList: TXlsStorageList);
  56. begin
  57.   inherited Create;
  58.   Name:=aName;
  59.   StList:=aStList;
  60. end;
  61.  
  62. destructor TNamedStorageList.Destroy;
  63. begin
  64.   FreeAndNil(StList);
  65.   inherited;
  66. end;
  67.  
  68.  
  69. constructor TXlsDBTemplateStore.Create(AOwner: TComponent);
  70. begin
  71.   inherited Create(AOwner);
  72.   StorageCache:= TStorageListCache.Create;
  73. end;
  74.  
  75. destructor TXlsDBTemplateStore.Destroy;
  76. begin
  77.   FreeAndNil(StorageCache);
  78.   inherited;
  79. end;
  80.  
  81. procedure TXlsDBTemplateStore.Notification(AComponent: TComponent; Operation: TOperation);
  82. begin
  83.   inherited Notification(AComponent, Operation);
  84.   if Operation = opRemove then
  85.   begin
  86.     if AComponent = FDataSet then
  87.         FDataSet:= nil;
  88.     if AComponent = FNameField then
  89.         FNameField:= nil;
  90.     if AComponent = FDataField then
  91.         FDataField:= nil;
  92.   end;
  93. end;
  94.  
  95. function TXlsDBTemplateStore.GetStorages(Name: string): TXlsStorageList;
  96. var
  97.   k: integer;
  98.   Sl:TXlsStorageList;
  99.   Ms: TMemoryStream;
  100. begin
  101.   if StorageCache.Find(Name, k) then
  102.   begin
  103.     Result:= StorageCache[k].StList;
  104.     exit;
  105.   end;
  106.  
  107.   //This is an unoptimized routine and should be only used as an example
  108.   //In 'real world' you should use an sql dataset, and fetch only the report needed
  109.   DataSet.Open;
  110.   try
  111.     if not Assigned(DataSet) then raise Exception.Create(ErrNoDataSet);
  112.     DataSet.First;
  113.     while not DataSet.Eof do if FNameField.Value= Name then
  114.     begin
  115.       Sl:=TXlsStorageList.Create;
  116.       try
  117.         Ms:=TMemoryStream.Create;
  118.         try
  119.           FDataField.SaveToStream (Ms);
  120.           Ms.Position:=0;
  121.           Sl.ReadData(Ms);
  122.         finally
  123.           FreeAndNil(Ms);
  124.         end;
  125.         StorageCache.Add(TNamedStorageList.Create(Name, Sl));
  126.       except
  127.         FreeAndNil(Sl);
  128.         raise;
  129.       end; //except;
  130.  
  131.       Result:=Sl;
  132.       exit;
  133.     end;
  134.  
  135.   finally
  136.     DataSet.Close;
  137.   end; //finally
  138.  
  139.   raise Exception.CreateFmt(ErrReportNotFound, [Name]);
  140. end;
  141.  
  142. procedure TXlsDBTemplateStore.ClearCache;
  143. begin
  144.   StorageCache.Clear;
  145. end;
  146.  
  147. end.
  148.