home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d6 / FRCLX.ZIP / SOURCE / FR_DBSet.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-30  |  5KB  |  206 lines
  1.  
  2. {******************************************}
  3. {                                          }
  4. {           FastReport CLX v2.4            }
  5. {            Report DB dataset             }
  6. {                                          }
  7. { Copyright (c) 1998-2001 by Tzyganenko A. }
  8. {                                          }
  9. {******************************************}
  10.  
  11. unit FR_DBSet;
  12.  
  13. interface
  14.  
  15. {$I FR.inc}
  16.  
  17. uses
  18.   SysUtils, Classes, FR_DBRel, FR_DSet, DB;
  19.  
  20. type
  21.   TfrDBDataSet = class(TfrDataset)
  22.   private
  23. {$IFDEF IBO}
  24.     FDataSet: TIB_DataSet;
  25.     FDataSource: TIB_DataSource;
  26. {$ELSE}
  27.     FDataSet: TDataSet;
  28.     FDataSource: TDataSource;
  29. {$ENDIF}
  30.     FOpenDataSource, FCloseDataSource: Boolean;
  31.     FOnOpen, FOnClose: TNotifyEvent;
  32.     FBookmark: TfrBookmark;
  33.     FEof: Boolean;
  34. {$IFDEF IBO}
  35.     procedure SetDataSet(Value: TIB_DataSet);
  36.     procedure SetDataSource(Value: TIB_DataSource);
  37. {$ELSE}
  38.     procedure SetDataSet(Value: TDataSet);
  39.     procedure SetDataSource(Value: TDataSource);
  40. {$ENDIF}
  41.   protected
  42.     procedure Notification(AComponent: TComponent;
  43.                            Operation: TOperation); override;
  44.   public
  45.     constructor Create(AOwner: TComponent); override;
  46.     procedure Init; override;
  47.     procedure Exit; override;
  48.     procedure First; override;
  49.     procedure Next; override;
  50.     procedure Prior; override;
  51.     procedure Open;
  52.     procedure Close;
  53.     function Eof: Boolean; override;
  54.     function GetDataSet: TfrTDataSet;
  55.   published
  56.     property CloseDataSource: Boolean read FCloseDataSource write FCloseDataSource default False;
  57. {$IFDEF IBO}
  58.     property DataSet: TIB_DataSet read FDataSet write SetDataSet;
  59.     property DataSource: TIB_DataSource read FDataSource write SetDataSource;
  60. {$ELSE}
  61.     property DataSet: TDataSet read FDataSet write SetDataSet;
  62.     property DataSource: TDataSource read FDataSource write SetDataSource;
  63. {$ENDIF}
  64.     property OpenDataSource: Boolean read FOpenDataSource write FOpenDataSource default True;
  65.     property RangeBegin;
  66.     property RangeEnd;
  67.     property RangeEndCount;
  68.     property OnCheckEOF;
  69.     property OnClose: TNotifyEvent read FOnClose write FOnClose;
  70.     property OnFirst;
  71.     property OnNext;
  72.     property OnPrior;
  73.     property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
  74.   end;
  75.  
  76.  
  77. implementation
  78.  
  79. uses FR_Class;
  80.  
  81. type
  82.   EDSError = class(Exception);
  83.  
  84. constructor TfrDBDataSet.Create(AOwner: TComponent);
  85. begin
  86.   inherited Create(AOwner);
  87.   FOpenDataSource := True;
  88. end;
  89.  
  90. procedure TfrDBDataSet.Notification(AComponent: TComponent; Operation: TOperation);
  91. begin
  92.   inherited Notification(AComponent, Operation);
  93.   if Operation = opRemove then
  94.     if AComponent = FDataSource then
  95.       FDataSource := nil
  96.     else if AComponent = FDataSet then
  97.       FDataSet := nil
  98. end;
  99.  
  100. {$IFDEF IBO}
  101. procedure TfrDBDataSet.SetDataSet(Value: TIB_DataSet);
  102. {$ELSE}
  103. procedure TfrDBDataSet.SetDataSet(Value: TDataSet);
  104. {$ENDIF}
  105. begin
  106.   FDataSet := Value;
  107.   FDataSource := nil;
  108. end;
  109.  
  110. {$IFDEF IBO}
  111. procedure TfrDBDataSet.SetDataSource(Value: TIB_DataSource);
  112. {$ELSE}
  113. procedure TfrDBDataSet.SetDataSource(Value: TDataSource);
  114. {$ENDIF}
  115. begin
  116.   FDataSource := Value;
  117.   if Value <> nil then
  118.     FDataSet := nil;
  119. end;
  120.  
  121. function TfrDBDataSet.GetDataSet: TfrTDataSet;
  122. begin
  123.   if (FDataSource <> nil) and (FDataSource.DataSet <> nil) then
  124.     Result := TfrTDataSet(FDataSource.DataSet)
  125.   else if FDataSet <> nil then
  126.     Result := TfrTDataSet(FDataSet)
  127.   else
  128.   begin
  129.     raise EDSError.Create('TfrDBDataset ' + Name + ' is not assigned to TDataSet.');
  130.     Result := nil;
  131.   end;
  132. end;
  133.  
  134. procedure TfrDBDataSet.Init;
  135. begin
  136.   Open;
  137.   FBookmark := frGetBookmark(TfrTDataSet(GetDataSet));
  138.   FEof := False;
  139. end;
  140.  
  141. procedure TfrDBDataSet.Exit;
  142. begin
  143.   if FBookMark <> frEmptyBookmark then
  144.   begin
  145.     if (FRangeBegin = rbCurrent) or (FRangeEnd = reCurrent) then
  146.       frGotoBookmark(TfrTDataSet(GetDataSet), FBookmark);
  147.     frFreeBookmark(TfrTDataSet(GetDataSet), FBookmark);
  148.   end;
  149.   FBookMark := frEmptyBookmark;
  150.   Close;
  151. end;
  152.  
  153. procedure TfrDBDataSet.First;
  154. begin
  155.   if FRangeBegin = rbFirst then
  156.     GetDataSet.First
  157.   else if FRangeBegin = rbCurrent then
  158.     frGotoBookmark(GetDataSet, FBookmark);
  159.   FEof := False;
  160.   inherited First;
  161. end;
  162.  
  163. procedure TfrDBDataSet.Next;
  164. var
  165.   b: TfrBookmark;
  166. begin
  167.   FEof := False;
  168.   if FRangeEnd = reCurrent then
  169.   begin
  170.     b := frGetBookmark(GetDataSet);
  171.     if frIsBookmarksEqual(GetDataSet, b, FBookmark) then
  172.       FEof := True;
  173.     frFreeBookmark(GetDataSet, b);
  174.     System.Exit;
  175.   end;
  176.   GetDataSet.Next;
  177.   inherited Next;
  178. end;
  179.  
  180. procedure TfrDBDataSet.Prior;
  181. begin
  182.   GetDataSet.Prior;
  183.   inherited Prior;
  184. end;
  185.  
  186. function TfrDBDataSet.Eof: Boolean;
  187. begin
  188.   Result := inherited Eof or GetDataSet.Eof or FEof;
  189. end;
  190.  
  191. procedure TfrDBDataSet.Open;
  192. begin
  193.   if FOpenDataSource then GetDataSet.Open;
  194.   if Assigned(FOnOpen) then FOnOpen(Self);
  195. end;
  196.  
  197. procedure TfrDBDataSet.Close;
  198. begin
  199.   if Assigned(FOnClose) then FOnClose(Self);
  200.   if FCloseDataSource then GetDataSet.Close;
  201. end;
  202.  
  203.  
  204.  
  205. end.
  206.