1 {
2
3 *****************************************************************************
4 See the file COPYING.modifiedLGPL.txt, included in this distribution,
5 for details about the license.
6 *****************************************************************************
7
8 Authors: Alexander Klenin
9
10 }
11 unit TADbSource;
12
13 {$H+}
14 {$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
15 interface
16
17 uses
18 Classes, Db, TAChartUtils, TACustomSource;
19
20 type
21
22 TDbChartSourceOptions = set of (dcsoDateTimeX, dcsoDateTimeY);
23
24 TDbChartSource = class;
25
26 TDbChartSourceGetItemEvent = procedure (
27 ASender: TDbChartSource; var AItem: TChartDataItem) of object;
28
29 { TDbChartSource }
30
31 TDbChartSource = class(TCustomChartSource)
32 strict private
33 FBookmark: TBookmark;
34 FCurItem: TChartDataItem;
35 FDataLink: TDataLink;
36 FDateTimeFormat: String;
37 FFieldColor: String;
38 FFieldText: String;
39 FFieldX: String;
40 FFieldY: String;
41 FFieldXList: TStringList;
42 FFieldYList: TStringList;
43 FOnGetItem: TDbChartSourceGetItemEvent;
44 FOptions: TDbChartSourceOptions;
45
GetDataSourcenull46 function GetDataSource: TDataSource; inline;
47 procedure SetDataSource(AValue: TDataSource);
48 procedure SetFieldColor(const AValue: String);
49 procedure SetFieldText(const AValue: String);
50 procedure SetFieldX(const AValue: String);
51 procedure SetFieldY(const AValue: String);
52 procedure SetOnGetItem(AValue: TDbChartSourceGetItemEvent);
53 procedure SetOptions(AValue: TDbChartSourceOptions);
54 protected
GetCountnull55 function GetCount: Integer; override;
GetItemnull56 function GetItem(AIndex: Integer): PChartDataItem; override;
57 procedure SetXCount(AValue: Cardinal); override;
58 procedure SetYCount(AValue: Cardinal); override;
59 public
60 constructor Create(AOwner: TComponent); override;
61 destructor Destroy; override;
62 public
63 procedure AfterDraw; override;
64 procedure BeforeDraw; override;
DataSetnull65 function DataSet: TDataSet; inline;
66 procedure DefaultGetItem(var AItem: TChartDataItem);
67 procedure Reset;
68 published
69 property DataSource: TDataSource read GetDataSource write SetDataSource;
70 property DateTimeFormat: String read FDateTimeFormat write FDateTimeFormat;
71 property FieldColor: String read FFieldColor write SetFieldColor;
72 property FieldText: String read FFieldText write SetFieldText;
73 property FieldX: String read FFieldX write SetFieldX;
74 property FieldY: String read FFieldY write SetFieldY;
75 property Options: TDbChartSourceOptions read FOptions write SetOptions default [];
76 published
77 property OnGetItem: TDbChartSourceGetItemEvent read FOnGetItem write SetOnGetItem;
78 end;
79
80 procedure Register;
81
82 implementation
83
84 uses
85 Math, SysUtils, DateUtils, TAMath;
86
87 type
88
89 { TDbChartSourceDataLink }
90
91 TDbChartSourceDataLink = class(TDataLink)
92 strict private
93 FChartSrc: TDbChartSource;
94 protected
95 procedure ActiveChanged; override;
96 procedure DataSetChanged; override;
97 procedure DataSetScrolled(ADistance: Integer); override;
98 procedure UpdateData; override;
99 public
100 constructor Create(ASrc: TDbChartSource);
101 end;
102
103 // FIXME: This is a workaround for issue #19887.
104 // Remove when dataset gains the capability to turn data events off.
105 var
106 VLockedDatasets: TFPList;
107
108 { TDbChartSourceDataLink }
109
110 procedure TDbChartSourceDataLink.ActiveChanged;
111 begin
112 inherited ActiveChanged;
113 // Make associated series check XCount and YCount.
114 if (FChartSrc.ComponentState = []) and Assigned(Dataset) and (Dataset.State <> dsInactive) then
115 FChartSrc.Reset;
116 end;
117
118 constructor TDbChartSourceDataLink.Create(ASrc: TDbChartSource);
119 begin
120 FChartSrc := ASrc;
121 VisualControl := true;
122 end;
123
124 procedure TDbChartSourceDataLink.DataSetChanged;
125 begin
126 inherited DataSetChanged;
127 if DataSet.State = dsBrowse then
128 FChartSrc.Reset;
129 end;
130
131 procedure TDbChartSourceDataLink.DataSetScrolled(ADistance: Integer);
132 begin
133 Unused(ADistance); // No need to react on scrolling.
134 end;
135
136 procedure TDbChartSourceDataLink.UpdateData;
137 begin
138 inherited UpdateData;
139 FChartSrc.Reset;
140 end;
141
142
143 { TDbChartSource }
144
145 procedure TDbChartSource.AfterDraw;
146 begin
147 inherited AfterDraw;
148 try
149 if not FDataLink.Active or (FBookmark = nil) then exit;
150 FDataLink.Dataset.EnableControls;
151 FDataLink.DataSet.GotoBookmark(FBookmark);
152 FDataLink.DataSet.FreeBookmark(FBookmark);
153 finally
154 FBookmark := nil;
155 VLockedDatasets.Remove(FDataLink.DataSet);
156 end;
157 end;
158
159 procedure TDbChartSource.BeforeDraw;
160 begin
161 inherited BeforeDraw;
162 VLockedDatasets.Add(FDataLink.DataSet);
163 FDataLink.Dataset.DisableControls;
164 if FDataLink.Active and (FBookmark = nil) then
165 FBookmark := FDataLink.DataSet.GetBookmark;
166 end;
167
168 constructor TDbChartSource.Create(AOwner: TComponent);
169 begin
170 inherited Create(AOwner);
171 FDataLink := TDbChartSourceDataLink.Create(Self);
172 FFieldXList := TStringList.Create;
173 FFieldXList.StrictDelimiter := true;
174 FFieldYList := TStringList.Create;
175 FFieldYList.StrictDelimiter := true;
176 FXCount := 1; // Even when no FieldX is specified there is an x value (sequential counter).
177 FYCount := 0; // Has been set to 1 by inherited constructor
178 end;
179
DataSetnull180 function TDbChartSource.DataSet: TDataSet;
181 begin
182 Result := FDataLink.DataSet;
183 end;
184
185 procedure TDbChartSource.DefaultGetItem(var AItem: TChartDataItem);
186
FieldValueOrNaNnull187 function FieldValueOrNaN(
188 ADataset: TDataSet; const AFieldName: String; ADateTime: Boolean): Double;
189 begin
190 with ADataset.FieldByName(AFieldName) do
191 if IsNull then
192 Result := SafeNan
193 else if ADateTime then
194 begin
195 if (DataType = ftString) and (FDateTimeFormat <> '') then
196 Result := ScanDateTime(FDateTimeFormat, AsString)
197 else
198 Result := AsDateTime
199 end else
200 Result := AsFloat;
201 end;
202
203 var
204 ds: TDataSet;
205 i: Integer;
206 begin
207 ds := DataSet;
208
209 if FFieldXList.Count > 0 then begin
210 AItem.X := FieldValueOrNaN(ds, FFieldXList[0], dcsoDateTimeX in Options);
211 for i := 0 to High(AItem.XList) do
212 AItem.XList[i] :=
213 FieldValueOrNaN(ds, FFieldXList[i + 1], false); // no date/time in extra x values
214 end else
215 AItem.X := ds.RecNo;
216
217 if FYCount > 0 then begin
218 AItem.Y := FieldValueOrNaN(ds, FFieldYList[0], dcsoDateTimeY in Options);
219 for i := 0 to High(AItem.YList) do
220 AItem.YList[i] :=
221 FieldValueOrNaN(ds, FFieldYList[i + 1], false); // not date/time in extra y values!
222 end;
223
224 if FieldColor <> '' then
225 AItem.Color := ds.FieldByName(FieldColor).AsInteger;
226
227 if FieldText <> '' then
228 AItem.Text := ds.FieldByName(FieldText).AsString;
229 end;
230
231 destructor TDbChartSource.Destroy;
232 begin
233 FreeAndNil(FDataLink);
234 FreeAndNil(FFieldXList);
235 FreeAndNil(FFieldYList);
236 inherited;
237 end;
238
TDbChartSource.GetCountnull239 function TDbChartSource.GetCount: Integer;
240 begin
241 if FDataLink.Active then
242 Result := DataSource.DataSet.RecordCount
243 else
244 Result := 0;
245 end;
246
TDbChartSource.GetDataSourcenull247 function TDbChartSource.GetDataSource: TDataSource;
248 begin
249 Result := FDataLink.DataSource;
250 end;
251
GetItemnull252 function TDbChartSource.GetItem(AIndex: Integer): PChartDataItem;
253 var
254 ds: TDataSet;
255 begin
256 Result := @FCurItem;
257 SetDataItemDefaults(FCurItem);
258 if not FDataLink.Active then exit;
259
260 Inc(AIndex); // RecNo is counted from 1
261 ds := DataSet;
262 if ds.IsUniDirectional then begin
263 if ds.RecNo < AIndex then
264 ds.First;
265 end
266 else begin
267 if AIndex > ds.RecNo - AIndex then
268 while (ds.RecNo > AIndex) and not ds.BOF do
269 ds.Prior
270 else
271 ds.First;
272 end;
273 while (ds.RecNo < AIndex) and not ds.EOF do
274 ds.Next;
275 if ds.RecNo <> AIndex then begin
276 // Either the requested item is out of range, or the dataset is filtered.
277 FCurItem.X := SafeNaN;
278 FCurItem.Y := SafeNaN;
279 exit;
280 end;
281 if Assigned(OnGetItem) then
282 // Data in unusual format, e.g. dates in non-current locale, will cause
283 // errors in DefaultGetItem -- so don't call it before the handler.
284 // User may call it himself if he deems it safe and necessary.
285 OnGetItem(Self, FCurItem)
286 else
287 DefaultGetItem(FCurItem);
288 end;
289
290 procedure TDbChartSource.Reset;
291 begin
292 InvalidateCaches;
293 if VLockedDatasets.IndexOf(FDataLink.DataSet) >= 0 then exit;
294 Notify;
295 end;
296
297 procedure TDbChartSource.SetDataSource(AValue: TDataSource);
298 begin
299 if DataSource = AValue then exit;
300 FDataLink.DataSource := AValue;
301 end;
302
303 procedure TDbChartSource.SetFieldColor(const AValue: String);
304 begin
305 if FFieldColor = AValue then exit;
306 FFieldColor := AValue;
307 Reset;
308 end;
309
310 procedure TDbChartSource.SetFieldText(const AValue: String);
311 begin
312 if FFieldText = AValue then exit;
313 FFieldText := AValue;
314 Reset;
315 end;
316
317 procedure TDbChartSource.SetFieldX(const AValue: String);
318 begin
319 if FFieldX = AValue then exit;
320 FFieldX := AValue;
321 if FFieldX = '' then
322 FFieldXList.Clear
323 else
324 FFieldXList.CommaText := FFieldX;
325 FXCount := Min(1, FFieldXList.Count);
326 // There is always one x value even if FieldX is not specified (sequential counter).
327 SetLength(FCurItem.XList, Max(FXCount - 1, 0));
328 Reset;
329 end;
330
331 procedure TDbChartSource.SetFieldY(const AValue: String);
332 begin
333 if FFieldY = AValue then exit;
334 FFieldY := AValue;
335 if FFieldY = '' then
336 FFieldYList.Clear
337 else
338 FFieldYList.CommaText := FFieldY;
339 FYCount := FFieldYList.Count;
340 SetLength(FCurItem.YList, Max(FYCount - 1, 0));
341 Reset;
342 end;
343
344 procedure TDbChartSource.SetOnGetItem(AValue: TDbChartSourceGetItemEvent);
345 begin
346 if TMethod(FOnGetItem) = TMethod(AValue) then exit;
347 FOnGetItem := AValue;
348 Reset;
349 end;
350
351 procedure TDbChartSource.SetOptions(AValue: TDbChartSourceOptions);
352 begin
353 if FOptions = AValue then exit;
354 FOptions := AValue;
355 Reset;
356 end;
357
358 procedure TDbChartSource.SetXCount(AValue: Cardinal);
359 begin
360 Unused(AValue);
361 raise EXCountError.Create('Set FieldX instead');
362 end;
363
364 procedure TDbChartSource.SetYCount(AValue: Cardinal);
365 begin
366 Unused(AValue);
367 raise EYCountError.Create('Set FieldY instead');
368 end;
369
370
371 procedure Register;
372 begin
373 RegisterComponents(CHART_COMPONENT_IDE_PAGE, [TDbChartSource]);
374 end;
375
376
377 initialization
378 VLockedDatasets := TFPList.Create;
379
380 finalization
381 FreeAndNil(VLockedDatasets);
382
383 end.
384
385