mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-26 21:43:58 +02:00
881 lines
22 KiB
ObjectPascal
881 lines
22 KiB
ObjectPascal
{
|
|
|
|
*****************************************************************************
|
|
* *
|
|
* See the file COPYING.modifiedLGPL.txt, included in this distribution, *
|
|
* for details about the copyright. *
|
|
* *
|
|
* This program is distributed in the hope that it will be useful, *
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of *
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. *
|
|
* *
|
|
*****************************************************************************
|
|
|
|
Authors: Alexander Klenin
|
|
|
|
}
|
|
|
|
unit TACustomSource;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, Types, TAChartUtils;
|
|
|
|
type
|
|
TAxisIntervalParamOption = (
|
|
aipGraphCoords,
|
|
aipUseCount, aipUseMaxLength, aipUseMinLength, aipUseNiceSteps);
|
|
|
|
const
|
|
DEF_INTERVAL_STEPS = '0.2|0.5|1.0';
|
|
DEF_INTERVAL_OPTIONS = [aipUseMaxLength, aipUseMinLength, aipUseNiceSteps];
|
|
|
|
type
|
|
TAxisIntervalParamOptions = set of TAxisIntervalParamOption;
|
|
|
|
TChartAxisIntervalParams = class(TPersistent)
|
|
strict private
|
|
FCount: Integer;
|
|
FMaxLength: Integer;
|
|
FMinLength: Integer;
|
|
FNiceSteps: String;
|
|
FOptions: TAxisIntervalParamOptions;
|
|
FOwner: TPersistent;
|
|
FStepValues: TDoubleDynArray;
|
|
FTolerance: Cardinal;
|
|
function NiceStepsIsStored: Boolean;
|
|
procedure ParseNiceSteps;
|
|
procedure SetCount(AValue: Integer);
|
|
procedure SetMaxLength(AValue: Integer);
|
|
procedure SetMinLength(AValue: Integer);
|
|
procedure SetNiceSteps(const AValue: String);
|
|
procedure SetOptions(AValue: TAxisIntervalParamOptions);
|
|
procedure SetTolerance(AValue: Cardinal);
|
|
strict protected
|
|
procedure Changed; virtual;
|
|
protected
|
|
function GetOwner: TPersistent; override;
|
|
public
|
|
procedure Assign(ASource: TPersistent); override;
|
|
constructor Create(AOwner: TPersistent);
|
|
property StepValues: TDoubleDynArray read FStepValues;
|
|
published
|
|
property Count: Integer read FCount write SetCount default 5;
|
|
property MaxLength: Integer read FMaxLength write SetMaxLength default 50;
|
|
property MinLength: Integer read FMinLength write SetMinLength default 10;
|
|
property NiceSteps: String
|
|
read FNiceSteps write SetNiceSteps stored NiceStepsIsStored;
|
|
property Options: TAxisIntervalParamOptions
|
|
read FOptions write SetOptions default DEF_INTERVAL_OPTIONS;
|
|
property Tolerance: Cardinal read FTolerance write SetTolerance default 0;
|
|
end;
|
|
|
|
type
|
|
EBufferError = class(EChartError);
|
|
EEditableSourceRequired = class(EChartError);
|
|
EYCountError = class(EChartError);
|
|
|
|
TChartValueText = record
|
|
FText: String;
|
|
FValue: Double;
|
|
end;
|
|
PChartValueText = ^TChartValueText;
|
|
|
|
TChartValueTextArray = array of TChartValueText;
|
|
|
|
{ TChartDataItem }
|
|
|
|
TChartDataItem = object
|
|
X, Y: Double;
|
|
Color: TChartColor;
|
|
Text: String;
|
|
YList: TDoubleDynArray;
|
|
function GetY(AIndex: Integer): Double;
|
|
procedure SetY(AValue: Double);
|
|
procedure MultiplyY(ACoeff: Double);
|
|
function Point: TDoublePoint; inline;
|
|
end;
|
|
PChartDataItem = ^TChartDataItem;
|
|
|
|
TGraphToImageFunc = function (AX: Double): Integer of object;
|
|
TIntegerTransformFunc = function (AX: Integer): Integer of object;
|
|
|
|
TValuesInRangeParams = object
|
|
FAxisToGraph: TTransformFunc;
|
|
FFormat: String;
|
|
FGraphToAxis: TTransformFunc;
|
|
FGraphToImage: TGraphToImageFunc;
|
|
FIntervals: TChartAxisIntervalParams;
|
|
FMin, FMax: Double;
|
|
FMinStep: Double;
|
|
FScale: TIntegerTransformFunc;
|
|
FUseY: Boolean;
|
|
|
|
function CountToStep(ACount: Integer): Double; inline;
|
|
function IsAcceptableStep(AStep: Integer): Boolean; inline;
|
|
function ToImage(AX: Double): Integer; inline;
|
|
end;
|
|
|
|
TCustomChartSource = class;
|
|
|
|
TCustomChartSourceEnumerator = class
|
|
strict private
|
|
FSource: TCustomChartSource;
|
|
FIndex: Integer;
|
|
public
|
|
constructor Create(ASource: TCustomChartSource);
|
|
function GetCurrent: PChartDataItem;
|
|
function MoveNext: Boolean;
|
|
procedure Reset;
|
|
property Current: PChartDataItem read GetCurrent;
|
|
end;
|
|
|
|
TCustomChartSource = class(TComponent)
|
|
strict private
|
|
FBroadcaster: TBroadcaster;
|
|
FUpdateCount: Integer;
|
|
|
|
procedure SortValuesInRange(
|
|
var AValues: TChartValueTextArray; AStart, AEnd: Integer);
|
|
strict protected
|
|
FExtent: TDoubleRect;
|
|
FExtentIsValid: Boolean;
|
|
FValuesTotal: Double;
|
|
FValuesTotalIsValid: Boolean;
|
|
FYCount: Cardinal;
|
|
|
|
function GetCount: Integer; virtual; abstract;
|
|
function GetItem(AIndex: Integer): PChartDataItem; virtual; abstract;
|
|
procedure InvalidateCaches;
|
|
procedure Notify;
|
|
procedure SetYCount(AValue: Cardinal); virtual; abstract;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
public
|
|
procedure AfterDraw; virtual;
|
|
procedure BeforeDraw; virtual;
|
|
procedure BeginUpdate;
|
|
procedure EndUpdate; virtual;
|
|
function IsUpdating: Boolean; inline;
|
|
public
|
|
class procedure CheckFormat(const AFormat: String);
|
|
function Extent: TDoubleRect;
|
|
function ExtentCumulative: TDoubleRect;
|
|
function ExtentList: TDoubleRect;
|
|
procedure FindBounds(AXMin, AXMax: Double; out ALB, AUB: Integer);
|
|
function FormatItem(
|
|
const AFormat: String; AIndex, AYIndex: Integer): String;
|
|
function GetEnumerator: TCustomChartSourceEnumerator;
|
|
function IsSorted: Boolean; virtual;
|
|
procedure ValuesInRange(
|
|
AParams: TValuesInRangeParams; var AValues: TChartValueTextArray); virtual;
|
|
function ValuesTotal: Double; virtual;
|
|
function XOfMax: Double;
|
|
function XOfMin: Double;
|
|
|
|
property Broadcaster: TBroadcaster read FBroadcaster;
|
|
property Count: Integer read GetCount;
|
|
property Item[AIndex: Integer]: PChartDataItem read GetItem; default;
|
|
property YCount: Cardinal read FYCount write SetYCount default 1;
|
|
end;
|
|
|
|
{ TChartSourceBuffer }
|
|
|
|
TChartSourceBuffer = class
|
|
strict private
|
|
FBuf: array of TChartDataItem;
|
|
FCount: Cardinal;
|
|
FStart: Cardinal;
|
|
FSum: TChartDataItem;
|
|
procedure AddValue(const AItem: TChartDataItem);
|
|
function EndIndex: Cardinal; inline;
|
|
function GetCapacity: Cardinal; inline;
|
|
procedure SetCapacity(AValue: Cardinal); inline;
|
|
public
|
|
procedure AddFirst(const AItem: TChartDataItem);
|
|
procedure AddLast(const AItem: TChartDataItem);
|
|
procedure Clear; inline;
|
|
function GetPtr(AOffset: Cardinal): PChartDataItem; overload;
|
|
procedure GetSum(var AItem: TChartDataItem);
|
|
procedure RemoveFirst;
|
|
procedure RemoveLast;
|
|
procedure RemoveValue(const AItem: TChartDataItem);
|
|
property Capacity: Cardinal read GetCapacity write SetCapacity;
|
|
end;
|
|
|
|
procedure SetDataItemDefaults(var AItem: TChartDataItem);
|
|
|
|
implementation
|
|
|
|
uses
|
|
Math, StrUtils, SysUtils, TAMath;
|
|
|
|
function CompareChartValueTextPtr(AItem1, AItem2: Pointer): Integer;
|
|
begin
|
|
Result := CompareValue(
|
|
PChartValueText(AItem1)^.FValue,
|
|
PChartValueText(AItem2)^.FValue);
|
|
end;
|
|
|
|
function IsValueTextsSorted(
|
|
const AValues: TChartValueTextArray; AStart, AEnd: Integer): Boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := AStart to AEnd - 1 do
|
|
if AValues[i].FValue > AValues[i + 1].FValue then exit(false);
|
|
Result := true;
|
|
end;
|
|
|
|
procedure SetDataItemDefaults(var AItem: TChartDataItem);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
AItem.X := 0;
|
|
AItem.Y := 0;
|
|
AItem.Color := clTAColor;
|
|
AItem.Text := '';
|
|
for i := 0 to High(AItem.YList) do
|
|
AItem.YList[i] := 0;
|
|
end;
|
|
|
|
{ TValuesInRangeParams }
|
|
|
|
function TValuesInRangeParams.CountToStep(ACount: Integer): Double;
|
|
begin
|
|
Result := Power(10, Floor(Log10((FMax - FMin) / ACount)));
|
|
end;
|
|
|
|
function TValuesInRangeParams.IsAcceptableStep(AStep: Integer): Boolean;
|
|
begin
|
|
with FIntervals do
|
|
Result := not (
|
|
(aipUseMinLength in Options) and (AStep < FScale(MinLength)) or
|
|
(aipUseMaxLength in Options) and (AStep > FScale(MaxLength)));
|
|
end;
|
|
|
|
function TValuesInRangeParams.ToImage(AX: Double): Integer;
|
|
begin
|
|
if not (aipGraphCoords in FIntervals.Options) then
|
|
AX := FAxisToGraph(AX);
|
|
Result := FGraphToImage(AX);
|
|
end;
|
|
|
|
{ TChartAxisIntervalParams }
|
|
|
|
procedure TChartAxisIntervalParams.Assign(ASource: TPersistent);
|
|
begin
|
|
if ASource is TChartAxisIntervalParams then
|
|
with TChartAxisIntervalParams(ASource) do begin
|
|
Self.FCount := Count;
|
|
Self.FMaxLength := MaxLength;
|
|
Self.FMinLength := MinLength;
|
|
Self.FNiceSteps := NiceSteps;
|
|
Self.FOptions := Options;
|
|
end
|
|
else
|
|
inherited Assign(ASource);
|
|
end;
|
|
|
|
procedure TChartAxisIntervalParams.Changed;
|
|
begin
|
|
if not (FOwner is TCustomChartSource) then exit;
|
|
with FOwner as TCustomChartSource do begin
|
|
BeginUpdate;
|
|
EndUpdate;
|
|
end;
|
|
end;
|
|
|
|
constructor TChartAxisIntervalParams.Create(AOwner: TPersistent);
|
|
begin
|
|
FOwner := AOwner;
|
|
SetPropDefaults(Self, ['Count', 'MaxLength', 'MinLength', 'Options']);
|
|
FNiceSteps := DEF_INTERVAL_STEPS;
|
|
ParseNiceSteps;
|
|
end;
|
|
|
|
function TChartAxisIntervalParams.GetOwner: TPersistent;
|
|
begin
|
|
Result := FOwner;
|
|
end;
|
|
|
|
function TChartAxisIntervalParams.NiceStepsIsStored: Boolean;
|
|
begin
|
|
Result := NiceSteps <> DEF_INTERVAL_STEPS;
|
|
end;
|
|
|
|
procedure TChartAxisIntervalParams.ParseNiceSteps;
|
|
var
|
|
parts: TStringList;
|
|
i: Integer;
|
|
begin
|
|
parts := TStringList.Create;
|
|
try
|
|
parts.Delimiter := '|';
|
|
parts.StrictDelimiter := true;
|
|
parts.DelimitedText := IfThen(NiceSteps = '', DEF_INTERVAL_STEPS, NiceSteps);
|
|
SetLength(FStepValues, parts.Count);
|
|
for i := 0 to parts.Count - 1 do
|
|
FStepValues[i] := StrToFloatDefSep(parts[i]);
|
|
finally
|
|
parts.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TChartAxisIntervalParams.SetCount(AValue: Integer);
|
|
begin
|
|
if FCount = AValue then exit;
|
|
FCount := AValue;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TChartAxisIntervalParams.SetMaxLength(AValue: Integer);
|
|
begin
|
|
if FMaxLength = AValue then exit;
|
|
FMaxLength := AValue;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TChartAxisIntervalParams.SetMinLength(AValue: Integer);
|
|
begin
|
|
if FMinLength = AValue then exit;
|
|
FMinLength := AValue;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TChartAxisIntervalParams.SetNiceSteps(const AValue: String);
|
|
begin
|
|
if FNiceSteps = AValue then exit;
|
|
FNiceSteps := AValue;
|
|
ParseNiceSteps;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TChartAxisIntervalParams.SetOptions(
|
|
AValue: TAxisIntervalParamOptions);
|
|
begin
|
|
if FOptions = AValue then exit;
|
|
FOptions := AValue;
|
|
Changed;
|
|
end;
|
|
|
|
procedure TChartAxisIntervalParams.SetTolerance(AValue: Cardinal);
|
|
begin
|
|
if FTolerance = AValue then exit;
|
|
FTolerance := AValue;
|
|
Changed;
|
|
end;
|
|
|
|
{ TChartDataItem }
|
|
|
|
function TChartDataItem.GetY(AIndex: Integer): Double;
|
|
begin
|
|
AIndex := EnsureRange(AIndex, 0, Length(YList));
|
|
if AIndex = 0 then
|
|
Result := Y
|
|
else
|
|
Result := YList[AIndex - 1];
|
|
end;
|
|
|
|
procedure TChartDataItem.MultiplyY(ACoeff: Double);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Y *= ACoeff;
|
|
for i := 0 to High(YList) do
|
|
YList[i] *= ACoeff;
|
|
end;
|
|
|
|
function TChartDataItem.Point: TDoublePoint;
|
|
begin
|
|
Result.X := X;
|
|
Result.Y := Y;
|
|
end;
|
|
|
|
procedure TChartDataItem.SetY(AValue: Double);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Y := AValue;
|
|
for i := 0 to High(YList) do
|
|
YList[i] := AValue;
|
|
end;
|
|
|
|
{ TChartSourceBuffer }
|
|
|
|
procedure TChartSourceBuffer.AddFirst(const AItem: TChartDataItem);
|
|
begin
|
|
if Capacity = 0 then
|
|
raise EBufferError.Create('');
|
|
FStart := (FStart + Cardinal(High(FBuf))) mod Capacity;
|
|
if FCount = Capacity then
|
|
RemoveValue(FBuf[FStart])
|
|
else
|
|
FCount += 1;
|
|
FBuf[FStart] := AItem;
|
|
AddValue(AItem);
|
|
end;
|
|
|
|
procedure TChartSourceBuffer.AddLast(const AItem: TChartDataItem);
|
|
begin
|
|
if Capacity > 0 then
|
|
if FCount = Capacity then begin
|
|
RemoveValue(FBuf[FStart]);
|
|
FBuf[FStart] := AItem;
|
|
FStart := (FStart + 1) mod Capacity;
|
|
end
|
|
else begin
|
|
FCount += 1;
|
|
FBuf[EndIndex] := AItem;
|
|
end;
|
|
AddValue(AItem);
|
|
end;
|
|
|
|
procedure TChartSourceBuffer.AddValue(const AItem: TChartDataItem);
|
|
var
|
|
i, oldLen: Integer;
|
|
begin
|
|
with FSum do begin
|
|
Y += AItem.Y;
|
|
oldLen := Length(YList);
|
|
SetLength(YList, Max(Length(AItem.YList), oldLen));
|
|
for i := oldLen to High(YList) do
|
|
YList[i] := 0;
|
|
for i := 0 to Min(High(YList), High(AItem.YList)) do
|
|
YList[i] += AItem.YList[i];
|
|
end;
|
|
end;
|
|
|
|
procedure TChartSourceBuffer.Clear;
|
|
begin
|
|
FCount := 0;
|
|
FStart := 0;
|
|
FSum.Y := 0;
|
|
FSum.YList := nil;
|
|
end;
|
|
|
|
function TChartSourceBuffer.EndIndex: Cardinal;
|
|
begin
|
|
Result := (FStart + Cardinal(FCount - 1)) mod Capacity;
|
|
end;
|
|
|
|
function TChartSourceBuffer.GetCapacity: Cardinal;
|
|
begin
|
|
Result := Length(FBuf);
|
|
end;
|
|
|
|
function TChartSourceBuffer.GetPtr(AOffset: Cardinal): PChartDataItem;
|
|
begin
|
|
if AOffset >= FCount then
|
|
raise EBufferError.Create('AOffset');
|
|
Result := @FBuf[(FStart + AOffset + Capacity) mod Capacity];
|
|
end;
|
|
|
|
procedure TChartSourceBuffer.GetSum(var AItem: TChartDataItem);
|
|
begin
|
|
AItem.Y := FSum.Y;
|
|
AItem.YList := Copy(FSum.YList);
|
|
end;
|
|
|
|
procedure TChartSourceBuffer.RemoveFirst;
|
|
begin
|
|
if FCount = 0 then
|
|
raise EBufferError.Create('Empty');
|
|
RemoveValue(FBuf[FStart]);
|
|
FCount -= 1;
|
|
FStart := (FStart + 1) mod Capacity;
|
|
end;
|
|
|
|
procedure TChartSourceBuffer.RemoveLast;
|
|
begin
|
|
if FCount = 0 then
|
|
raise EBufferError.Create('Empty');
|
|
RemoveValue(FBuf[EndIndex]);
|
|
FCount -= 1;
|
|
end;
|
|
|
|
procedure TChartSourceBuffer.RemoveValue(const AItem: TChartDataItem);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
with AItem do begin
|
|
FSum.Y -= Y;
|
|
for i := 0 to Min(High(FSum.YList), High(YList)) do
|
|
FSum.YList[i] -= YList[i];
|
|
end;
|
|
end;
|
|
|
|
procedure TChartSourceBuffer.SetCapacity(AValue: Cardinal);
|
|
begin
|
|
if AValue = Capacity then exit;
|
|
SetLength(FBuf, AValue);
|
|
Clear;
|
|
end;
|
|
|
|
{ TCustomChartSourceEnumerator }
|
|
|
|
constructor TCustomChartSourceEnumerator.Create(ASource: TCustomChartSource);
|
|
begin
|
|
FSource := ASource;
|
|
FIndex := -1;
|
|
end;
|
|
|
|
function TCustomChartSourceEnumerator.GetCurrent: PChartDataItem;
|
|
begin
|
|
Result := FSource[FIndex];
|
|
end;
|
|
|
|
function TCustomChartSourceEnumerator.MoveNext: Boolean;
|
|
begin
|
|
FIndex += 1;
|
|
Result := FIndex < FSource.Count;
|
|
end;
|
|
|
|
procedure TCustomChartSourceEnumerator.Reset;
|
|
begin
|
|
FIndex := 0;
|
|
end;
|
|
|
|
{ TCustomChartSource }
|
|
|
|
procedure TCustomChartSource.AfterDraw;
|
|
begin
|
|
// empty
|
|
end;
|
|
|
|
procedure TCustomChartSource.BeforeDraw;
|
|
begin
|
|
// empty
|
|
end;
|
|
|
|
procedure TCustomChartSource.BeginUpdate;
|
|
begin
|
|
Inc(FUpdateCount);
|
|
end;
|
|
|
|
class procedure TCustomChartSource.CheckFormat(const AFormat: String);
|
|
begin
|
|
Format(AFormat, [0.0, 0.0, '', 0.0, 0.0]);
|
|
end;
|
|
|
|
constructor TCustomChartSource.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FBroadcaster := TBroadcaster.Create;
|
|
FYCount := 1;
|
|
end;
|
|
|
|
destructor TCustomChartSource.Destroy;
|
|
begin
|
|
FreeAndNil(FBroadcaster);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TCustomChartSource.EndUpdate;
|
|
begin
|
|
Dec(FUpdateCount);
|
|
if FUpdateCount > 0 then exit;
|
|
// Values can be set directly between BeginUpdate and EndUpdate.
|
|
InvalidateCaches;
|
|
Notify;
|
|
end;
|
|
|
|
function TCustomChartSource.Extent: TDoubleRect;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if FExtentIsValid then exit(FExtent);
|
|
FExtent := EmptyExtent;
|
|
for i := 0 to Count - 1 do
|
|
with Item[i]^ do begin
|
|
UpdateMinMax(X, FExtent.a.X, FExtent.b.X);
|
|
UpdateMinMax(Y, FExtent.a.Y, FExtent.b.Y);
|
|
end;
|
|
FExtentIsValid := true;
|
|
Result := FExtent;
|
|
end;
|
|
|
|
function TCustomChartSource.ExtentCumulative: TDoubleRect;
|
|
var
|
|
h: Double;
|
|
i, j: Integer;
|
|
begin
|
|
Result := Extent;
|
|
if YCount < 2 then exit;
|
|
for i := 0 to Count - 1 do begin
|
|
h := NumberOr(Item[i]^.Y);
|
|
for j := 0 to YCount - 2 do begin
|
|
h += NumberOr(Item[i]^.YList[j]);
|
|
// If some of Y values are negative, h may be non-monotonic.
|
|
UpdateMinMax(h, Result.a.Y, Result.b.Y);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TCustomChartSource.ExtentList: TDoubleRect;
|
|
var
|
|
i, j: Integer;
|
|
begin
|
|
Result := Extent;
|
|
for i := 0 to Count - 1 do
|
|
with Item[i]^ do
|
|
for j := 0 to High(YList) do
|
|
UpdateMinMax(YList[j], Result.a.Y, Result.b.Y);
|
|
end;
|
|
|
|
procedure TCustomChartSource.FindBounds(
|
|
AXMin, AXMax: Double; out ALB, AUB: Integer);
|
|
|
|
function FindLB(X: Double; L, R: Integer): Integer;
|
|
begin
|
|
while L <= R do begin
|
|
Result := (R - L) div 2 + L;
|
|
if Item[Result]^.X < X then
|
|
L := Result + 1
|
|
else
|
|
R := Result - 1;
|
|
end;
|
|
Result := L;
|
|
end;
|
|
|
|
function FindUB(X: Double; L, R: Integer): Integer;
|
|
begin
|
|
while L <= R do begin
|
|
Result := (R - L) div 2 + L;
|
|
if Item[Result]^.X <= X then
|
|
L := Result + 1
|
|
else
|
|
R := Result - 1;
|
|
end;
|
|
Result := R;
|
|
end;
|
|
|
|
begin
|
|
EnsureOrder(AXMin, AXMax);
|
|
if IsSorted then begin
|
|
ALB := FindLB(AXMin, 0, Count - 1);
|
|
AUB := FindUB(AXMax, 0, Count - 1);
|
|
end
|
|
else begin
|
|
ALB := 0;
|
|
while (ALB < Count) and (IsNan(Item[ALB]^.X) or (Item[ALB]^.X < AXMin)) do
|
|
Inc(ALB);
|
|
AUB := Count - 1;
|
|
while (AUB >= 0) and (IsNan(Item[AUB]^.X) or (Item[AUB]^.X > AXMax)) do
|
|
Dec(AUB);
|
|
end;
|
|
end;
|
|
|
|
function TCustomChartSource.FormatItem(
|
|
const AFormat: String; AIndex, AYIndex: Integer): String;
|
|
const
|
|
TO_PERCENT = 100;
|
|
var
|
|
total, percent, vy: Double;
|
|
begin
|
|
total := ValuesTotal;
|
|
if total = 0 then
|
|
percent := 0
|
|
else
|
|
percent := TO_PERCENT / total;
|
|
with Item[AIndex]^ do begin
|
|
vy := GetY(AYIndex);
|
|
Result := Format(AFormat, [vy, vy * percent, Text, total, X]);
|
|
end;
|
|
end;
|
|
|
|
function TCustomChartSource.GetEnumerator: TCustomChartSourceEnumerator;
|
|
begin
|
|
Result := TCustomChartSourceEnumerator.Create(Self);
|
|
end;
|
|
|
|
procedure TCustomChartSource.InvalidateCaches;
|
|
begin
|
|
FExtentIsValid := false;
|
|
FValuesTotalIsValid := false;
|
|
end;
|
|
|
|
function TCustomChartSource.IsSorted: Boolean;
|
|
begin
|
|
Result := false;
|
|
end;
|
|
|
|
function TCustomChartSource.IsUpdating: Boolean; inline;
|
|
begin
|
|
Result := FUpdateCount > 0;
|
|
end;
|
|
|
|
procedure TCustomChartSource.Notify;
|
|
begin
|
|
if not IsUpdating then
|
|
FBroadcaster.Broadcast(Self);
|
|
end;
|
|
|
|
procedure TCustomChartSource.SortValuesInRange(
|
|
var AValues: TChartValueTextArray; AStart, AEnd: Integer);
|
|
var
|
|
i, j, next: Integer;
|
|
lst: TFPList;
|
|
p: PChartValueText;
|
|
tmp: TChartValueText;
|
|
begin
|
|
lst := TFPList.Create;
|
|
try
|
|
lst.Count := AEnd - AStart + 1;
|
|
for i := AStart to AEnd do
|
|
lst[i - AStart] := @AValues[i];
|
|
lst.Sort(@CompareChartValueTextPtr);
|
|
for i := AStart to AEnd do begin
|
|
if lst[i - AStart] = nil then continue;
|
|
j := i;
|
|
tmp := AValues[j];
|
|
while true do begin
|
|
p := PChartValueText(lst[j - AStart]);
|
|
lst[j - AStart] := nil;
|
|
{$HINTS OFF} // Work around the fpc bug #19582.
|
|
next := (PtrUInt(p) - PtrUInt(@AValues[0])) div SizeOf(p^);
|
|
{$HINTS ON}
|
|
if next = i then break;
|
|
AValues[j] := p^;
|
|
j := next;
|
|
end;
|
|
AValues[j] := tmp;
|
|
end;
|
|
finally
|
|
lst.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TCustomChartSource.ValuesInRange(
|
|
AParams: TValuesInRangeParams; var AValues: TChartValueTextArray);
|
|
|
|
procedure Put(
|
|
out ADest: TChartValueText; AValue: Double; AIndex: Integer); inline;
|
|
begin
|
|
ADest.FValue := AValue;
|
|
ADest.FText := FormatItem(AParams.FFormat, AIndex, 0);
|
|
end;
|
|
|
|
var
|
|
prevImagePos: Integer = MaxInt;
|
|
|
|
function IsTooClose(AValue: Double): Boolean;
|
|
var
|
|
imagePos: Integer;
|
|
begin
|
|
with AParams do
|
|
if aipUseMinLength in FIntervals.Options then begin
|
|
imagePos := ToImage(AValue);
|
|
Result := Abs(imagePos - prevImagePos) < FScale(FIntervals.MinLength);
|
|
end;
|
|
if not Result then
|
|
prevImagePos := imagePos;
|
|
end;
|
|
|
|
var
|
|
i, j, cnt, start: Integer;
|
|
v: Double;
|
|
lo, hi: TChartValueText;
|
|
begin
|
|
// Select all values in a given range, plus lower and upper bound values.
|
|
// Proceed through the (possibly unsorted) data source in a single pass.
|
|
start := Length(AValues);
|
|
SetLength(AValues, start + Count + 2);
|
|
cnt := start;
|
|
lo.FValue := NegInfinity;
|
|
hi.FValue := SafeInfinity;
|
|
AValues[start].FValue := SafeNan;
|
|
for i := 0 to Count - 1 do begin
|
|
with Item[I]^ do
|
|
v := IfThen(AParams.FUseY, Y, X);
|
|
if IsNan(v) then continue;
|
|
if v < AParams.FMin then begin
|
|
if v > lo.FValue then
|
|
Put(lo, v, i);
|
|
end
|
|
else if v > AParams.FMax then begin
|
|
if v < hi.FValue then
|
|
Put(hi, v, i);
|
|
end
|
|
else begin
|
|
if (aipUseMinLength in AParams.FIntervals.Options) and IsTooClose(v) then
|
|
continue;
|
|
if not IsInfinite(lo.FValue) and (cnt = start) then
|
|
cnt += 1;
|
|
Put(AValues[cnt], v, i);
|
|
cnt += 1;
|
|
end;
|
|
end;
|
|
|
|
if not IsInfinite(lo.FValue) then begin
|
|
if not IsNan(AValues[start].FValue) then begin
|
|
// The lower bound value occured after the first in-range value,
|
|
// so we did not reserve space for it. Hopefully rare case.
|
|
for i := cnt downto start + 1 do
|
|
AValues[i] := AValues[i - 1];
|
|
cnt += 1;
|
|
end;
|
|
AValues[start] := lo;
|
|
if cnt = start then
|
|
cnt += 1;
|
|
end;
|
|
if not IsInfinite(hi.FValue) then begin
|
|
AValues[cnt] := hi;
|
|
cnt += 1;
|
|
end;
|
|
SetLength(AValues, cnt);
|
|
|
|
if IsSorted or IsValueTextsSorted(AValues, start, cnt - 1) then exit;
|
|
SortValuesInRange(AValues, start, cnt - 1);
|
|
if aipUseMinLength in AParams.FIntervals.Options then begin
|
|
prevImagePos := MaxInt;
|
|
j := start;
|
|
for i := start to cnt - 1 do begin
|
|
v := AValues[i].FValue;
|
|
if InRange(v, AParams.FMin, AParams.FMax) and IsTooClose(v) then continue;
|
|
AValues[j] := AValues[i];
|
|
j += 1;
|
|
end;
|
|
SetLength(AValues, j);
|
|
end;
|
|
end;
|
|
|
|
function TCustomChartSource.ValuesTotal: Double;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
if FValuesTotalIsValid then exit(FValuesTotal);
|
|
FValuesTotal := 0;
|
|
for i := 0 to Count - 1 do
|
|
FValuesTotal += Item[i]^.Y;
|
|
FValuesTotalIsValid := true;
|
|
Result := FValuesTotal;
|
|
end;
|
|
|
|
function TCustomChartSource.XOfMax: Double;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Count - 1 do
|
|
with Item[i]^ do
|
|
if Y = Extent.b.Y then exit(X);
|
|
Result := 0.0;
|
|
end;
|
|
|
|
function TCustomChartSource.XOfMin: Double;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Count - 1 do
|
|
with Item[i]^ do
|
|
if Y = Extent.a.Y then exit(X);
|
|
Result := 0.0;
|
|
end;
|
|
|
|
end.
|
|
|