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