PageRenderTime 24ms CodeModel.GetById 21ms app.highlight 1ms RepoModel.GetById 1ms app.codeStats 0ms

/Source/FR_DBSET.PAS

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