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
12 unit TAIntervalSources;
13
14 {$H+}
15
16 interface
17
18 uses
19 Classes, TAChartUtils, TACustomSource;
20
21 type
22
23 { TIntervalChartSource }
24
25 TIntervalChartSource = class(TCustomChartSource)
26 strict private
27 FParams: TChartAxisIntervalParams;
28 procedure SetParams(AValue: TChartAxisIntervalParams);
29 strict protected
30 procedure CalculateIntervals(
31 AParams: TValuesInRangeParams; out ABestStart, ABestStep: Double);
32 protected
GetCountnull33 function GetCount: Integer; override;
GetItemnull34 function GetItem(AIndex: Integer): PChartDataItem; override;
35 procedure SetXCount(AValue: Cardinal); override;
36 procedure SetYCount(AValue: Cardinal); override;
37 public
38 constructor Create(AOwner: TComponent); override;
39 destructor Destroy; override;
40
41 procedure ValuesInRange(
42 AParams: TValuesInRangeParams; var AValues: TChartValueTextArray); override;
43 published
44 property Params: TChartAxisIntervalParams read FParams write SetParams;
45 end;
46
47 TDateTimeStep = (
48 dtsYear, dtsQuarter, dtsMonth, dtsWeek, dtsDay,
49 dtsHour, dtsMinute, dtsSecond, dtsMillisecond
50 );
51 TDateTimeSteps = set of TDateTimeStep;
52
53 const
54 DATE_TIME_STEPS_ALL = [Low(TDateTimeStep) .. High(TDateTimeStep)];
55
56 type
57
58 { TDateTimeStepFormat }
59
60 TDateTimeStepFormat = class(TPersistent)
61 private
62 FSource: TBasicChartSource;
63 FYearFmt: String;
64 FMonthFmt: String;
65 FWeekFmt: String;
66 FDayFmt: String;
67 FHourFmt: String;
68 FMinuteFmt: String;
69 FSecondFmt: String;
70 FMillisecondFmt: String;
IsStoredYearFmtnull71 function IsStoredYearFmt: Boolean;
IsStoredMonthFmtnull72 function IsStoredMonthFmt: Boolean;
IsStoredWeekFmtnull73 function IsStoredWeekFmt: Boolean;
IsStoredDayFmtnull74 function IsStoredDayFmt: Boolean;
IsStoredHourFmtnull75 function IsStoredHourFmt: Boolean;
IsStoredMinuteFmtnull76 function IsStoredMinuteFmt: Boolean;
IsStoredSecondFmtnull77 function IsStoredSecondFmt: Boolean;
IsStoredMillisecondFmtnull78 function IsStoredMillisecondFmt: Boolean;
79 procedure SetYearFmt(const AValue: String);
80 procedure SetMonthFmt(const AValue: String);
81 procedure SetWeekFmt(const AValue: String);
82 procedure SetDayFmt(const AValue: String);
83 procedure SetHourFmt(const AValue: String);
84 procedure SetMinuteFmt(const AValue: String);
85 procedure SetSecondFmt(const AValue: String);
86 procedure SetMillisecondFmt(const AValue: String);
87 public
88 constructor Create(ASource: TBasicChartSource);
89 published
90 property YearFormat: String
91 read FYearFmt write SetYearFmt stored IsStoredYearFmt;
92 property MonthFormat: String
93 read FMonthFmt write SetMonthFmt stored IsStoredMonthFmt;
94 property WeekFormat: String
95 read FWeekFmt write SetWeekFmt stored IsStoredWeekFmt;
96 property DayFormat: String
97 read FDayFmt write SetDayFmt stored IsStoredDayFmt;
98 property HourFormat: String
99 read FHourFmt write SetHourFmt stored IsStoredHourFmt;
100 property MinuteFormat: String
101 read FMinuteFmt write SetMinuteFmt stored IsStoredMinuteFmt;
102 property SecondFormat: String
103 read FSecondFmt write SetSecondFmt stored IsStoredSecondFmt;
104 property MillisecondFormat: String
105 read FMillisecondFmt write SetMillisecondFmt stored IsStoredMillisecondFmt;
106 end;
107
108 { TDateTimeIntervalChartSource }
109
110 TDateTimeStepChangeEvent = procedure (Sender: TObject; ASteps: TDateTimeStep) of object;
111
112 TDateTimeIntervalChartSource = class(TIntervalChartSource)
113 strict private
114 FDateTimeFormat: String;
115 FDateTimeStepFormat: TDateTimeStepFormat;
116 FSteps: TDateTimeSteps;
117 FSuppressPrevUnit: Boolean;
118 FOnDateTimeStepChange: TDateTimeStepChangeEvent;
119 procedure SetDateTimeFormat(AValue: String);
120 procedure SetSteps(AValue: TDateTimeSteps);
121 procedure SetSuppressPrevUnit(AValue: Boolean);
122 public
123 constructor Create(AOwner: TComponent); override;
124 destructor Destroy; override;
125 procedure ValuesInRange(
126 AParams: TValuesInRangeParams; var AValues: TChartValueTextArray); override;
127 published
128 property DateTimeFormat: String
129 read FDateTimeFormat write SetDateTimeFormat;
130 property DateTimeStepFormat: TDateTimeStepFormat
131 read FDateTimeStepFormat write FDateTimeStepFormat;
132 property Steps: TDateTimeSteps
133 read FSteps write SetSteps default DATE_TIME_STEPS_ALL;
134 property SuppressPrevUnit: Boolean
135 read FSuppressPrevUnit write SetSuppressPrevUnit default true;
136 property OnDateTimeStepChange: TDateTimeStepChangeEvent
137 read FOnDateTimeStepChange write FOnDateTimeStepChange;
138 end;
139
140 const
141 DEFAULT_YEAR_FORMAT = 'yyyy';
142 // DEFAULT_QUARTER_FORMAT = 'Q/yyyy';
143 DEFAULT_MONTH_FORMAT = 'mm/yyyy';
144 DEFAULT_WEEK_FORMAT = 'dd/mm';
145 DEFAULT_DAY_FORMAT = 'dd/mm';
146 DEFAULT_HOUR_FORMAT = 'dd hh:nn';
147 DEFAULT_MINUTE_FORMAT = 'hh:nn';
148 DEFAULT_SECOND_FORMAT = 'nn:ss';
149 DEFAULT_MILLISECOND_FORMAT = 'szzz"ms"';
150
151 procedure Register;
152
153 implementation
154
155 uses
156 DateUtils, Math, StrUtils, SysUtils, TAMath;
157
158 const
159 YEAR = 365.25;
160 DATE_STEP_INTERVALS: array [TDateTimeStep] of Double = (
161 YEAR, YEAR / 4, YEAR / 12, 7, 1,
162 OneHour, OneMinute, OneSecond, OneMillisecond
163 );
164
165 type
166 TSourceIntervalParams = class(TChartAxisIntervalParams)
167 strict protected
168 procedure Changed; override;
169 end;
170
171 TDateTimeIntervalsHelper = object
172 FBestStep: TDateTimeStep;
173 FBestStepCoeff: Double;
174 FOrigParams: TValuesInRangeParams;
175 FStep: TDateTimeStep;
176 FStepLen: Double;
177
AxisToGraphnull178 function AxisToGraph(AX: Double): Double;
179 procedure CheckStep(AStepCoeff: Double);
GraphToAxisnull180 function GraphToAxis(AX: Double): Double;
NextValuenull181 function NextValue(AValue: TDateTime): Double;
StartValuenull182 function StartValue(AValue: TDateTime): TDateTime;
183 end;
184
185 procedure Register;
186 begin
187 RegisterComponents(
188 CHART_COMPONENT_IDE_PAGE, [
189 TIntervalChartSource, TDateTimeIntervalChartSource
190 ]);
191 end;
192
SafeRoundnull193 function SafeRound(AValue: Double): Double; inline;
194 begin
195 Result := Int(AValue * 1e9) / 1e9;
196 end;
197
198 { TDateTimeIntervalsHelper }
199
AxisToGraphnull200 function TDateTimeIntervalsHelper.AxisToGraph(AX: Double): Double;
201 begin
202 Result := FOrigParams.FAxisToGraph(AX) * DATE_STEP_INTERVALS[FStep];
203 end;
204
205 procedure TDateTimeIntervalsHelper.CheckStep(AStepCoeff: Double);
206 begin
207 // Strict inequaltity is importatnt to avoid steps like "ten quarters".
208 if (1.0 <= AStepCoeff) and (AStepCoeff < FBestStepCoeff) then begin
209 FBestStepCoeff := AStepCoeff;
210 FBestStep := FStep;
211 FStepLen := DATE_STEP_INTERVALS[FBestStep] * FBestStepCoeff;
212 end;
213 end;
214
GraphToAxisnull215 function TDateTimeIntervalsHelper.GraphToAxis(AX: Double): Double;
216 begin
217 Result := FOrigParams.FGraphToAxis(AX / DATE_STEP_INTERVALS[FStep]);
218 end;
219
NextValuenull220 function TDateTimeIntervalsHelper.NextValue(AValue: TDateTime): Double;
221 begin
222 case FBestStep of
223 dtsYear:
224 if FBestStepCoeff > 10 then
225 // DateTime arithmetics fails on large year numbers.
226 Result := AValue + FStepLen
227 else
228 Result := IncYear(AValue, Round(FBestStepCoeff));
229 dtsMonth: Result := IncMonth(AValue, Round(FBestStepCoeff));
230 otherwise Result := AValue + FStepLen;
231 end;
232 end;
233
StartValuenull234 function TDateTimeIntervalsHelper.StartValue(AValue: TDateTime): TDateTime;
235 begin
236 Result := Int(AValue / FStepLen - 1) * FStepLen;
237 case FBestStep of
238 dtsYear:
239 // DateTime arithmetics fails on large year numbers.
240 if FBestStepCoeff <= 10 then
241 Result := StartOfTheYear(AValue);
242 dtsMonth: Result := StartOfTheMonth(AValue);
243 end;
244 end;
245
246 { TSourceIntervalParams }
247
248 procedure TSourceIntervalParams.Changed;
249 begin
250 with GetOwner as TCustomChartSource do begin
251 BeginUpdate;
252 EndUpdate;
253 end;
254 end;
255
256 { TIntervalChartSource }
257
258 procedure TIntervalChartSource.CalculateIntervals(
259 AParams: TValuesInRangeParams; out ABestStart, ABestStep: Double);
260
261 procedure CalcMinMaxCount(out AMinCount, AMaxCount: Integer);
262 var
263 imageWidth, len: Integer;
264 begin
265 // If the axis transformation is non-linear, steps may not be equidistant.
266 // However, both minimax and maximin will be achieved on equal steps.
267 with AParams do
268 imageWidth := Abs(ToImage(FMax) - ToImage(FMin));
269 if aipUseMinLength in Params.Options then
270 len := AParams.FScale(Max(Params.MinLength, 2))
271 else
272 len := 2;
273 AMaxCount := Max(imageWidth div len, 2);
274 if aipUseMaxLength in Params.Options then begin
275 len := AParams.FScale(Max(Params.MaxLength, 2));
276 AMinCount := Max((imageWidth + 1) div len, 2);
277 end
278 else
279 AMinCount := 2;
280 end;
281
282 procedure TryStep(AStep: Double; var ABestCount: Integer);
283 var
284 m, start: Double;
285 mi, prev, cnt: Int64;
286 begin
287 if AStep <= 0 then exit;
288 start := Int(AParams.FMin / AStep) * AStep;
289 m := start;
290 prev := AParams.ToImage(m);
291 cnt := 0;
292 while m <= AParams.FMax do begin
293 mi := AParams.ToImage(m + AStep);
294 if not AParams.IsAcceptableStep(Abs(prev - mi)) then exit;
295 m += AStep;
296 prev := mi;
297 cnt += 1;
298 end;
299 if
300 not (aipUseCount in Params.Options) or (ABestCount <= 0) or
301 (Abs(cnt - Params.Count) < Abs(ABestCount - Params.Count))
302 then begin
303 ABestStart := start - AStep;
304 ABestStep := AStep;
305 ABestCount := cnt;
306 end;
307 end;
308
309 var
310 minCount, maxCount, bestCount: Integer;
311 s, sv: Double;
312 begin
313 CalcMinMaxCount(minCount, maxCount);
314 bestCount := 0;
315 if aipUseNiceSteps in Params.Options then begin
316 s := AParams.CountToStep(minCount) * 10;
317 while s >= Max(AParams.CountToStep(maxCount), AParams.FMinStep) do begin
318 for sv in Params.StepValues do
319 TryStep(s * sv, bestCount);
320 // We are not required to pick the best count, so any one will do.
321 if not (aipUseCount in Params.Options) and (bestCount > 0) then break;
322 s *= 0.1;
323 end;
324 end;
325 if bestCount > 0 then exit;
326 // Either nice steps were not required, or we failed to find one.
327 if aipUseCount in Params.Options then
328 bestCount := EnsureRange(Params.Count, minCount, maxCount)
329 else
330 bestCount := minCount;
331 ABestStep := (AParams.FMax - AParams.FMin) / bestCount;
332 ABestStart := AParams.FMin - ABestStep;
333 end;
334
335 constructor TIntervalChartSource.Create(AOwner: TComponent);
336 begin
337 inherited Create(AOwner);
338 FParams := TChartAxisIntervalParams.Create(Self);
339 end;
340
341 destructor TIntervalChartSource.Destroy;
342 begin
343 FreeAndNil(FParams);
344 inherited;
345 end;
346
GetCountnull347 function TIntervalChartSource.GetCount: Integer;
348 begin
349 Result := 0;
350 end;
351
GetItemnull352 function TIntervalChartSource.GetItem(AIndex: Integer): PChartDataItem;
353 begin
354 Unused(AIndex);
355 Result := nil;
356 end;
357
358 procedure TIntervalChartSource.SetParams(AValue: TChartAxisIntervalParams);
359 begin
360 if FParams = AValue then exit;
361 FParams.Assign(AValue);
362 InvalidateCaches;
363 Notify;
364 end;
365
366 procedure TIntervalChartSource.SetXCount(AValue: Cardinal);
367 begin
368 Unused(AValue);
369 raise EXCountError.Create('Cannot set XCount');
370 end;
371
372 procedure TIntervalChartSource.SetYCount(AValue: Cardinal);
373 begin
374 Unused(AValue);
375 raise EYCountError.Create('Cannot set YCount');
376 end;
377
378 procedure TIntervalChartSource.ValuesInRange(
379 AParams: TValuesInRangeParams; var AValues: TChartValueTextArray);
380 const
381 // Arbitrary limit to prevent hangup/OOM in case of bug in CalculateIntervals.
382 MAX_COUNT = 10000;
383 var
384 start, step, m, eps: Double;
385 i: Integer;
386 begin
387 if AParams.FMin >= AParams.FMax then exit;
388 AParams.FIntervals := Params;
389
390 if aipGraphCoords in Params.Options then begin
391 AParams.FMin := AParams.FAxisToGraph(AParams.FMin);
392 AParams.FMax := AParams.FAxisToGraph(AParams.FMax);
393 end;
394 EnsureOrder(AParams.FMin, AParams.FMax);
395 CalculateIntervals(AParams, start, step);
396 if step <= 0 then exit;
397 eps := (AParams.FMax - AParams.FMin) * RANGE_EPSILON;
398 m := start;
399 SetLength(AValues, Trunc(Min((AParams.FMax - m) / step + 2, MAX_COUNT)));
400 for i := 0 to High(AValues) do begin
401 if IsZero(m, eps) then
402 m := 0;
403 AValues[i].FValue := m;
404 if m > AParams.FMax then begin
405 SetLength(AValues, i + 1);
406 break;
407 end;
408 m += step;
409 end;
410 if aipGraphCoords in Params.Options then
411 for i := 0 to High(AValues) do
412 AValues[i].FValue := AParams.FGraphToAxis(AValues[i].FValue);
413 for i := 0 to High(AValues) do begin
414 AParams.RoundToImage(AValues[i].FValue);
415 // Extra format arguments for compatibility with FormatItem.
416 AValues[i].FText := Format(
417 AParams.FFormat, [AValues[i].FValue, 0.0, '', 0.0, 0.0]);
418 end;
419 end;
420
421 { TDateTimeStepFormat }
422
423 constructor TDateTimeStepFormat.Create(ASource: TBasicChartSource);
424 begin
425 inherited Create;
426 FSource := ASource;
427 FYearFmt := DEFAULT_YEAR_FORMAT;
428 FMonthFmt := DEFAULT_MONTH_FORMAT;
429 FWeekFmt := DEFAULT_WEEK_FORMAT;
430 FDayFmt := DEFAULT_DAY_FORMAT;
431 FHourFmt := DEFAULT_HOUR_FORMAT;
432 FMinuteFmt := DEFAULT_MINUTE_FORMAT;
433 FSecondFmt := DEFAULT_SECOND_FORMAT;
434 FMillisecondFmt := DEFAULT_MILLISECOND_FORMAT;
435 end;
436
IsStoredYearFmtnull437 function TDateTimeStepFormat.IsStoredYearFmt: Boolean;
438 begin
439 Result := FYearFmt <> DEFAULT_YEAR_FORMAT;
440 end;
441
IsStoredMonthFmtnull442 function TDateTimeStepFormat.IsStoredMonthFmt: Boolean;
443 begin
444 Result := FMonthFmt <> DEFAULT_MONTH_FORMAT;
445 end;
446
TDateTimeStepFormat.IsStoredWeekFmtnull447 function TDateTimeStepFormat.IsStoredWeekFmt: Boolean;
448 begin
449 Result := FWeekFmt <> DEFAULT_WEEK_FORMAT;
450 end;
451
IsStoredDayFmtnull452 function TDateTimeStepFormat.IsStoredDayFmt: Boolean;
453 begin
454 Result := FDayFmt <> DEFAULT_DAY_FORMAT;
455 end;
456
TDateTimeStepFormat.IsStoredHourFmtnull457 function TDateTimeStepFormat.IsStoredHourFmt: Boolean;
458 begin
459 Result := FHourFmt <> DEFAULT_HOUR_FORMAT;
460 end;
461
TDateTimeStepFormat.IsStoredMinuteFmtnull462 function TDateTimeStepFormat.IsStoredMinuteFmt: Boolean;
463 begin
464 Result := FMinuteFmt <> DEFAULT_MINUTE_FORMAT;
465 end;
466
TDateTimeStepFormat.IsStoredSecondFmtnull467 function TDateTimeStepFormat.IsStoredSecondFmt: Boolean;
468 begin
469 Result := FSecondFmt <> DEFAULT_SECOND_FORMAT;
470 end;
471
IsStoredMillisecondFmtnull472 function TDateTimeStepFormat.IsStoredMillisecondFmt: Boolean;
473 begin
474 Result := FMillisecondFmt <> DEFAULT_MILLISECOND_FORMAT;
475 end;
476
477 procedure TDateTimeStepFormat.SetYearFmt(const AValue: String);
478 begin
479 if (AValue <> '') and (AValue <> FYearFmt) then begin
480 FSource.BeginUpdate;
481 FYearFmt := AValue;
482 FSource.EndUpdate;
483 end;
484 end;
485
486 procedure TDateTimeStepFormat.SetMonthFmt(const AValue: String);
487 begin
488 if (AValue <> '') and (AValue <> FMonthFmt) then begin
489 FSource.BeginUpdate;
490 FMonthFmt := AValue;
491 FSource.EndUpdate;
492 end;
493 end;
494
495 procedure TDateTimeStepFormat.SetWeekFmt(const AValue: String);
496 begin
497 if (AValue <> '') and (AValue <> FWeekFmt) then begin
498 FSource.BeginUpdate;
499 FWeekFmt := AValue;
500 FSource.EndUpdate;
501 end;
502 end;
503
504 procedure TDateTimeStepFormat.SetDayFmt(const AValue: String);
505 begin
506 if (AValue <> '') and (AValue <> FDayFmt) then begin
507 FSource.BeginUpdate;
508 FDayFmt := AValue;
509 FSource.EndUpdate;
510 end;
511 end;
512
513 procedure TDateTimeStepFormat.SetHourFmt(const AValue: String);
514 begin
515 if (AValue <> '') and (AValue <> FHourFmt) then begin
516 FSource.BeginUpdate;
517 FHourFmt := AValue;
518 FSource.EndUpdate;
519 end;
520 end;
521
522 procedure TDateTimeStepFormat.SetMinuteFmt(const AValue: String);
523 begin
524 if (AValue <> '') and (AValue <> FMinuteFmt) then begin
525 FSource.BeginUpdate;
526 FMinuteFmt := AValue;
527 FSource.EndUpdate;
528 end;
529 end;
530
531 procedure TDateTimeStepFormat.SetSecondFmt(const AValue: String);
532 begin
533 if (AValue <> '') and (AValue <> FSecondFmt) then begin
534 FSource.BeginUpdate;
535 FSecondFmt := AValue;
536 FSource.EndUpdate;
537 end;
538 end;
539
540 procedure TDateTimeStepFormat.SetMillisecondFmt(const AValue: String);
541 begin
542 if (AValue <> '') and (AValue <> FMillisecondFmt) then begin
543 FSource.BeginUpdate;
544 FMillisecondFmt := AValue;
545 FSource.EndUpdate;
546 end;
547 end;
548
549
550 { TDateTimeIntervalChartSource }
551
552 constructor TDateTimeIntervalChartSource.Create(AOwner: TComponent);
553 begin
554 inherited Create(AOwner);
555 FSteps := DATE_TIME_STEPS_ALL;
556 FSuppressPrevUnit := true;
557 FDateTimeStepFormat := TDateTimeStepFormat.Create(self);
558 end;
559
560 destructor TDateTimeIntervalChartSource.Destroy;
561 begin
562 FDateTimeStepFormat.Free;
563 inherited;
564 end;
565
566 procedure TDateTimeIntervalChartSource.SetDateTimeFormat(AValue: String);
567 begin
568 if FDateTimeFormat = AValue then exit;
569 FDateTimeFormat := AValue;
570 InvalidateCaches;
571 Notify;
572 end;
573
574 procedure TDateTimeIntervalChartSource.SetSteps(AValue: TDateTimeSteps);
575 begin
576 if FSteps = AValue then exit;
577 FSteps := AValue;
578 InvalidateCaches;
579 Notify;
580 end;
581
582 procedure TDateTimeIntervalChartSource.SetSuppressPrevUnit(AValue: Boolean);
583 begin
584 if FSuppressPrevUnit = AValue then exit;
585 BeginUpdate;
586 FSuppressPrevUnit := AValue;
587 EndUpdate;
588 end;
589
590 procedure TDateTimeIntervalChartSource.ValuesInRange(
591 AParams: TValuesInRangeParams; var AValues: TChartValueTextArray);
592 var
593 helper: TDateTimeIntervalsHelper;
594 prevSt: TSystemTime;
595
FormatLabelnull596 function FormatLabel(AValue: TDateTime): String;
597 var
598 st: TSystemTime;
599 begin
600 if DateTimeFormat <> '' then
601 exit(FormatDateTime(DateTimeFormat, AValue));
602 DateTimeToSystemTime(AValue, st);
603 case helper.FBestStep of
604 dtsYear:
605 Result := FormatDateTime(DateTimeStepFormat.YearFormat, AValue);
606 dtsQuarter:
607 Result := IntToRoman(Floor(AValue / helper.FStepLen) mod 4 + 1) + '/' +
608 FormatDateTime(DateTimeStepFormat.YearFormat, AValue);
609 dtsMonth:
610 if FSuppressPrevUnit and (st.Year = prevSt.Year) then
611 Result := FormatDateTime('mm', AValue) else
612 Result := FormatDateTime(DateTimeStepFormat.MonthFormat, AValue);
613 dtsWeek:
614 Result := FormatDateTime(DateTimeStepFormat.WeekFormat, AValue);
615 dtsDay:
616 if FSuppressPrevUnit and (st.Month = prevSt.Month) then
617 Result := FormatDateTime('dd', AValue) else
618 Result := FormatDateTime(DateTimeStepFormat.DayFormat, AValue);
619 dtsHour:
620 if FSuppressPrevUnit and (st.Day = prevSt.Day) then
621 Result := FormatDateTime('hh:00', AValue) else
622 Result := FormatDateTime(DateTimeStepFormat.HourFormat, AValue);
623 dtsMinute:
624 if FSuppressPrevUnit and (st.Hour = prevSt.Hour) then
625 Result := FormatDateTime('nn', AValue) else
626 Result := FormatDateTime(DateTimeStepFormat.MinuteFormat, AValue);
627 dtsSecond:
628 if FSuppressPrevUnit and (st.Minute = prevSt.Minute) then
629 Result := FormatDateTime('ss', AValue) else
630 Result := FormatDateTime(DateTimeStepFormat.SecondFormat, AValue);
631 dtsMillisecond:
632 if FSuppressPrevUnit and (st.Second = prevSt.Second) then
633 Result := IntToStr(st.Millisecond) + 'ms' else
634 Result := FormatDateTime(DateTimeStepFormat.MillisecondFormat, AValue);
635 end;
636 if InRange(AValue, helper.FOrigParams.FMin, helper.FOrigParams.FMax) then
637 prevSt := st;
638 end;
639
640 procedure AddValue(AIndex: Integer; AValue: Double);
641 begin
642 with AValues[AIndex] do begin
643 FValue := AValue;
644 FText := Format(
645 AParams.FFormat, [AValue, 0.0, FormatLabel(AValue), 0.0, 0.0]);
646 end;
647 end;
648
649 const
650 MAX_COUNT = 1000; // Arbitraty limit to prevent OOM in case of a bug.
651 var
652 i, cnt: Integer;
653 x, start, stepLen: Double;
654 begin
655 if
656 (AParams.FMin >= AParams.FMax) or (aipGraphCoords in Params.options)
657 then
658 exit;
659 AParams.FIntervals := Params;
660
661 helper.FOrigParams := AParams;
662 AParams.FAxisToGraph := @helper.AxisToGraph;
663 AParams.FGraphToAxis := @helper.GraphToAxis;
664 AParams.FMinStep := 1.0;
665 helper.FBestStepCoeff := SafeInfinity;
666 for helper.FStep in Steps do begin
667 AParams.FMin := helper.FOrigParams.FMin / DATE_STEP_INTERVALS[helper.FStep];
668 AParams.FMax := helper.FOrigParams.FMax / DATE_STEP_INTERVALS[helper.FStep];
669 CalculateIntervals(AParams, start, stepLen);
670 helper.CheckStep(stepLen);
671 end;
672
673 if IsInfinite(helper.FBestStepCoeff) then exit;
674
675 start := helper.StartValue(helper.FOrigParams.FMin);
676 cnt := 1;
677 x := start;
678 while (x <= helper.FOrigParams.FMax) and (cnt < MAX_COUNT) do begin
679 cnt += 1;
680 x := helper.NextValue(x);
681 end;
682 i := Length(AValues);
683 SetLength(AValues, i + cnt);
684
685 FillChar(prevSt, SizeOf(prevSt), $FF);
686 x := start;
687 while (x <= helper.FOrigParams.FMax) and (i < cnt - 1) do begin
688 AddValue(i, x);
689 i += 1;
690 x := helper.NextValue(x);
691 end;
692 AddValue(i, x);
693
694 if Assigned(FOnDateTimeStepChange) then
695 FOnDateTimeStepChange(self, helper.FBestStep);
696 end;
697
698 end.
699
700