mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-05-01 01:25:19 +02:00
717 lines
20 KiB
ObjectPascal
717 lines
20 KiB
ObjectPascal
{
|
|
|
|
*****************************************************************************
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
*****************************************************************************
|
|
|
|
Authors: Alexander Klenin
|
|
|
|
}
|
|
|
|
unit TAIntervalSources;
|
|
|
|
{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, TAChartUtils, TACustomSource;
|
|
|
|
type
|
|
|
|
{ TIntervalChartSource }
|
|
|
|
TIntervalChartSource = class(TCustomChartSource)
|
|
strict private
|
|
FParams: TChartAxisIntervalParams;
|
|
procedure SetParams(AValue: TChartAxisIntervalParams);
|
|
strict protected
|
|
procedure CalculateIntervals(
|
|
AParams: TValuesInRangeParams; out ABestStart, ABestStep: Double);
|
|
protected
|
|
function GetCount: Integer; override;
|
|
function GetItem(AIndex: Integer): PChartDataItem; override;
|
|
procedure SetXCount(AValue: Cardinal); override;
|
|
procedure SetYCount(AValue: Cardinal); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
procedure ValuesInRange(
|
|
AParams: TValuesInRangeParams; var AValues: TChartValueTextArray); override;
|
|
published
|
|
property Params: TChartAxisIntervalParams read FParams write SetParams;
|
|
end;
|
|
|
|
TDateTimeStep = (
|
|
dtsYear, dtsQuarter, dtsMonth, dtsWeek, dtsDay,
|
|
dtsHour, dtsMinute, dtsSecond, dtsMillisecond
|
|
);
|
|
TDateTimeSteps = set of TDateTimeStep;
|
|
|
|
const
|
|
DATE_TIME_STEPS_ALL = [Low(TDateTimeStep) .. High(TDateTimeStep)];
|
|
|
|
type
|
|
|
|
{ TDateTimeStepFormat }
|
|
|
|
TDateTimeStepFormat = class(TPersistent)
|
|
private
|
|
FSource: TBasicChartSource;
|
|
FYearFmt: String;
|
|
FMonthFmt: String;
|
|
FWeekFmt: String;
|
|
FDayFmt: String;
|
|
FHourFmt: String;
|
|
FMinuteFmt: String;
|
|
FSecondFmt: String;
|
|
FMillisecondFmt: String;
|
|
function IsStoredYearFmt: Boolean;
|
|
function IsStoredMonthFmt: Boolean;
|
|
function IsStoredWeekFmt: Boolean;
|
|
function IsStoredDayFmt: Boolean;
|
|
function IsStoredHourFmt: Boolean;
|
|
function IsStoredMinuteFmt: Boolean;
|
|
function IsStoredSecondFmt: Boolean;
|
|
function IsStoredMillisecondFmt: Boolean;
|
|
procedure SetYearFmt(const AValue: String);
|
|
procedure SetMonthFmt(const AValue: String);
|
|
procedure SetWeekFmt(const AValue: String);
|
|
procedure SetDayFmt(const AValue: String);
|
|
procedure SetHourFmt(const AValue: String);
|
|
procedure SetMinuteFmt(const AValue: String);
|
|
procedure SetSecondFmt(const AValue: String);
|
|
procedure SetMillisecondFmt(const AValue: String);
|
|
public
|
|
constructor Create(ASource: TBasicChartSource);
|
|
published
|
|
property YearFormat: String
|
|
read FYearFmt write SetYearFmt stored IsStoredYearFmt;
|
|
property MonthFormat: String
|
|
read FMonthFmt write SetMonthFmt stored IsStoredMonthFmt;
|
|
property WeekFormat: String
|
|
read FWeekFmt write SetWeekFmt stored IsStoredWeekFmt;
|
|
property DayFormat: String
|
|
read FDayFmt write SetDayFmt stored IsStoredDayFmt;
|
|
property HourFormat: String
|
|
read FHourFmt write SetHourFmt stored IsStoredHourFmt;
|
|
property MinuteFormat: String
|
|
read FMinuteFmt write SetMinuteFmt stored IsStoredMinuteFmt;
|
|
property SecondFormat: String
|
|
read FSecondFmt write SetSecondFmt stored IsStoredSecondFmt;
|
|
property MillisecondFormat: String
|
|
read FMillisecondFmt write SetMillisecondFmt stored IsStoredMillisecondFmt;
|
|
end;
|
|
|
|
{ TDateTimeIntervalChartSource }
|
|
|
|
TDateTimeStepChangeEvent = procedure (Sender: TObject; ASteps: TDateTimeStep) of object;
|
|
|
|
TDateTimeIntervalChartSource = class(TIntervalChartSource)
|
|
strict private
|
|
FDateTimeFormat: String;
|
|
FDateTimeStepFormat: TDateTimeStepFormat;
|
|
FSteps: TDateTimeSteps;
|
|
FSuppressPrevUnit: Boolean;
|
|
FOnDateTimeStepChange: TDateTimeStepChangeEvent;
|
|
procedure SetDateTimeFormat(AValue: String);
|
|
procedure SetSteps(AValue: TDateTimeSteps);
|
|
procedure SetSuppressPrevUnit(AValue: Boolean);
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure ValuesInRange(
|
|
AParams: TValuesInRangeParams; var AValues: TChartValueTextArray); override;
|
|
published
|
|
property DateTimeFormat: String
|
|
read FDateTimeFormat write SetDateTimeFormat;
|
|
property DateTimeStepFormat: TDateTimeStepFormat
|
|
read FDateTimeStepFormat write FDateTimeStepFormat;
|
|
property Steps: TDateTimeSteps
|
|
read FSteps write SetSteps default DATE_TIME_STEPS_ALL;
|
|
property SuppressPrevUnit: Boolean
|
|
read FSuppressPrevUnit write SetSuppressPrevUnit default true;
|
|
property OnDateTimeStepChange: TDateTimeStepChangeEvent
|
|
read FOnDateTimeStepChange write FOnDateTimeStepChange;
|
|
end;
|
|
|
|
const
|
|
DEFAULT_YEAR_FORMAT = 'yyyy';
|
|
// DEFAULT_QUARTER_FORMAT = 'Q/yyyy';
|
|
DEFAULT_MONTH_FORMAT = 'mm/yyyy';
|
|
DEFAULT_WEEK_FORMAT = 'dd/mm';
|
|
DEFAULT_DAY_FORMAT = 'dd/mm';
|
|
DEFAULT_HOUR_FORMAT = 'dd hh:nn';
|
|
DEFAULT_MINUTE_FORMAT = 'hh:nn';
|
|
DEFAULT_SECOND_FORMAT = 'nn:ss';
|
|
DEFAULT_MILLISECOND_FORMAT = 'szzz"ms"';
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
uses
|
|
DateUtils, Math, StrUtils, SysUtils, TAMath;
|
|
|
|
const
|
|
YEAR = 365.25;
|
|
DATE_STEP_INTERVALS: array [TDateTimeStep] of Double = (
|
|
YEAR, YEAR / 4, YEAR / 12, 7, 1,
|
|
OneHour, OneMinute, OneSecond, OneMillisecond
|
|
);
|
|
|
|
type
|
|
TSourceIntervalParams = class(TChartAxisIntervalParams)
|
|
strict protected
|
|
procedure Changed; override;
|
|
end;
|
|
|
|
TDateTimeIntervalsHelper = object
|
|
FBestStep: TDateTimeStep;
|
|
FBestStepCoeff: Double;
|
|
FOrigParams: TValuesInRangeParams;
|
|
FStep: TDateTimeStep;
|
|
FStepLen: Double;
|
|
|
|
function AxisToGraph(AX: Double): Double;
|
|
procedure CheckStep(AStepCoeff: Double);
|
|
function GraphToAxis(AX: Double): Double;
|
|
function NextValue(AValue: TDateTime): Double;
|
|
function StartValue(AValue: TDateTime): TDateTime;
|
|
end;
|
|
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents(
|
|
CHART_COMPONENT_IDE_PAGE, [
|
|
TIntervalChartSource, TDateTimeIntervalChartSource
|
|
]);
|
|
end;
|
|
|
|
function SafeRound(AValue: Double): Double; inline;
|
|
begin
|
|
Result := Int(AValue * 1e9) / 1e9;
|
|
end;
|
|
|
|
{ TDateTimeIntervalsHelper }
|
|
|
|
function TDateTimeIntervalsHelper.AxisToGraph(AX: Double): Double;
|
|
begin
|
|
Result := FOrigParams.FAxisToGraph(AX) * DATE_STEP_INTERVALS[FStep];
|
|
end;
|
|
|
|
procedure TDateTimeIntervalsHelper.CheckStep(AStepCoeff: Double);
|
|
begin
|
|
// Strict inequaltity is importatnt to avoid steps like "ten quarters".
|
|
if (1.0 <= AStepCoeff) and (AStepCoeff < FBestStepCoeff) then begin
|
|
FBestStepCoeff := AStepCoeff;
|
|
FBestStep := FStep;
|
|
FStepLen := DATE_STEP_INTERVALS[FBestStep] * FBestStepCoeff;
|
|
end;
|
|
end;
|
|
|
|
function TDateTimeIntervalsHelper.GraphToAxis(AX: Double): Double;
|
|
begin
|
|
Result := FOrigParams.FGraphToAxis(AX / DATE_STEP_INTERVALS[FStep]);
|
|
end;
|
|
|
|
function TDateTimeIntervalsHelper.NextValue(AValue: TDateTime): Double;
|
|
begin
|
|
case FBestStep of
|
|
dtsYear:
|
|
if FBestStepCoeff > 10 then
|
|
// DateTime arithmetics fails on large year numbers.
|
|
Result := AValue + FStepLen
|
|
else
|
|
Result := IncYear(AValue, Round(FBestStepCoeff));
|
|
dtsMonth: Result := IncMonth(AValue, Round(FBestStepCoeff));
|
|
otherwise Result := AValue + FStepLen;
|
|
end;
|
|
end;
|
|
|
|
function TDateTimeIntervalsHelper.StartValue(AValue: TDateTime): TDateTime;
|
|
begin
|
|
Result := Int(AValue / FStepLen - 1) * FStepLen;
|
|
case FBestStep of
|
|
dtsYear:
|
|
// DateTime arithmetics fails on large year numbers.
|
|
if FBestStepCoeff <= 10 then
|
|
Result := StartOfTheYear(AValue);
|
|
dtsMonth: Result := StartOfTheMonth(AValue);
|
|
end;
|
|
end;
|
|
|
|
{ TSourceIntervalParams }
|
|
|
|
procedure TSourceIntervalParams.Changed;
|
|
begin
|
|
with GetOwner as TCustomChartSource do begin
|
|
BeginUpdate;
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
{ TIntervalChartSource }
|
|
|
|
procedure TIntervalChartSource.CalculateIntervals(
|
|
AParams: TValuesInRangeParams; out ABestStart, ABestStep: Double);
|
|
|
|
procedure CalcMinMaxCount(out AMinCount, AMaxCount: Integer);
|
|
var
|
|
imageWidth, len: Integer;
|
|
begin
|
|
// If the axis transformation is non-linear, steps may not be equidistant.
|
|
// However, both minimax and maximin will be achieved on equal steps.
|
|
with AParams do
|
|
imageWidth := Abs(ToImage(FMax) - ToImage(FMin));
|
|
if aipUseMinLength in Params.Options then
|
|
len := AParams.FScale(Max(Params.MinLength, 2))
|
|
else
|
|
len := 2;
|
|
AMaxCount := Max(imageWidth div len, 2);
|
|
if aipUseMaxLength in Params.Options then begin
|
|
len := AParams.FScale(Max(Params.MaxLength, 2));
|
|
AMinCount := Max((imageWidth + 1) div len, 2);
|
|
end
|
|
else
|
|
AMinCount := 2;
|
|
end;
|
|
|
|
procedure TryStep(AStep: Double; var ABestCount: Integer);
|
|
var
|
|
m, start: Double;
|
|
mi, prev, cnt: Int64;
|
|
begin
|
|
if AStep <= 0 then exit;
|
|
start := Int(AParams.FMin / AStep) * AStep;
|
|
m := start;
|
|
prev := AParams.ToImage(m);
|
|
cnt := 0;
|
|
while m <= AParams.FMax do begin
|
|
mi := AParams.ToImage(m + AStep);
|
|
if not AParams.IsAcceptableStep(Abs(prev - mi)) then exit;
|
|
m += AStep;
|
|
prev := mi;
|
|
cnt += 1;
|
|
end;
|
|
if
|
|
not (aipUseCount in Params.Options) or (ABestCount <= 0) or
|
|
(Abs(cnt - Params.Count) < Abs(ABestCount - Params.Count))
|
|
then begin
|
|
ABestStart := start - AStep;
|
|
ABestStep := AStep;
|
|
ABestCount := cnt;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
minCount, maxCount, bestCount: Integer;
|
|
s, sv: Double;
|
|
begin
|
|
CalcMinMaxCount(minCount, maxCount);
|
|
bestCount := 0;
|
|
if aipUseNiceSteps in Params.Options then begin
|
|
s := AParams.CountToStep(minCount) * 10;
|
|
while s >= Max(AParams.CountToStep(maxCount), AParams.FMinStep) do begin
|
|
for sv in Params.StepValues do
|
|
TryStep(s * sv, bestCount);
|
|
// We are not required to pick the best count, so any one will do.
|
|
if not (aipUseCount in Params.Options) and (bestCount > 0) then break;
|
|
s *= 0.1;
|
|
end;
|
|
end;
|
|
if bestCount > 0 then exit;
|
|
// Either nice steps were not required, or we failed to find one.
|
|
if aipUseCount in Params.Options then
|
|
bestCount := EnsureRange(Params.Count, minCount, maxCount)
|
|
else
|
|
bestCount := minCount;
|
|
ABestStep := (AParams.FMax - AParams.FMin) / bestCount;
|
|
ABestStart := AParams.FMin - ABestStep;
|
|
end;
|
|
|
|
constructor TIntervalChartSource.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FParams := TChartAxisIntervalParams.Create(Self);
|
|
end;
|
|
|
|
destructor TIntervalChartSource.Destroy;
|
|
begin
|
|
FreeAndNil(FParams);
|
|
inherited;
|
|
end;
|
|
|
|
function TIntervalChartSource.GetCount: Integer;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TIntervalChartSource.GetItem(AIndex: Integer): PChartDataItem;
|
|
begin
|
|
Unused(AIndex);
|
|
Result := nil;
|
|
end;
|
|
|
|
procedure TIntervalChartSource.SetParams(AValue: TChartAxisIntervalParams);
|
|
begin
|
|
if FParams = AValue then exit;
|
|
FParams.Assign(AValue);
|
|
InvalidateCaches;
|
|
Notify;
|
|
end;
|
|
|
|
procedure TIntervalChartSource.SetXCount(AValue: Cardinal);
|
|
begin
|
|
Unused(AValue);
|
|
raise EXCountError.Create('Cannot set XCount');
|
|
end;
|
|
|
|
procedure TIntervalChartSource.SetYCount(AValue: Cardinal);
|
|
begin
|
|
Unused(AValue);
|
|
raise EYCountError.Create('Cannot set YCount');
|
|
end;
|
|
|
|
procedure TIntervalChartSource.ValuesInRange(
|
|
AParams: TValuesInRangeParams; var AValues: TChartValueTextArray);
|
|
const
|
|
// Arbitrary limit to prevent hangup/OOM in case of bug in CalculateIntervals.
|
|
MAX_COUNT = 10000;
|
|
var
|
|
start, step, m, eps: Double;
|
|
i: Integer;
|
|
begin
|
|
if AParams.FMin >= AParams.FMax then exit;
|
|
AParams.FIntervals := Params;
|
|
|
|
if aipGraphCoords in Params.Options then begin
|
|
AParams.FMin := AParams.FAxisToGraph(AParams.FMin);
|
|
AParams.FMax := AParams.FAxisToGraph(AParams.FMax);
|
|
end;
|
|
EnsureOrder(AParams.FMin, AParams.FMax);
|
|
CalculateIntervals(AParams, start, step);
|
|
if step <= 0 then exit;
|
|
eps := (AParams.FMax - AParams.FMin) * RANGE_EPSILON;
|
|
m := start;
|
|
SetLength(AValues, Trunc(Min((AParams.FMax - m) / step + 2, MAX_COUNT)));
|
|
for i := 0 to High(AValues) do begin
|
|
if IsZero(m, eps) then
|
|
m := 0;
|
|
AValues[i].FValue := m;
|
|
if m > AParams.FMax then begin
|
|
SetLength(AValues, i + 1);
|
|
break;
|
|
end;
|
|
m += step;
|
|
end;
|
|
if aipGraphCoords in Params.Options then
|
|
for i := 0 to High(AValues) do
|
|
AValues[i].FValue := AParams.FGraphToAxis(AValues[i].FValue);
|
|
for i := 0 to High(AValues) do begin
|
|
AParams.RoundToImage(AValues[i].FValue);
|
|
// Extra format arguments for compatibility with FormatItem.
|
|
AValues[i].FText := Format(
|
|
AParams.FFormat, [AValues[i].FValue, 0.0, '', 0.0, 0.0]);
|
|
end;
|
|
end;
|
|
|
|
{ TDateTimeStepFormat }
|
|
|
|
constructor TDateTimeStepFormat.Create(ASource: TBasicChartSource);
|
|
begin
|
|
inherited Create;
|
|
FSource := ASource;
|
|
FYearFmt := DEFAULT_YEAR_FORMAT;
|
|
FMonthFmt := DEFAULT_MONTH_FORMAT;
|
|
FWeekFmt := DEFAULT_WEEK_FORMAT;
|
|
FDayFmt := DEFAULT_DAY_FORMAT;
|
|
FHourFmt := DEFAULT_HOUR_FORMAT;
|
|
FMinuteFmt := DEFAULT_MINUTE_FORMAT;
|
|
FSecondFmt := DEFAULT_SECOND_FORMAT;
|
|
FMillisecondFmt := DEFAULT_MILLISECOND_FORMAT;
|
|
end;
|
|
|
|
function TDateTimeStepFormat.IsStoredYearFmt: Boolean;
|
|
begin
|
|
Result := FYearFmt <> DEFAULT_YEAR_FORMAT;
|
|
end;
|
|
|
|
function TDateTimeStepFormat.IsStoredMonthFmt: Boolean;
|
|
begin
|
|
Result := FMonthFmt <> DEFAULT_MONTH_FORMAT;
|
|
end;
|
|
|
|
function TDateTimeStepFormat.IsStoredWeekFmt: Boolean;
|
|
begin
|
|
Result := FWeekFmt <> DEFAULT_WEEK_FORMAT;
|
|
end;
|
|
|
|
function TDateTimeStepFormat.IsStoredDayFmt: Boolean;
|
|
begin
|
|
Result := FDayFmt <> DEFAULT_DAY_FORMAT;
|
|
end;
|
|
|
|
function TDateTimeStepFormat.IsStoredHourFmt: Boolean;
|
|
begin
|
|
Result := FHourFmt <> DEFAULT_HOUR_FORMAT;
|
|
end;
|
|
|
|
function TDateTimeStepFormat.IsStoredMinuteFmt: Boolean;
|
|
begin
|
|
Result := FMinuteFmt <> DEFAULT_MINUTE_FORMAT;
|
|
end;
|
|
|
|
function TDateTimeStepFormat.IsStoredSecondFmt: Boolean;
|
|
begin
|
|
Result := FSecondFmt <> DEFAULT_SECOND_FORMAT;
|
|
end;
|
|
|
|
function TDateTimeStepFormat.IsStoredMillisecondFmt: Boolean;
|
|
begin
|
|
Result := FMillisecondFmt <> DEFAULT_MILLISECOND_FORMAT;
|
|
end;
|
|
|
|
procedure TDateTimeStepFormat.SetYearFmt(const AValue: String);
|
|
begin
|
|
if (AValue <> '') and (AValue <> FYearFmt) then begin
|
|
FSource.BeginUpdate;
|
|
FYearFmt := AValue;
|
|
FSource.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TDateTimeStepFormat.SetMonthFmt(const AValue: String);
|
|
begin
|
|
if (AValue <> '') and (AValue <> FMonthFmt) then begin
|
|
FSource.BeginUpdate;
|
|
FMonthFmt := AValue;
|
|
FSource.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TDateTimeStepFormat.SetWeekFmt(const AValue: String);
|
|
begin
|
|
if (AValue <> '') and (AValue <> FWeekFmt) then begin
|
|
FSource.BeginUpdate;
|
|
FWeekFmt := AValue;
|
|
FSource.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TDateTimeStepFormat.SetDayFmt(const AValue: String);
|
|
begin
|
|
if (AValue <> '') and (AValue <> FDayFmt) then begin
|
|
FSource.BeginUpdate;
|
|
FDayFmt := AValue;
|
|
FSource.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TDateTimeStepFormat.SetHourFmt(const AValue: String);
|
|
begin
|
|
if (AValue <> '') and (AValue <> FHourFmt) then begin
|
|
FSource.BeginUpdate;
|
|
FHourFmt := AValue;
|
|
FSource.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TDateTimeStepFormat.SetMinuteFmt(const AValue: String);
|
|
begin
|
|
if (AValue <> '') and (AValue <> FMinuteFmt) then begin
|
|
FSource.BeginUpdate;
|
|
FMinuteFmt := AValue;
|
|
FSource.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TDateTimeStepFormat.SetSecondFmt(const AValue: String);
|
|
begin
|
|
if (AValue <> '') and (AValue <> FSecondFmt) then begin
|
|
FSource.BeginUpdate;
|
|
FSecondFmt := AValue;
|
|
FSource.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
procedure TDateTimeStepFormat.SetMillisecondFmt(const AValue: String);
|
|
begin
|
|
if (AValue <> '') and (AValue <> FMillisecondFmt) then begin
|
|
FSource.BeginUpdate;
|
|
FMillisecondFmt := AValue;
|
|
FSource.EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TDateTimeIntervalChartSource }
|
|
|
|
constructor TDateTimeIntervalChartSource.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FSteps := DATE_TIME_STEPS_ALL;
|
|
FSuppressPrevUnit := true;
|
|
FDateTimeStepFormat := TDateTimeStepFormat.Create(self);
|
|
end;
|
|
|
|
destructor TDateTimeIntervalChartSource.Destroy;
|
|
begin
|
|
FDateTimeStepFormat.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDateTimeIntervalChartSource.SetDateTimeFormat(AValue: String);
|
|
begin
|
|
if FDateTimeFormat = AValue then exit;
|
|
FDateTimeFormat := AValue;
|
|
InvalidateCaches;
|
|
Notify;
|
|
end;
|
|
|
|
procedure TDateTimeIntervalChartSource.SetSteps(AValue: TDateTimeSteps);
|
|
begin
|
|
if FSteps = AValue then exit;
|
|
FSteps := AValue;
|
|
InvalidateCaches;
|
|
Notify;
|
|
end;
|
|
|
|
procedure TDateTimeIntervalChartSource.SetSuppressPrevUnit(AValue: Boolean);
|
|
begin
|
|
if FSuppressPrevUnit = AValue then exit;
|
|
BeginUpdate;
|
|
FSuppressPrevUnit := AValue;
|
|
EndUpdate;
|
|
end;
|
|
|
|
procedure TDateTimeIntervalChartSource.ValuesInRange(
|
|
AParams: TValuesInRangeParams; var AValues: TChartValueTextArray);
|
|
var
|
|
helper: TDateTimeIntervalsHelper;
|
|
prevSt: TSystemTime;
|
|
|
|
function DoFormatDateTime(AFormat: String; AValue: TDateTime): String;
|
|
var
|
|
optn: TFormatDateTimeOptions;
|
|
begin
|
|
if pos('[', AFormat) > 0 then
|
|
optn := [fdoInterval]
|
|
else
|
|
optn := [];
|
|
Result := FormatDateTime(AFormat, AValue, optn);
|
|
end;
|
|
|
|
function FormatLabel(AValue: TDateTime): String;
|
|
var
|
|
st: TSystemTime;
|
|
begin
|
|
if DateTimeFormat <> '' then
|
|
exit(DoFormatDateTime(DateTimeFormat, AValue));
|
|
DateTimeToSystemTime(AValue, st);
|
|
case helper.FBestStep of
|
|
dtsYear:
|
|
Result := FormatDateTime(DateTimeStepFormat.YearFormat, AValue);
|
|
dtsQuarter:
|
|
Result := IntToRoman(Floor(AValue / helper.FStepLen) mod 4 + 1) + '/' +
|
|
FormatDateTime(DateTimeStepFormat.YearFormat, AValue);
|
|
dtsMonth:
|
|
if FSuppressPrevUnit and (st.Year = prevSt.Year) then
|
|
Result := FormatDateTime('mm', AValue)
|
|
else
|
|
Result := FormatDateTime(DateTimeStepFormat.MonthFormat, AValue);
|
|
dtsWeek:
|
|
Result := FormatDateTime(DateTimeStepFormat.WeekFormat, AValue);
|
|
dtsDay:
|
|
if FSuppressPrevUnit and (st.Month = prevSt.Month) then
|
|
Result := DoFormatDateTime('dd', AValue)
|
|
else
|
|
Result := DoFormatDateTime(DateTimeStepFormat.DayFormat, AValue);
|
|
dtsHour:
|
|
if FSuppressPrevUnit and (st.Day = prevSt.Day) then
|
|
Result := DoFormatDateTime('hh:00', AValue)
|
|
else
|
|
Result := DoFormatDateTime(DateTimeStepFormat.HourFormat, AValue);
|
|
dtsMinute:
|
|
if FSuppressPrevUnit and (st.Hour = prevSt.Hour) then
|
|
Result := DoFormatDateTime('nn', AValue)
|
|
else
|
|
Result := DoFormatDateTime(DateTimeStepFormat.MinuteFormat, AValue);
|
|
dtsSecond:
|
|
if FSuppressPrevUnit and (st.Minute = prevSt.Minute) then
|
|
Result := DoFormatDateTime('ss', AValue)
|
|
else
|
|
Result := DoFormatDateTime(DateTimeStepFormat.SecondFormat, AValue);
|
|
dtsMillisecond:
|
|
if FSuppressPrevUnit and (st.Second = prevSt.Second) then
|
|
Result := IntToStr(st.Millisecond) + 'ms'
|
|
else
|
|
Result := DoFormatDateTime(DateTimeStepFormat.MillisecondFormat, AValue);
|
|
end;
|
|
if InRange(AValue, helper.FOrigParams.FMin, helper.FOrigParams.FMax) then
|
|
prevSt := st;
|
|
end;
|
|
|
|
procedure AddValue(AIndex: Integer; AValue: Double);
|
|
begin
|
|
with AValues[AIndex] do begin
|
|
FValue := AValue;
|
|
FText := Format(
|
|
AParams.FFormat, [AValue, 0.0, FormatLabel(AValue), 0.0, 0.0]);
|
|
end;
|
|
end;
|
|
|
|
const
|
|
MAX_COUNT = 1000; // Arbitraty limit to prevent OOM in case of a bug.
|
|
var
|
|
i, cnt: Integer;
|
|
x, start, stepLen: Double;
|
|
begin
|
|
if
|
|
(AParams.FMin >= AParams.FMax) or (aipGraphCoords in Params.options)
|
|
then
|
|
exit;
|
|
AParams.FIntervals := Params;
|
|
|
|
helper.FOrigParams := AParams;
|
|
AParams.FAxisToGraph := @helper.AxisToGraph;
|
|
AParams.FGraphToAxis := @helper.GraphToAxis;
|
|
AParams.FMinStep := 1.0;
|
|
helper.FBestStepCoeff := SafeInfinity;
|
|
for helper.FStep in Steps do begin
|
|
AParams.FMin := helper.FOrigParams.FMin / DATE_STEP_INTERVALS[helper.FStep];
|
|
AParams.FMax := helper.FOrigParams.FMax / DATE_STEP_INTERVALS[helper.FStep];
|
|
CalculateIntervals(AParams, start, stepLen);
|
|
helper.CheckStep(stepLen);
|
|
end;
|
|
|
|
if IsInfinite(helper.FBestStepCoeff) then exit;
|
|
|
|
start := helper.StartValue(helper.FOrigParams.FMin);
|
|
cnt := 1;
|
|
x := start;
|
|
while (x <= helper.FOrigParams.FMax) and (cnt < MAX_COUNT) do begin
|
|
cnt += 1;
|
|
x := helper.NextValue(x);
|
|
end;
|
|
i := Length(AValues);
|
|
SetLength(AValues, i + cnt);
|
|
|
|
FillChar(prevSt, SizeOf(prevSt), $FF);
|
|
x := start;
|
|
while (x <= helper.FOrigParams.FMax) and (i < cnt - 1) do begin
|
|
AddValue(i, x);
|
|
i += 1;
|
|
x := helper.NextValue(x);
|
|
end;
|
|
AddValue(i, x);
|
|
|
|
if Assigned(FOnDateTimeStepChange) then
|
|
FOnDateTimeStepChange(self, helper.FBestStep);
|
|
end;
|
|
|
|
end.
|
|
|