1{
2    This file is part of the Free Component Library.
3    Copyright (c) 2017 Michael Van Canneyt, member of the Free Pascal development team
4
5    Report Data loop classes based on TDataset.
6
7    See the file COPYING.FPC, included in this distribution,
8    for details about the copyright.
9
10    This program is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13
14 **********************************************************************}
15unit fpreportdb;
16
17{$mode objfpc}{$H+}
18
19interface
20
21uses
22  Classes, SysUtils, fpreport, db;
23
24Type
25
26  { TFPReportDatasetData }
27
28  TFPReportDatasetData = class(TFPReportData)
29  private
30    FDataSet: TDataSet;
31    procedure SetDataSet(AValue: TDataSet);
32  protected
33    function GetIsOpened: boolean; override;
34    Procedure Notification(AComponent: TComponent; Operation: TOperation); override;
35    procedure DoGetValue(const AFieldName: string; var AValue: variant); override;
36    procedure DoInitDataFields; override;
37    procedure DoOpen; override;
38    procedure DoFirst; override;
39    procedure DoNext; override;
40    procedure DoClose; override;
41    function  DoEOF: boolean; override;
42  Public
43    property  DataFields;
44    Procedure StartDesigning; override;
45    Procedure EndDesigning; override;
46  published
47    property  DataSet: TDataSet read FDataSet write SetDataSet;
48  end;
49
50implementation
51
52resourcestring
53  SErrNoDataSetAssigned  = 'No dataset has been assigned.';
54  SErrDatasetNotOpen = 'Dataset has not been opened yet';
55  SErrFieldTypeMisMatch = 'Field type for field "%s" changed. Expected "%s", got "%s"';
56  SErrUnknownFieldInDataset = 'Unexpected field in dataset: "%s"';
57
58{ TFPReportDatasetData }
59
60procedure TFPReportDatasetData.SetDataSet(AValue: TDataSet);
61begin
62  if FDataSet=AValue then Exit;
63  if Assigned(FDataset) then
64    FDataset.RemoveFreeNotification(Self);
65  FDataSet:=AValue;
66  if Assigned(FDataset) then
67    FDataset.FreeNotification(Self);
68end;
69
70function TFPReportDatasetData.GetIsOpened: boolean;
71begin
72  Result:=inherited GetIsOpened;
73  if Result then
74    Result:=FDataset.Active; // Can be closed because of master-detail.
75end;
76
77procedure TFPReportDatasetData.Notification(AComponent: TComponent; Operation: TOperation);
78begin
79  inherited Notification(AComponent, Operation);
80  if (Operation=opRemove) and (AComponent=FDataset) then
81    FDataset:=Nil;
82end;
83
84procedure TFPReportDatasetData.DoGetValue(const AFieldName: string; var AValue: variant);
85var
86  ms: TMemoryStream;
87begin
88  inherited DoGetValue(AFieldName, AValue);
89  try
90    if FieldTypes[AFieldName] = rfkStream then
91    begin
92      ms := TMemoryStream.Create;
93      try
94        TBlobField(FDataSet.FieldByName(AFieldName)).SaveToStream(ms);
95        AValue := FPReportStreamToMIMEEncodeString(ms);
96      finally
97        ms.Free;
98      end;
99    end
100    else
101    begin
102      AValue := FDataSet.FieldByName(AFieldName).Value;
103    end;
104  except
105    on E: EDatabaseError do
106    begin
107      // no nothing - it's probably an expression, which will be handled in CustomBand.ExpandMacro()
108    end;
109  end;
110end;
111
112procedure TFPReportDatasetData.DoInitDataFields;
113var
114  i: integer;
115
116  function DatabaseKindToReportKind(const AType: TFieldType): TFPReportFieldKind;
117  begin
118    case AType of
119      ftUnknown:        Result := rfkString;
120      ftString:         Result := rfkString;
121      ftSmallint:       Result := rfkInteger;
122      ftInteger:        Result := rfkInteger;
123      ftWord:           Result := rfkInteger;
124      ftBoolean:        Result := rfkBoolean;
125      ftFloat:          Result := rfkFloat;
126      ftCurrency:       Result := rfkCurrency;
127      ftBCD:            Result := rfkFloat;
128      ftDate:           Result := rfkDateTime;
129      ftTime:           Result := rfkDateTime;
130      ftDateTime:       Result := rfkDateTime;
131      ftBytes:          Result := rfkStream;
132      ftVarBytes:       Result := rfkStream;
133      ftAutoInc:        Result := rfkInteger;
134      ftBlob:           Result := rfkStream;
135      ftMemo:           Result := rfkStream;
136      ftGraphic:        Result := rfkStream;
137      ftFmtMemo:        Result := rfkString;
138      //ftParadoxOle:
139      //ftDBaseOle:
140      ftTypedBinary:    Result := rfkStream;
141      //ftCursor:
142      ftFixedChar:      Result := rfkString;
143      ftWideString:     Result := rfkString;
144      ftLargeint:       Result := rfkInteger;
145      //ftADT:
146      //ftArray:
147      //ftReference:
148      //ftDataSet:
149      ftOraBlob:        Result := rfkStream;
150      ftOraClob:        Result := rfkStream;
151      ftVariant:        Result := rfkString;
152      //ftInterface:
153      //ftIDispatch:
154      ftGuid:           Result := rfkString;
155      ftTimeStamp:      Result := rfkDateTime;
156      //ftFMTBcd:
157      ftFixedWideChar:  Result := rfkString;
158      ftWideMemo:       Result := rfkString;
159      else
160        Result := rfkString;
161    end;
162  end;
163
164Var
165  B,AllowNew : Boolean;
166  F : TFPReportDataField;
167  Rfk  : TFPReportFieldKind;
168
169begin
170  inherited DoInitDataFields;
171  B:=FDataset.FieldDefs.Count=0;
172  if B then
173    FDataset.Open;
174  try
175     if (DataFields.Count>0) and (DataFields.Count<>FDataset.FieldDefs.Count) then
176       // Reset totally
177       DataFields.Clear;
178    AllowNew:=(Datafields.Count=0);
179    for i := 0 to FDataSet.FieldDefs.Count-1 do
180      begin
181      RFK:=DatabaseKindToReportKind(FDataset.FieldDefs[i].DataType);
182      F:=Datafields.FindField(FDataset.FieldDefs[i].Name);
183      if (F=Nil) then
184        if AllowNew then
185          DataFields.AddField(FDataset.FieldDefs[i].Name, RFK)
186        else
187          Raise EReportError.CreateFmt(SErrUnknownFieldInDataset,[F.FieldName])
188      else
189        if (F.FieldKind<>RFK) then
190          Raise EReportError.CreateFmt(SErrFieldTypeMisMatch,[F.FieldName,ReportFieldKindNames[F.FieldKind],ReportFieldKindNames[RFK]]);
191      end
192  finally
193    if B then
194      FDataset.Close;
195  end;
196end;
197
198procedure TFPReportDatasetData.DoOpen;
199begin
200  inherited DoOpen;
201  if not Assigned(FDataSet) then
202    ReportError(SErrNoDataSetAssigned);
203  FDataSet.Open;
204end;
205
206procedure TFPReportDatasetData.DoFirst;
207begin
208  if not Assigned(FDataSet) then
209    ReportError(SErrNoDataSetAssigned);
210  if not FDataSet.Active then
211    ReportError(SErrDatasetNotOpen);
212  inherited DoFirst;
213  FDataSet.First;
214end;
215
216procedure TFPReportDatasetData.DoNext;
217begin
218  inherited DoNext;
219  FDataSet.Next;
220end;
221
222procedure TFPReportDatasetData.DoClose;
223begin
224  inherited DoClose;
225  FDataSet.Close;
226end;
227
228function TFPReportDatasetData.DoEOF: boolean;
229begin
230  Result := FDataSet.EOF;
231end;
232
233Type
234  TMyDataset = Class(TDataset);
235
236procedure TFPReportDatasetData.StartDesigning;
237
238begin
239  Inherited;
240  if Assigned(DataSet) then
241    // Dirty hack!!
242    TMyDataset(Dataset).SetDesigning(True,True);
243end;
244
245procedure TFPReportDatasetData.EndDesigning;
246begin
247  if Assigned(DataSet) then
248    // Dirty hack!!
249    TMyDataset(Dataset).SetDesigning(False,True);
250  Inherited;
251end;
252
253end.
254
255