3
*****************************************************************************
5
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
6
* for details about the copyright. *
8
* This program is distributed in the hope that it will be useful, *
9
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
10
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
12
*****************************************************************************
14
Authors: Alexander Klenin
18
unit TAIntervalSources;
25
Classes, TAChartUtils, TACustomSource;
29
{ TIntervalChartSource }
31
TIntervalChartSource = class(TCustomChartSource)
33
FParams: TChartAxisIntervalParams;
34
procedure RoundToImage(
35
const AParams: TValuesInRangeParams; var AValues: TChartValueTextArray);
36
procedure SetParams(AValue: TChartAxisIntervalParams);
38
procedure CalculateIntervals(
39
AParams: TValuesInRangeParams; out ABestStart, ABestStep: Double);
41
function GetCount: Integer; override;
42
function GetItem(AIndex: Integer): PChartDataItem; override;
43
procedure SetYCount(AValue: Cardinal); override;
45
constructor Create(AOwner: TComponent); override;
46
destructor Destroy; override;
48
procedure ValuesInRange(
49
AParams: TValuesInRangeParams; var AValues: TChartValueTextArray); override;
51
property Params: TChartAxisIntervalParams read FParams write SetParams;
55
dtsYear, dtsQuarter, dtsMonth, dtsWeek, dtsDay,
56
dtsHour, dtsMinute, dtsSecond, dtsMillisecond
58
TDateTimeSteps = set of TDateTimeStep;
61
DATE_TIME_STEPS_ALL = [Low(TDateTimeStep) .. High(TDateTimeStep)];
65
{ TDateTimeIntervalChartSource }
67
TDateTimeIntervalChartSource = class(TIntervalChartSource)
69
FDateTimeFormat: String;
70
FSteps: TDateTimeSteps;
71
procedure SetDateTimeFormat(AValue: String);
72
procedure SetSteps(AValue: TDateTimeSteps);
74
constructor Create(AOwner: TComponent); override;
75
procedure ValuesInRange(
76
AParams: TValuesInRangeParams; var AValues: TChartValueTextArray); override;
78
property DateTimeFormat: String read FDateTimeFormat write SetDateTimeFormat;
79
property Steps: TDateTimeSteps
80
read FSteps write SetSteps default DATE_TIME_STEPS_ALL;
89
DateUtils, Math, StrUtils, SysUtils, TAMath;
93
DATE_STEP_INTERVALS: array [TDateTimeStep] of Double = (
94
YEAR, YEAR / 4, YEAR / 12, 7, 1,
95
OneHour, OneMinute, OneSecond, OneMillisecond
99
TSourceIntervalParams = class(TChartAxisIntervalParams)
101
procedure Changed; override;
104
TDateTimeIntervalsHelper = object
105
FBestStep: TDateTimeStep;
106
FBestStepCoeff: Double;
107
FOrigParams: TValuesInRangeParams;
108
FStep: TDateTimeStep;
111
function AxisToGraph(AX: Double): Double;
112
procedure CheckStep(AStepCoeff: Double);
113
function GraphToAxis(AX: Double): Double;
114
function NextValue(AValue: TDateTime): Double;
115
function StartValue(AValue: TDateTime): TDateTime;
121
CHART_COMPONENT_IDE_PAGE, [
122
TIntervalChartSource, TDateTimeIntervalChartSource
126
function SafeRound(AValue: Double): Double; inline;
128
Result := Int(AValue * 1e9) / 1e9;
131
{ TDateTimeIntervalsHelper }
133
function TDateTimeIntervalsHelper.AxisToGraph(AX: Double): Double;
135
Result := FOrigParams.FAxisToGraph(AX) * DATE_STEP_INTERVALS[FStep];
138
procedure TDateTimeIntervalsHelper.CheckStep(AStepCoeff: Double);
140
// Strict inequaltity is importatnt to avoid steps like "ten quarters".
141
if (1.0 <= AStepCoeff) and (AStepCoeff < FBestStepCoeff) then begin
142
FBestStepCoeff := AStepCoeff;
144
FStepLen := DATE_STEP_INTERVALS[FBestStep] * FBestStepCoeff;
148
function TDateTimeIntervalsHelper.GraphToAxis(AX: Double): Double;
150
Result := FOrigParams.FGraphToAxis(AX / DATE_STEP_INTERVALS[FStep]);
153
function TDateTimeIntervalsHelper.NextValue(AValue: TDateTime): Double;
157
if FBestStepCoeff > 10 then
158
// DateTime arithmetics fails on large year numbers.
159
Result := AValue + FStepLen
161
Result := IncYear(AValue, Round(FBestStepCoeff));
162
dtsMonth: Result := IncMonth(AValue, Round(FBestStepCoeff));
163
otherwise Result := AValue + FStepLen;
167
function TDateTimeIntervalsHelper.StartValue(AValue: TDateTime): TDateTime;
169
Result := Int(AValue / FStepLen - 1) * FStepLen;
172
// DateTime arithmetics fails on large year numbers.
173
if FBestStepCoeff <= 10 then
174
Result := StartOfTheYear(AValue);
175
dtsMonth: Result := StartOfTheMonth(AValue);
179
{ TSourceIntervalParams }
181
procedure TSourceIntervalParams.Changed;
183
with GetOwner as TCustomChartSource do begin
189
{ TIntervalChartSource }
191
procedure TIntervalChartSource.CalculateIntervals(
192
AParams: TValuesInRangeParams; out ABestStart, ABestStep: Double);
194
procedure CalcMinMaxCount(out AMinCount, AMaxCount: Integer);
196
imageWidth, len: Integer;
198
// If the axis transformation is non-linear, steps may not be equidistant.
199
// However, both minimax and maximin will be achieved on equal steps.
201
imageWidth := Abs(ToImage(FMax) - ToImage(FMin));
202
if aipUseMinLength in Params.Options then
203
len := AParams.FScale(Max(Params.MinLength, 2))
206
AMaxCount := Max(imageWidth div len, 2);
207
if aipUseMaxLength in Params.Options then begin
208
len := AParams.FScale(Max(Params.MaxLength, 2));
209
AMinCount := Max((imageWidth + 1) div len, 2);
215
procedure TryStep(AStep: Double; var ABestCount: Integer);
218
mi, prev, cnt: Integer;
220
if AStep <= 0 then exit;
221
start := Int(AParams.FMin / AStep) * AStep;
223
prev := AParams.ToImage(m);
225
while m <= AParams.FMax do begin
226
mi := AParams.ToImage(m + AStep);
227
if not AParams.IsAcceptableStep(Abs(prev - mi)) then exit;
233
not (aipUseCount in Params.Options) or (ABestCount <= 0) or
234
(Abs(cnt - Params.Count) < Abs(ABestCount - Params.Count))
236
ABestStart := start - AStep;
243
minCount, maxCount, bestCount: Integer;
246
CalcMinMaxCount(minCount, maxCount);
248
if aipUseNiceSteps in Params.Options then begin
249
s := AParams.CountToStep(minCount) * 10;
250
while s >= Max(AParams.CountToStep(maxCount), AParams.FMinStep) do begin
251
for sv in Params.StepValues do
252
TryStep(s * sv, bestCount);
253
// We are not required to pick the best count, so any one will do.
254
if not (aipUseCount in Params.Options) and (bestCount > 0) then break;
258
if bestCount > 0 then exit;
259
// Either nice steps were not required, or we failed to find one.
260
if aipUseCount in Params.Options then
261
bestCount := EnsureRange(Params.Count, minCount, maxCount)
263
bestCount := minCount;
264
ABestStep := (AParams.FMax - AParams.FMin) / bestCount;
265
ABestStart := AParams.FMin - ABestStep;
268
constructor TIntervalChartSource.Create(AOwner: TComponent);
270
inherited Create(AOwner);
271
FParams := TChartAxisIntervalParams.Create(Self);
274
destructor TIntervalChartSource.Destroy;
280
function TIntervalChartSource.GetCount: Integer;
285
function TIntervalChartSource.GetItem(AIndex: Integer): PChartDataItem;
291
procedure TIntervalChartSource.RoundToImage(
292
const AParams: TValuesInRangeParams; var AValues: TChartValueTextArray);
294
function A2I(AX: Double): Integer; inline;
296
Result := AParams.FGraphToImage(AParams.FAxisToGraph(AX));
304
if AParams.FIntervals.Tolerance = 0 then exit;
305
for i := 0 to High(AValues) do begin
306
v := AValues[i].FValue;
307
if (v = 0) or IsInfinite(v) or IsNan(v) then continue;
309
p := Power(10, Floor(Log10(Abs(v)) - Log10(High(Int64)) + 1));
310
while v <> 0 do begin
311
rv := Round(v / p) * p;
312
if Abs(A2I(rv) - x) >= AParams.FIntervals.Tolerance then break;
316
AValues[i].FValue := v;
320
procedure TIntervalChartSource.SetParams(AValue: TChartAxisIntervalParams);
322
if FParams = AValue then exit;
323
FParams.Assign(AValue);
328
procedure TIntervalChartSource.SetYCount(AValue: Cardinal);
331
raise EYCountError.Create('Can not set YCount');
334
procedure TIntervalChartSource.ValuesInRange(
335
AParams: TValuesInRangeParams; var AValues: TChartValueTextArray);
337
// Arbitrary limit to prevent hangup/OOM in case of bug in CalculateIntervals.
340
start, step, m: Double;
343
if AParams.FMin >= AParams.FMax then exit;
344
AParams.FIntervals := Params;
346
if aipGraphCoords in Params.Options then begin
347
AParams.FMin := AParams.FAxisToGraph(AParams.FMin);
348
AParams.FMax := AParams.FAxisToGraph(AParams.FMax);
350
CalculateIntervals(AParams, start, step);
351
if step <= 0 then exit;
353
SetLength(AValues, Trunc(Min((AParams.FMax - m) / step + 2, MAX_COUNT)));
354
for i := 0 to High(AValues) do begin
357
AValues[i].FValue := m;
358
if m > AParams.FMax then begin
359
SetLength(AValues, i + 1);
364
if aipGraphCoords in Params.Options then
365
for i := 0 to High(AValues) do
366
AValues[i].FValue := AParams.FGraphToAxis(AValues[i].FValue);
367
RoundToImage(AParams, AValues);
368
for i := 0 to High(AValues) do
369
// Extra format arguments for compatibility with FormatItem.
370
AValues[i].FText := Format(
371
AParams.FFormat, [AValues[i].FValue, 0.0, '', 0.0, 0.0]);
374
{ TDateTimeIntervalChartSource }
376
constructor TDateTimeIntervalChartSource.Create(AOwner: TComponent);
378
inherited Create(AOwner);
379
FSteps := DATE_TIME_STEPS_ALL;
382
procedure TDateTimeIntervalChartSource.SetDateTimeFormat(AValue: String);
384
if FDateTimeFormat = AValue then exit;
385
FDateTimeFormat := AValue;
390
procedure TDateTimeIntervalChartSource.SetSteps(AValue: TDateTimeSteps);
392
if FSteps = AValue then exit;
398
procedure TDateTimeIntervalChartSource.ValuesInRange(
399
AParams: TValuesInRangeParams; var AValues: TChartValueTextArray);
401
helper: TDateTimeIntervalsHelper;
404
function FormatLabel(AValue: TDateTime): String;
408
if DateTimeFormat <> '' then
409
exit(FormatDateTime(DateTimeFormat, AValue));
410
DateTimeToSystemTime(AValue, st);
411
case helper.FBestStep of
413
Result := FormatDateTime('yyyy', AValue);
416
IntToRoman(Floor(AValue / helper.FStepLen) mod 4 + 1) +
417
FormatDateTime('/yyyy', AValue);
419
Result := FormatDateTime(
420
IfThen(st.Year = prevSt.Year, 'mm', 'mm/yyyy'), AValue);
422
Result := FormatDateTime('dd/mm', AValue);
424
Result := FormatDateTime(
425
IfThen(st.Month = prevSt.Month, 'dd', 'dd/mm'), AValue);
427
Result := FormatDateTime(
428
IfThen(st.Day = prevSt.Day, 'hh:00', 'dd hh:00'), AValue);
430
Result := FormatDateTime(
431
IfThen(st.Hour = prevSt.Hour, 'nn', 'hh:nn'), AValue);
433
Result := FormatDateTime(
434
IfThen(st.Minute = prevSt.Minute, 'ss', 'nn:ss'), AValue);
437
IfThen(st.Second = prevSt.Second, '', IntToStr(st.Second) + '.') +
438
IntToStr(st.Millisecond) + 'ms';
440
if InRange(AValue, helper.FOrigParams.FMin, helper.FOrigParams.FMax) then
444
procedure AddValue(AIndex: Integer; AValue: Double);
446
with AValues[AIndex] do begin
449
AParams.FFormat, [AValue, 0.0, FormatLabel(AValue), 0.0, 0.0]);
454
MAX_COUNT = 1000; // Arbitraty limit to prevent OOM in case of a bug.
457
x, start, stepLen: Double;
460
(AParams.FMin >= AParams.FMax) or (aipGraphCoords in Params.options)
463
AParams.FIntervals := Params;
465
helper.FOrigParams := AParams;
466
AParams.FAxisToGraph := @helper.AxisToGraph;
467
AParams.FGraphToAxis := @helper.GraphToAxis;
468
AParams.FMinStep := 1.0;
469
helper.FBestStepCoeff := SafeInfinity;
470
for helper.FStep in Steps do begin
471
AParams.FMin := helper.FOrigParams.FMin / DATE_STEP_INTERVALS[helper.FStep];
472
AParams.FMax := helper.FOrigParams.FMax / DATE_STEP_INTERVALS[helper.FStep];
473
CalculateIntervals(AParams, start, stepLen);
474
helper.CheckStep(stepLen);
477
if IsInfinite(helper.FBestStepCoeff) then exit;
479
start := helper.StartValue(helper.FOrigParams.FMin);
482
while (x <= helper.FOrigParams.FMax) and (cnt < MAX_COUNT) do begin
484
x := helper.NextValue(x);
486
i := Length(AValues);
487
SetLength(AValues, i + cnt);
489
FillChar(prevSt, SizeOf(prevSt), $FF);
491
while (x <= helper.FOrigParams.FMax) and (i < cnt - 1) do begin
494
x := helper.NextValue(x);