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 else ;
244 end;
245 end;
246
247 { TSourceIntervalParams }
248
249 procedure TSourceIntervalParams.Changed;
250 begin
251 with GetOwner as TCustomChartSource do begin
252 BeginUpdate;
253 EndUpdate;
254 end;
255 end;
256
257 { TIntervalChartSource }
258
259 procedure TIntervalChartSource.CalculateIntervals(
260 AParams: TValuesInRangeParams; out ABestStart, ABestStep: Double);
261
262 procedure CalcMinMaxCount(out AMinCount, AMaxCount: Integer);
263 var
264 imageWidth, len: Integer;
265 begin
266 // If the axis transformation is non-linear, steps may not be equidistant.
267 // However, both minimax and maximin will be achieved on equal steps.
268 with AParams do
269 imageWidth := Abs(ToImage(FMax) - ToImage(FMin));
270 if aipUseMinLength in Params.Options then
271 len := AParams.FScale(Max(Params.MinLength, 2))
272 else
273 len := 2;
274 AMaxCount := Max(imageWidth div len, 2);
275 if aipUseMaxLength in Params.Options then begin
276 len := AParams.FScale(Max(Params.MaxLength, 2));
277 AMinCount := Max((imageWidth + 1) div len, 2);
278 end
279 else
280 AMinCount := 2;
281 end;
282
283 procedure TryStep(AStep: Double; var ABestCount: Integer);
284 var
285 m, start: Double;
286 mi, prev, cnt: Int64;
287 begin
288 if AStep <= 0 then exit;
289 start := Int(AParams.FMin / AStep) * AStep;
290 m := start;
291 prev := AParams.ToImage(m);
292 cnt := 0;
293 while m <= AParams.FMax do begin
294 mi := AParams.ToImage(m + AStep);
295 if not AParams.IsAcceptableStep(Abs(prev - mi)) then exit;
296 m += AStep;
297 prev := mi;
298 cnt += 1;
299 end;
300 if
301 not (aipUseCount in Params.Options) or (ABestCount <= 0) or
302 (Abs(cnt - Params.Count) < Abs(ABestCount - Params.Count))
303 then begin
304 ABestStart := start - AStep;
305 ABestStep := AStep;
306 ABestCount := cnt;
307 end;
308 end;
309
310 var
311 minCount, maxCount, bestCount: Integer;
312 s, sv: Double;
313 begin
314 CalcMinMaxCount(minCount, maxCount);
315 bestCount := 0;
316 if aipUseNiceSteps in Params.Options then begin
317 s := AParams.CountToStep(minCount) * 10;
318 while s >= Max(AParams.CountToStep(maxCount), AParams.FMinStep) do begin
319 for sv in Params.StepValues do
320 TryStep(s * sv, bestCount);
321 // We are not required to pick the best count, so any one will do.
322 if not (aipUseCount in Params.Options) and (bestCount > 0) then break;
323 s *= 0.1;
324 end;
325 end;
326 if bestCount > 0 then exit;
327 // Either nice steps were not required, or we failed to find one.
328 if aipUseCount in Params.Options then
329 bestCount := EnsureRange(Params.Count, minCount, maxCount)
330 else
331 bestCount := minCount;
332 ABestStep := (AParams.FMax - AParams.FMin) / bestCount;
333 ABestStart := AParams.FMin - ABestStep;
334 end;
335
336 constructor TIntervalChartSource.Create(AOwner: TComponent);
337 begin
338 inherited Create(AOwner);
339 FParams := TChartAxisIntervalParams.Create(Self);
340 end;
341
342 destructor TIntervalChartSource.Destroy;
343 begin
344 FreeAndNil(FParams);
345 inherited;
346 end;
347
GetCountnull348 function TIntervalChartSource.GetCount: Integer;
349 begin
350 Result := 0;
351 end;
352
GetItemnull353 function TIntervalChartSource.GetItem(AIndex: Integer): PChartDataItem;
354 begin
355 Unused(AIndex);
356 Result := nil;
357 end;
358
359 procedure TIntervalChartSource.SetParams(AValue: TChartAxisIntervalParams);
360 begin
361 if FParams = AValue then exit;
362 FParams.Assign(AValue);
363 InvalidateCaches;
364 Notify;
365 end;
366
367 procedure TIntervalChartSource.SetXCount(AValue: Cardinal);
368 begin
369 Unused(AValue);
370 raise EXCountError.Create('Cannot set XCount');
371 end;
372
373 procedure TIntervalChartSource.SetYCount(AValue: Cardinal);
374 begin
375 Unused(AValue);
376 raise EYCountError.Create('Cannot set YCount');
377 end;
378
379 procedure TIntervalChartSource.ValuesInRange(
380 AParams: TValuesInRangeParams; var AValues: TChartValueTextArray);
381 const
382 // Arbitrary limit to prevent hangup/OOM in case of bug in CalculateIntervals.
383 MAX_COUNT = 10000;
384 var
385 start, step, m, eps: Double;
386 i: Integer;
387 begin
388 if AParams.FMin >= AParams.FMax then exit;
389 AParams.FIntervals := Params;
390
391 if aipGraphCoords in Params.Options then begin
392 AParams.FMin := AParams.FAxisToGraph(AParams.FMin);
393 AParams.FMax := AParams.FAxisToGraph(AParams.FMax);
394 end;
395 EnsureOrder(AParams.FMin, AParams.FMax);
396 CalculateIntervals(AParams, start, step);
397 if step <= 0 then exit;
398 eps := (AParams.FMax - AParams.FMin) * RANGE_EPSILON;
399 m := start;
400 SetLength(AValues, Trunc(Min((AParams.FMax - m) / step + 2, MAX_COUNT)));
401 for i := 0 to High(AValues) do begin
402 if IsZero(m, eps) then
403 m := 0;
404 AValues[i].FValue := m;
405 if m > AParams.FMax then begin
406 SetLength(AValues, i + 1);
407 break;
408 end;
409 m += step;
410 end;
411 if aipGraphCoords in Params.Options then
412 for i := 0 to High(AValues) do
413 AValues[i].FValue := AParams.FGraphToAxis(AValues[i].FValue);
414 for i := 0 to High(AValues) do begin
415 AParams.RoundToImage(AValues[i].FValue);
416 // Extra format arguments for compatibility with FormatItem.
417 AValues[i].FText := Format(
418 AParams.FFormat, [AValues[i].FValue, 0.0, '', 0.0, 0.0]);
419 end;
420 end;
421
422 { TDateTimeStepFormat }
423
424 constructor TDateTimeStepFormat.Create(ASource: TBasicChartSource);
425 begin
426 inherited Create;
427 FSource := ASource;
428 FYearFmt := DEFAULT_YEAR_FORMAT;
429 FMonthFmt := DEFAULT_MONTH_FORMAT;
430 FWeekFmt := DEFAULT_WEEK_FORMAT;
431 FDayFmt := DEFAULT_DAY_FORMAT;
432 FHourFmt := DEFAULT_HOUR_FORMAT;
433 FMinuteFmt := DEFAULT_MINUTE_FORMAT;
434 FSecondFmt := DEFAULT_SECOND_FORMAT;
435 FMillisecondFmt := DEFAULT_MILLISECOND_FORMAT;
436 end;
437
IsStoredYearFmtnull438 function TDateTimeStepFormat.IsStoredYearFmt: Boolean;
439 begin
440 Result := FYearFmt <> DEFAULT_YEAR_FORMAT;
441 end;
442
IsStoredMonthFmtnull443 function TDateTimeStepFormat.IsStoredMonthFmt: Boolean;
444 begin
445 Result := FMonthFmt <> DEFAULT_MONTH_FORMAT;
446 end;
447
TDateTimeStepFormat.IsStoredWeekFmtnull448 function TDateTimeStepFormat.IsStoredWeekFmt: Boolean;
449 begin
450 Result := FWeekFmt <> DEFAULT_WEEK_FORMAT;
451 end;
452
IsStoredDayFmtnull453 function TDateTimeStepFormat.IsStoredDayFmt: Boolean;
454 begin
455 Result := FDayFmt <> DEFAULT_DAY_FORMAT;
456 end;
457
TDateTimeStepFormat.IsStoredHourFmtnull458 function TDateTimeStepFormat.IsStoredHourFmt: Boolean;
459 begin
460 Result := FHourFmt <> DEFAULT_HOUR_FORMAT;
461 end;
462
TDateTimeStepFormat.IsStoredMinuteFmtnull463 function TDateTimeStepFormat.IsStoredMinuteFmt: Boolean;
464 begin
465 Result := FMinuteFmt <> DEFAULT_MINUTE_FORMAT;
466 end;
467
TDateTimeStepFormat.IsStoredSecondFmtnull468 function TDateTimeStepFormat.IsStoredSecondFmt: Boolean;
469 begin
470 Result := FSecondFmt <> DEFAULT_SECOND_FORMAT;
471 end;
472
IsStoredMillisecondFmtnull473 function TDateTimeStepFormat.IsStoredMillisecondFmt: Boolean;
474 begin
475 Result := FMillisecondFmt <> DEFAULT_MILLISECOND_FORMAT;
476 end;
477
478 procedure TDateTimeStepFormat.SetYearFmt(const AValue: String);
479 begin
480 if (AValue <> '') and (AValue <> FYearFmt) then begin
481 FSource.BeginUpdate;
482 FYearFmt := AValue;
483 FSource.EndUpdate;
484 end;
485 end;
486
487 procedure TDateTimeStepFormat.SetMonthFmt(const AValue: String);
488 begin
489 if (AValue <> '') and (AValue <> FMonthFmt) then begin
490 FSource.BeginUpdate;
491 FMonthFmt := AValue;
492 FSource.EndUpdate;
493 end;
494 end;
495
496 procedure TDateTimeStepFormat.SetWeekFmt(const AValue: String);
497 begin
498 if (AValue <> '') and (AValue <> FWeekFmt) then begin
499 FSource.BeginUpdate;
500 FWeekFmt := AValue;
501 FSource.EndUpdate;
502 end;
503 end;
504
505 procedure TDateTimeStepFormat.SetDayFmt(const AValue: String);
506 begin
507 if (AValue <> '') and (AValue <> FDayFmt) then begin
508 FSource.BeginUpdate;
509 FDayFmt := AValue;
510 FSource.EndUpdate;
511 end;
512 end;
513
514 procedure TDateTimeStepFormat.SetHourFmt(const AValue: String);
515 begin
516 if (AValue <> '') and (AValue <> FHourFmt) then begin
517 FSource.BeginUpdate;
518 FHourFmt := AValue;
519 FSource.EndUpdate;
520 end;
521 end;
522
523 procedure TDateTimeStepFormat.SetMinuteFmt(const AValue: String);
524 begin
525 if (AValue <> '') and (AValue <> FMinuteFmt) then begin
526 FSource.BeginUpdate;
527 FMinuteFmt := AValue;
528 FSource.EndUpdate;
529 end;
530 end;
531
532 procedure TDateTimeStepFormat.SetSecondFmt(const AValue: String);
533 begin
534 if (AValue <> '') and (AValue <> FSecondFmt) then begin
535 FSource.BeginUpdate;
536 FSecondFmt := AValue;
537 FSource.EndUpdate;
538 end;
539 end;
540
541 procedure TDateTimeStepFormat.SetMillisecondFmt(const AValue: String);
542 begin
543 if (AValue <> '') and (AValue <> FMillisecondFmt) then begin
544 FSource.BeginUpdate;
545 FMillisecondFmt := AValue;
546 FSource.EndUpdate;
547 end;
548 end;
549
550
551 { TDateTimeIntervalChartSource }
552
553 constructor TDateTimeIntervalChartSource.Create(AOwner: TComponent);
554 begin
555 inherited Create(AOwner);
556 FSteps := DATE_TIME_STEPS_ALL;
557 FSuppressPrevUnit := true;
558 FDateTimeStepFormat := TDateTimeStepFormat.Create(self);
559 end;
560
561 destructor TDateTimeIntervalChartSource.Destroy;
562 begin
563 FDateTimeStepFormat.Free;
564 inherited;
565 end;
566
567 procedure TDateTimeIntervalChartSource.SetDateTimeFormat(AValue: String);
568 begin
569 if FDateTimeFormat = AValue then exit;
570 FDateTimeFormat := AValue;
571 InvalidateCaches;
572 Notify;
573 end;
574
575 procedure TDateTimeIntervalChartSource.SetSteps(AValue: TDateTimeSteps);
576 begin
577 if FSteps = AValue then exit;
578 FSteps := AValue;
579 InvalidateCaches;
580 Notify;
581 end;
582
583 procedure TDateTimeIntervalChartSource.SetSuppressPrevUnit(AValue: Boolean);
584 begin
585 if FSuppressPrevUnit = AValue then exit;
586 BeginUpdate;
587 FSuppressPrevUnit := AValue;
588 EndUpdate;
589 end;
590
591 procedure TDateTimeIntervalChartSource.ValuesInRange(
592 AParams: TValuesInRangeParams; var AValues: TChartValueTextArray);
593 var
594 helper: TDateTimeIntervalsHelper;
595 prevSt: TSystemTime;
596
DoFormatDateTimenull597 function DoFormatDateTime(AFormat: String; AValue: TDateTime): String;
598 var
599 optn: TFormatDateTimeOptions;
600 begin
601 if pos('[', AFormat) > 0 then
602 optn := [fdoInterval]
603 else
604 optn := [];
605 Result := FormatDateTime(AFormat, AValue, optn);
606 end;
607
FormatLabelnull608 function FormatLabel(AValue: TDateTime): String;
609 var
610 st: TSystemTime;
611 begin
612 if DateTimeFormat <> '' then
613 exit(DoFormatDateTime(DateTimeFormat, AValue));
614 DateTimeToSystemTime(AValue, st);
615 case helper.FBestStep of
616 dtsYear:
617 Result := FormatDateTime(DateTimeStepFormat.YearFormat, AValue);
618 dtsQuarter:
619 Result := IntToRoman(Floor(AValue / helper.FStepLen) mod 4 + 1) + '/' +
620 FormatDateTime(DateTimeStepFormat.YearFormat, AValue);
621 dtsMonth:
622 if FSuppressPrevUnit and (st.Year = prevSt.Year) then
623 Result := FormatDateTime('mm', AValue)
624 else
625 Result := FormatDateTime(DateTimeStepFormat.MonthFormat, AValue);
626 dtsWeek:
627 Result := FormatDateTime(DateTimeStepFormat.WeekFormat, AValue);
628 dtsDay:
629 if FSuppressPrevUnit and (st.Month = prevSt.Month) then
630 Result := DoFormatDateTime('dd', AValue)
631 else
632 Result := DoFormatDateTime(DateTimeStepFormat.DayFormat, AValue);
633 dtsHour:
634 if FSuppressPrevUnit and (st.Day = prevSt.Day) then
635 Result := DoFormatDateTime('hh:00', AValue)
636 else
637 Result := DoFormatDateTime(DateTimeStepFormat.HourFormat, AValue);
638 dtsMinute:
639 if FSuppressPrevUnit and (st.Hour = prevSt.Hour) then
640 Result := DoFormatDateTime('nn', AValue)
641 else
642 Result := DoFormatDateTime(DateTimeStepFormat.MinuteFormat, AValue);
643 dtsSecond:
644 if FSuppressPrevUnit and (st.Minute = prevSt.Minute) then
645 Result := DoFormatDateTime('ss', AValue)
646 else
647 Result := DoFormatDateTime(DateTimeStepFormat.SecondFormat, AValue);
648 dtsMillisecond:
649 if FSuppressPrevUnit and (st.Second = prevSt.Second) then
650 Result := IntToStr(st.Millisecond) + 'ms'
651 else
652 Result := DoFormatDateTime(DateTimeStepFormat.MillisecondFormat, AValue);
653 end;
654 if InRange(AValue, helper.FOrigParams.FMin, helper.FOrigParams.FMax) then
655 prevSt := st;
656 end;
657
658 procedure AddValue(AIndex: Integer; AValue: Double);
659 begin
660 with AValues[AIndex] do begin
661 FValue := AValue;
662 FText := Format(
663 AParams.FFormat, [AValue, 0.0, FormatLabel(AValue), 0.0, 0.0]);
664 end;
665 end;
666
667 const
668 MAX_COUNT = 1000; // Arbitraty limit to prevent OOM in case of a bug.
669 var
670 i, cnt: Integer;
671 x, start, stepLen: Double;
672 begin
673 if
674 (AParams.FMin >= AParams.FMax) or (aipGraphCoords in Params.options)
675 then
676 exit;
677 AParams.FIntervals := Params;
678
679 helper.FOrigParams := AParams;
680 AParams.FAxisToGraph := @helper.AxisToGraph;
681 AParams.FGraphToAxis := @helper.GraphToAxis;
682 AParams.FMinStep := 1.0;
683 helper.FBestStepCoeff := SafeInfinity;
684 for helper.FStep in Steps do begin
685 AParams.FMin := helper.FOrigParams.FMin / DATE_STEP_INTERVALS[helper.FStep];
686 AParams.FMax := helper.FOrigParams.FMax / DATE_STEP_INTERVALS[helper.FStep];
687 CalculateIntervals(AParams, start, stepLen);
688 helper.CheckStep(stepLen);
689 end;
690
691 if IsInfinite(helper.FBestStepCoeff) then exit;
692
693 start := helper.StartValue(helper.FOrigParams.FMin);
694 cnt := 1;
695 x := start;
696 while (x <= helper.FOrigParams.FMax) and (cnt < MAX_COUNT) do begin
697 cnt += 1;
698 x := helper.NextValue(x);
699 end;
700 i := Length(AValues);
701 SetLength(AValues, i + cnt);
702
703 FillChar(prevSt, SizeOf(prevSt), $FF);
704 x := start;
705 while (x <= helper.FOrigParams.FMax) and (i < cnt - 1) do begin
706 AddValue(i, x);
707 i += 1;
708 x := helper.NextValue(x);
709 end;
710 AddValue(i, x);
711
712 if Assigned(FOnDateTimeStepChange) then
713 FOnDateTimeStepChange(self, helper.FBestStep);
714 end;
715
716 end.
717
718