mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-27 19:33:49 +02:00
2584 lines
76 KiB
ObjectPascal
2584 lines
76 KiB
ObjectPascal
{
|
|
*****************************************************************************
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
*****************************************************************************
|
|
|
|
Authors: Alexander Klenin
|
|
|
|
}
|
|
|
|
unit TAMultiSeries;
|
|
|
|
{$MODE ObjFPC}{$H+}
|
|
{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, Graphics,
|
|
TAChartUtils, TATypes, TACustomSource, TACustomSeries, TADrawUtils, TALegend;
|
|
|
|
const
|
|
DEF_BOX_WIDTH = 50;
|
|
DEF_WHISKERS_WIDTH = 25;
|
|
DEF_OHLC_TICK_WIDTH = 25;
|
|
|
|
DEF_YINDEX_OPEN = 1;
|
|
DEF_YINDEX_HIGH = 3;
|
|
DEF_YINDEX_LOW = 0;
|
|
DEF_YINDEX_CLOSE = 2;
|
|
|
|
DEF_YINDEX_WHISKERMIN = 0;
|
|
DEF_YINDEX_BOXMIN = 1;
|
|
DEF_YINDEX_CENTER = 2;
|
|
DEF_YINDEX_BOXMAX = 3;
|
|
DEF_YINDEX_WHISKERMAX = 4;
|
|
|
|
type
|
|
|
|
// TBubbleRadiusTransform = (brtNone, brtX, brtY); not used
|
|
TBubbleOverrideColor = (bocBrush, bocPen);
|
|
TBubbleOverrideColors = set of TBubbleOverrideColor;
|
|
TBubbleRadiusUnits = (
|
|
bruX, // Circle with radius given in x axis units
|
|
bruY, // Circle with radius given in y axis units
|
|
bruXY, // Ellipse
|
|
bruPercentageRadius, // Bubble radius is percentage of the smallest dimension of plot area
|
|
bruPercentageArea // dto., but bubble area
|
|
);
|
|
|
|
{ TBubbleSeries }
|
|
|
|
TBubbleSeries = class(TBasicPointSeries)
|
|
private
|
|
FBubbleBrush: TBrush;
|
|
FBubblePen: TPen;
|
|
FOverrideColor: TBubbleOverrideColors;
|
|
FBubbleRadiusPercentage: Integer;
|
|
FBubbleRadiusUnits: TBubbleRadiusUnits;
|
|
FBubbleScalingFactor: Double;
|
|
procedure SetBubbleBrush(AValue: TBrush);
|
|
procedure SetBubblePen(AValue: TPen);
|
|
procedure SetBubbleRadiusPercentage(AValue: Integer);
|
|
procedure SetBubbleRadiusUnits(AValue: TBubbleRadiusUnits);
|
|
procedure SetOverrideColor(AValue: TBubbleOverrideColors);
|
|
protected
|
|
function CalcBubbleScalingFactor(const ARect: TRect): Double;
|
|
function GetBubbleRect(AItem: PChartDataItem; AFactor: Double; out ARect: TRect): Boolean;
|
|
function GetLabelDataPoint(AIndex, AYIndex: Integer): TDoublePoint; override;
|
|
procedure GetLegendItems(AItems: TChartLegendItems); override;
|
|
function GetSeriesColor: TColor; override;
|
|
class procedure GetXYCountNeeded(out AXCount, AYCount: Cardinal); override;
|
|
function ToolTargetDistance(const AParams: TNearestPointParams;
|
|
AGraphPt: TDoublePoint; APointIdx, AXIdx, AYIdx: Integer): Integer; override;
|
|
procedure UpdateLabelDirectionReferenceLevel(AIndex, AYIndex: Integer;
|
|
var ALevel: Double); override;
|
|
procedure UpdateMargins(ADrawer: IChartDrawer; var AMargins: TRect); override;
|
|
public
|
|
function AddXY(AX, AY, ARadius: Double; AXLabel: String = '';
|
|
AColor: TColor = clTAColor): Integer; overload;
|
|
procedure Assign(ASource: TPersistent); override;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Draw(ADrawer: IChartDrawer); override;
|
|
function Extent: TDoubleRect; override;
|
|
function GetNearestPoint(const AParams: TNearestPointParams;
|
|
out AResults: TNearestPointResults): Boolean; override;
|
|
procedure MovePointEx(var AIndex: Integer; AXIndex, AYIndex: Integer;
|
|
const ANewPos: TDoublePoint); override;
|
|
published
|
|
property AxisIndexX;
|
|
property AxisIndexY;
|
|
property BubbleBrush: TBrush read FBubbleBrush write SetBubbleBrush;
|
|
property BubblePen: TPen read FBubblePen write SetBubblePen;
|
|
property BubbleRadiusPercentage: Integer read FBubbleRadiusPercentage
|
|
write SetBubbleRadiusPercentage default 20;
|
|
property BubbleRadiusUnits: TBubbleRadiusUnits read FBubbleRadiusUnits
|
|
write SetBubbleRadiusUnits default bruXY;
|
|
property MarkPositions;
|
|
property Marks;
|
|
property OverrideColor: TBubbleOverrideColors
|
|
read FOverrideColor write SetOverrideColor default [];
|
|
property Source;
|
|
property Styles;
|
|
property ToolTargets default [nptPoint, nptYList, nptCustom];
|
|
end;
|
|
|
|
TBoxAndWhiskerSeriesLegendDir = (bwlHorizontal, bwlVertical, bwlAuto);
|
|
TBoxAndWhiskerSeriesWidthStyle = (bwsPercent, bwsPercentMin);
|
|
TBoxAndWhiskerYDataLayout = (bwlNormal, bwlLegacy, bwlCustom);
|
|
|
|
TBoxAndWhiskerSeries = class(TBasicPointSeries)
|
|
strict private
|
|
FBoxBrush: TBrush;
|
|
FBoxPen: TPen;
|
|
FBoxWidth: Integer;
|
|
FLegendDirection: TBoxAndWhiskerSeriesLegendDir;
|
|
FMedianPen: TPen;
|
|
FWhiskersPen: TPen;
|
|
FWhiskersWidth: Integer;
|
|
FWidthStyle: TBoxAndWhiskerSeriesWidthStyle;
|
|
FYDataLayout: TBoxAndWhiskerYDataLayout;
|
|
FYIndexWhiskerMin: Integer;
|
|
FYIndexBoxMin: Integer;
|
|
FYIndexCenter: Integer;
|
|
FYIndexBoxMax: Integer;
|
|
FYIndexWhiskerMax: Integer;
|
|
procedure SetBoxBrush(AValue: TBrush);
|
|
procedure SetBoxPen(AValue: TPen);
|
|
procedure SetBoxWidth(AValue: Integer);
|
|
procedure SetLegendDirection(AValue: TBoxAndWhiskerSeriesLegendDir);
|
|
procedure SetMedianPen(AValue: TPen);
|
|
procedure SetWhiskersPen(AValue: TPen);
|
|
procedure SetWhiskersWidth(AValue: Integer);
|
|
procedure SetYDataLayout(AValue: TBoxAndWhiskerYDataLayout);
|
|
procedure SetYIndexBoxMax(AValue: Integer);
|
|
procedure SetYIndexBoxMin(AValue: Integer);
|
|
procedure SetYIndexCenter(AValue: Integer);
|
|
procedure SetYIndexWhiskerMax(AValue: Integer);
|
|
procedure SetYIndexWhiskerMin(AValue: Integer);
|
|
procedure UpdateYDataLayout;
|
|
protected
|
|
procedure GetLegendItems(AItems: TChartLegendItems); override;
|
|
function GetSeriesColor: TColor; override;
|
|
class procedure GetXYCountNeeded(out AXCount, AYCount: Cardinal); override;
|
|
function SkipMissingValues(AIndex: Integer): Boolean; override;
|
|
function ToolTargetDistance(const AParams: TNearestPointParams;
|
|
AGraphPt: TDoublePoint; APointIdx, AXIdx, AYIdx: Integer): Integer; override;
|
|
procedure UpdateLabelDirectionReferenceLevel(AIndex, AYIndex: Integer;
|
|
var ALevel: Double); override;
|
|
public
|
|
function AddXY(
|
|
AX, AYLoWhisker, AYLoBox, AY, AYHiBox, AYHiWhisker: Double;
|
|
AXLabel: String = ''; AColor: TColor = clTAColor): Integer; overload;
|
|
procedure Assign(ASource: TPersistent); override;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Draw(ADrawer: IChartDrawer); override;
|
|
function Extent: TDoubleRect; override;
|
|
function GetNearestPoint(const AParams: TNearestPointParams;
|
|
out AResults: TNearestPointResults): Boolean; override;
|
|
published
|
|
property BoxBrush: TBrush read FBoxBrush write SetBoxBrush;
|
|
property BoxPen: TPen read FBoxPen write SetBoxPen;
|
|
property BoxWidth: Integer
|
|
read FBoxWidth write SetBoxWidth default DEF_BOX_WIDTH;
|
|
property LegendDirection: TBoxAndWhiskerSeriesLegendDir
|
|
read FLegendDirection write SetLegendDirection default bwlHorizontal;
|
|
property MedianPen: TPen read FMedianPen write SetMedianPen;
|
|
property ToolTargets default [nptPoint, nptYList, nptCustom];
|
|
property WidthStyle: TBoxAndWhiskerSeriesWidthStyle
|
|
read FWidthStyle write FWidthStyle default bwsPercent;
|
|
property WhiskersPen: TPen read FWhiskersPen write SetWhiskersPen;
|
|
property WhiskersWidth: Integer
|
|
read FWhiskersWidth write SetWhiskersWidth default DEF_WHISKERS_WIDTH;
|
|
property YDataLayout: TBoxAndWhiskerYDataLayout
|
|
read FYDataLayout write SetYDataLayout default bwlLegacy;
|
|
property YIndexBoxMax: Integer
|
|
read FYIndexBoxMax write SetYIndexBoxMax default DEF_YINDEX_BOXMAX;
|
|
property YIndexBoxMin: Integer
|
|
read FYIndexBoxMin write SetYIndexBoxMin default DEF_YINDEX_BOXMIN;
|
|
property YIndexCenter: Integer
|
|
read FYIndexCenter write SetYIndexCenter default DEF_YINDEX_CENTER;
|
|
property YIndexWhiskerMax: Integer
|
|
read FYIndexWhiskerMax write SetYIndexWhiskerMax default DEF_YINDEX_WHISKERMAX;
|
|
property YIndexWhiskerMin: Integer
|
|
read FYIndexWhiskerMin write SetYIndexWhiskerMin default DEF_YINDEX_WHISKERMIN;
|
|
published
|
|
property AxisIndexX;
|
|
property AxisIndexY;
|
|
property MarkPositions;
|
|
property Marks;
|
|
property Source;
|
|
end;
|
|
|
|
TOHLCBrushKind = (obkCandleUp, obkCandleDown);
|
|
TOHLCPenKind = (opkCandleUp, opkCandleDown, opkCandleLine, opkLineUp, opkLineDown);
|
|
|
|
TOHLCBrush = class(TBrush)
|
|
private
|
|
const
|
|
DEFAULT_COLORS: array[TOHLCBrushKind] of TColor = (clLime, clRed);
|
|
private
|
|
FBrushKind: TOHLCBrushKind;
|
|
function IsColorStored: Boolean;
|
|
procedure SetBrushKind(AValue: TOHLCBrushKind);
|
|
public
|
|
property BrushKind: TOHLCBrushKind read FBrushKind write SetBrushKind;
|
|
published
|
|
property Color stored IsColorStored;
|
|
end;
|
|
|
|
TOHLCPen = class(TPen)
|
|
private
|
|
const
|
|
DEFAULT_COLORS: array[TOHLCPenKind] of TColor = (clGreen, clMaroon, clDefault, clLime, clRed);
|
|
private
|
|
FPenKind: TOHLCPenKind;
|
|
function IsColorStored: Boolean;
|
|
procedure SetPenKind(AValue: TOHLCPenKind);
|
|
public
|
|
property PenKind: TOHLCPenKind read FPenKind write SetPenKind;
|
|
published
|
|
property Color stored IsColorStored;
|
|
end;
|
|
|
|
TOHLCMode = (mOHLC, mCandleStick);
|
|
TTickWidthStyle = (twsPercent, twsPercentMin);
|
|
|
|
TOpenHighLowCloseSeries = class(TBasicPointSeries)
|
|
private
|
|
FPen: array[TOHLCPenKind] of TOHLCPen;
|
|
FBrush: array[TOHLCBrushKind] of TOHLCBrush;
|
|
FTickWidth: Integer;
|
|
FTickWidthStyle: TTickWidthStyle;
|
|
FYIndexClose: Integer;
|
|
FYIndexHigh: Integer;
|
|
FYIndexLow: Integer;
|
|
FYIndexOpen: Integer;
|
|
FMode: TOHLCMode;
|
|
function GetBrush(AIndex: TOHLCBrushKind): TOHLCBrush;
|
|
function GetPen(AIndex: TOHLCPenKind): TOHLCPen;
|
|
procedure SetBrush(AIndex: TOHLCBrushKind; AValue: TOHLCBrush);
|
|
procedure SetPen(AIndex: TOHLCPenKind; AValue: TOHLCPen);
|
|
procedure SetOHLCMode(AValue: TOHLCMode);
|
|
procedure SetTickWidth(AValue: Integer);
|
|
procedure SetTickWidthStyle(AValue: TTickWidthStyle);
|
|
procedure SetYIndexClose(AValue: Integer);
|
|
procedure SetYIndexHigh(AValue: Integer);
|
|
procedure SetYIndexLow(AValue: Integer);
|
|
procedure SetYIndexOpen(AValue: Integer);
|
|
protected
|
|
function CalcTickWidth(AX: Double; AIndex: Integer): Double;
|
|
procedure GetLegendItems(AItems: TChartLegendItems); override;
|
|
function GetSeriesColor: TColor; override;
|
|
class procedure GetXYCountNeeded(out AXCount, AYCount: Cardinal); override;
|
|
function SkipMissingValues(AIndex: Integer): Boolean; override;
|
|
function ToolTargetDistance(const AParams: TNearestPointParams;
|
|
AGraphPt: TDoublePoint; APointIdx, AXIdx, AYIdx: Integer): Integer; override;
|
|
procedure UpdateLabelDirectionReferenceLevel(AIndex, AYIndex: Integer;
|
|
var ALevel: Double); override;
|
|
public
|
|
procedure Assign(ASource: TPersistent); override;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
public
|
|
function AddXOHLC(
|
|
AX, AOpen, AHigh, ALow, AClose: Double;
|
|
ALabel: String = ''; AColor: TColor = clTAColor): Integer; inline;
|
|
procedure Draw(ADrawer: IChartDrawer); override;
|
|
function Extent: TDoubleRect; override;
|
|
function GetNearestPoint(const AParams: TNearestPointParams;
|
|
out AResults: TNearestPointResults): Boolean; override;
|
|
published
|
|
property CandlestickDownBrush: TOHLCBrush index obkCandleDown read GetBrush write SetBrush;
|
|
property CandlestickDownPen: TOHLCPen index opkCandleDown read GetPen write SetPen;
|
|
property CandlestickLinePen: TOHLCPen index opkCandleLine read GetPen write SetPen;
|
|
property CandlestickUpBrush: TOHLCBrush index obkCandleUp read GetBrush write SetBrush;
|
|
property CandlestickUpPen: TOHLCPen index opkCandleUp read GetPen write Setpen;
|
|
property DownLinePen: TOHLCPen index opkLineDown read GetPen write SetPen;
|
|
property LinePen: TOHLCPen index opkLineUp read GetPen write SetPen;
|
|
property Mode: TOHLCMode read FMode write SetOHLCMode default mOHLC;
|
|
property TickWidth: integer
|
|
read FTickWidth write SetTickWidth default DEF_OHLC_TICK_WIDTH;
|
|
property TickWidthStyle: TTickWidthStyle
|
|
read FTickWidthStyle write SetTickWidthStyle default twsPercent;
|
|
property ToolTargets default [nptPoint, nptYList, nptCustom];
|
|
property YIndexClose: integer
|
|
read FYIndexClose write SetYIndexClose default DEF_YINDEX_CLOSE;
|
|
property YIndexHigh: Integer
|
|
read FYIndexHigh write SetYIndexHigh default DEF_YINDEX_HIGH;
|
|
property YIndexLow: Integer
|
|
read FYIndexLow write SetYIndexLow default DEF_YINDEX_LOW;
|
|
property YIndexOpen: Integer
|
|
read FYIndexOpen write SetYIndexOpen default DEF_YINDEX_OPEN;
|
|
published
|
|
property AxisIndexX;
|
|
property AxisIndexY;
|
|
property MarkPositions;
|
|
property Marks;
|
|
property Source;
|
|
end;
|
|
|
|
TVectorCoordKind = (vckCenterDir, vckStartEnd);
|
|
|
|
TFieldSeries = class(TBasicPointSeries)
|
|
private
|
|
FArrow: TChartArrow;
|
|
FPen: TPen;
|
|
FCoordKind: TVectorCoordKind;
|
|
procedure SetArrow(AValue: TChartArrow);
|
|
procedure SetCoordKind(AValue: TVectorCoordKind);
|
|
procedure SetPen(AValue: TPen);
|
|
protected
|
|
procedure AfterAdd; override;
|
|
procedure DrawVector(ADrawer: IChartDrawer; AStartPt, AEndPt: TDoublePoint;
|
|
APen: TPen);
|
|
function GetColor(AIndex: Integer): TColor; inline;
|
|
function GetVectorPoints(AIndex: Integer;
|
|
out AStartPt, AEndPt: TDoublePoint): Boolean; inline;
|
|
class procedure GetXYCountNeeded(out AXCount, AYCount: Cardinal); override;
|
|
public
|
|
procedure Assign(ASource: TPersistent); override;
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
function AddVector(AX, AY, AVectorX, AVectorY: Double; AXLabel: String = '';
|
|
AColor: TColor = clTAColor): Integer; //inline;
|
|
function GetVector(AIndex: Integer): TDoublePoint; inline;
|
|
procedure SetVector(AIndex: Integer; const AValue: TDoublePoint); inline;
|
|
|
|
procedure Draw(ADrawer: IChartDrawer); override;
|
|
function Extent: TDoubleRect; override;
|
|
procedure GetLegendItems(AItems: TChartLegendItems); override;
|
|
function GetNearestPoint(const AParams: TNearestPointParams;
|
|
out AResults: TNearestPointResults): Boolean; override;
|
|
procedure MovePointEx(var AIndex: Integer; AXIndex, AYIndex: Integer;
|
|
const ANewPos: TDoublePoint); override;
|
|
procedure NormalizeVectors(ALength: Double);
|
|
|
|
published
|
|
property Arrow: TChartArrow read FArrow write SetArrow;
|
|
property AxisIndexX;
|
|
property AxisIndexY;
|
|
property MarkPositions;
|
|
property Marks;
|
|
property Pen: TPen read FPen write SetPen;
|
|
property Source;
|
|
property ToolTargets default [nptPoint, nptXList, nptYList, nptCustom];
|
|
property VectorCoordKind: TVectorCoordKind read FCoordKind write SetCoordKind default vckCenterDir;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
FPCanvas, Math, SysUtils, Types,
|
|
TAChartStrConsts, TAGeometry, TAGraph, TAMath;
|
|
|
|
type
|
|
|
|
TLegendItemOHLCLine = class(TLegendItemLine)
|
|
strict private
|
|
FMode: TOHLCMode;
|
|
FCandleStickUpColor: TColor;
|
|
FCandleStickDownColor: TColor;
|
|
public
|
|
constructor Create(ASeries: TOpenHighLowCloseSeries; const AText: String);
|
|
procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
|
|
end;
|
|
|
|
TLegendItemBoxAndWhiskers = class(TLegendItem)
|
|
strict private
|
|
FBoxBrush: TBrush;
|
|
FBoxPen: TPen;
|
|
FBoxWidth: Integer;
|
|
FIsVertical: Boolean;
|
|
FMedianPen: TPen;
|
|
FWhiskersPen: TPen;
|
|
FWhiskersWidth: Integer;
|
|
public
|
|
constructor Create(ASeries: TBoxAndWhiskerSeries; const AText: String);
|
|
procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
|
|
end;
|
|
|
|
TLegendItemField = class(TLegendItemLine)
|
|
strict private
|
|
FArrow: TChartArrow;
|
|
public
|
|
constructor Create(APen: TPen; AArrow: TChartArrow; const AText: String);
|
|
procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
|
|
end;
|
|
|
|
{ TLegendItemOHLCLine }
|
|
|
|
constructor TLegendItemOHLCLine.Create(ASeries: TOpenHighLowCloseSeries; const AText: String);
|
|
var
|
|
pen: TFPCustomPen;
|
|
begin
|
|
case ASeries.Mode of
|
|
mOHLC : pen := ASeries.LinePen;
|
|
mCandleStick : pen := ASeries.CandleStickLinePen;
|
|
end;
|
|
inherited Create(pen, AText);
|
|
FMode := ASeries.Mode;
|
|
FCandlestickUpColor := ASeries.CandlestickUpBrush.Color;
|
|
FCandlestickDownColor := ASeries.CandlestickDownBrush.Color;
|
|
end;
|
|
|
|
procedure TLegendItemOHLCLine.Draw(ADrawer: IChartDrawer; const ARect: TRect);
|
|
const
|
|
TICK_LENGTH = 3;
|
|
var
|
|
dx, dy, x, y: Integer;
|
|
pts: array[0..3] of TPoint;
|
|
begin
|
|
inherited Draw(ADrawer, ARect);
|
|
y := (ARect.Top + ARect.Bottom) div 2;
|
|
dx := (ARect.Right - ARect.Left) div 3;
|
|
x := ARect.Left + dx;
|
|
case FMode of
|
|
mOHLC:
|
|
begin
|
|
dy := ADrawer.Scale(TICK_LENGTH);
|
|
ADrawer.Line(x, y, x, y + dy);
|
|
x += dx;
|
|
ADrawer.Line(x, y, x, y - dy);
|
|
end;
|
|
mCandlestick:
|
|
begin
|
|
dy := (ARect.Bottom - ARect.Top) div 4;
|
|
pts[0] := Point(x, y-dy);
|
|
pts[1] := Point(x, y+dy);
|
|
pts[2] := Point(x+dx, y+dy);
|
|
pts[3] := pts[0];
|
|
ADrawer.SetBrushParams(bsSolid, FCandlestickUpColor);
|
|
ADrawer.Polygon(pts, 0, 4);
|
|
pts[0] := Point(x+dx, y+dy);
|
|
pts[1] := Point(x+dx, y-dy);
|
|
pts[2] := Point(x, y-dy);
|
|
pts[3] := pts[0];
|
|
ADrawer.SetBrushParams(bsSolid, FCandlestickDownColor);
|
|
ADrawer.Polygon(pts, 0, 4);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TLegendItemBoxAndWhiskers }
|
|
|
|
constructor TLegendItemBoxAndWhiskers.Create(
|
|
ASeries: TBoxAndWhiskerSeries; const AText: String);
|
|
begin
|
|
inherited Create(AText);
|
|
with ASeries do begin
|
|
FBoxBrush := BoxBrush;
|
|
FBoxPen := BoxPen;
|
|
FBoxWidth := BoxWidth;
|
|
FIsVertical :=
|
|
(LegendDirection = bwlVertical) or
|
|
(LegendDirection = bwlAuto) and IsRotated;
|
|
FMedianPen := MedianPen;
|
|
FWhiskersPen := WhiskersPen;
|
|
FWhiskersWidth := WhiskersWidth;
|
|
end;
|
|
end;
|
|
|
|
procedure TLegendItemBoxAndWhiskers.Draw(
|
|
ADrawer: IChartDrawer; const ARect: TRect);
|
|
|
|
function FlipRect(const AR: TRect): TRect;
|
|
begin
|
|
Result := Rect(AR.Top, AR.Left, AR.Bottom, AR.Right);
|
|
end;
|
|
|
|
var
|
|
symbol: array [1..5] of TRect;
|
|
var
|
|
center: TPoint;
|
|
i, m, ww, bw: Integer;
|
|
r: TRect;
|
|
begin
|
|
inherited Draw(ADrawer, ARect);
|
|
r := ARect;
|
|
r.BottomRight -= Point(1, 1);
|
|
if FIsVertical then
|
|
r := FlipRect(r);
|
|
|
|
center := (r.TopLeft + r.BottomRight) div 2;
|
|
m := MaxValue([FWhiskersWidth, FBoxWidth, 1]) * 2;
|
|
ww := (r.Bottom - r.Top) * FWhiskersWidth div m;
|
|
symbol[1] := Rect(r.Left, center.y, r.Right, center.y);
|
|
symbol[2] := Rect(r.Left, center.y - ww, r.Left, center.y + ww + 1);
|
|
symbol[3] := Rect(r.Right, center.y - ww, r.Right, center.y + ww + 1);
|
|
bw := (r.Bottom - r.Top) * FBoxWidth div m;
|
|
symbol[4] := Rect(
|
|
(r.Left * 2 + r.Right) div 3, center.y - bw,
|
|
(r.Left + r.Right * 2) div 3, center.y + bw);
|
|
bw -= Math.IfThen(FBoxPen.Style = psClear, 0, (FBoxPen.Width + 1) div 2);
|
|
symbol[5] := Rect(center.x, center.y - bw, center.x, center.y + bw);
|
|
|
|
if FIsVertical then
|
|
for i := 1 to High(symbol) do
|
|
symbol[i] := FlipRect(symbol[i]);
|
|
|
|
// Whisker
|
|
ADrawer.Pen := FWhiskersPen;
|
|
ADrawer.SetPenColor(FWhiskersPen.Color);
|
|
ADrawer.SetBrushParams(bsClear, clTAColor);
|
|
for i := 1 to 3 do
|
|
ADrawer.Line(symbol[i].TopLeft, symbol[i].BottomRight);
|
|
|
|
// Box
|
|
ADrawer.Pen := FBoxPen;
|
|
ADrawer.SetPenColor(FBoxPen.Color);
|
|
ADrawer.Brush:= FBoxBrush;
|
|
ADrawer.SetBrushColor(FBoxBrush.Color);
|
|
ADrawer.Rectangle(symbol[4]);
|
|
|
|
// Median line
|
|
ADrawer.Pen := FMedianPen;
|
|
ADrawer.SetPenColor(FMedianPen.Color);
|
|
ADrawer.Line(symbol[5].TopLeft, symbol[5].BottomRight);
|
|
end;
|
|
|
|
{ TLegendItemField }
|
|
|
|
constructor TLegendItemField.Create(APen: TPen; AArrow: TChartArrow;
|
|
const AText: String);
|
|
begin
|
|
inherited Create(APen, AText);
|
|
FArrow := AArrow;
|
|
end;
|
|
|
|
procedure TLegendItemField.Draw(ADrawer: IChartDrawer; const ARect: TRect);
|
|
var
|
|
y: Integer;
|
|
len: Double;
|
|
arr: TChartArrow;
|
|
begin
|
|
inherited Draw(ADrawer, ARect);
|
|
if (FPen = nil) or (FArrow = nil) or not FArrow.Visible then
|
|
exit;
|
|
len := (ARect.Right - ARect.Left) * 0.01;
|
|
arr := TChartArrow.Create(nil);
|
|
try
|
|
arr.Assign(FArrow);
|
|
arr.SetOwner(nil);
|
|
arr.BaseLength := round(FArrow.BaseLength * len);
|
|
arr.Length := round(FArrow.Length * len);
|
|
arr.Width := round(FArrow.Width * len);
|
|
y := (ARect.Top + ARect.Bottom) div 2;
|
|
arr.Draw(ADrawer, Point(ARect.Right, y), 0, FPen);
|
|
finally
|
|
arr.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TBubbleSeries }
|
|
|
|
function TBubbleSeries.AddXY(AX, AY, ARadius: Double; AXLabel: String;
|
|
AColor: TColor): Integer;
|
|
begin
|
|
Result := AddXY(AX, AY, [ARadius], AXLabel, AColor);
|
|
end;
|
|
|
|
procedure TBubbleSeries.Assign(ASource: TPersistent);
|
|
begin
|
|
if ASource is TBubbleSeries then
|
|
with TBubbleSeries(ASource) do begin
|
|
Self.BubbleBrush := FBubbleBrush;
|
|
Self.BubblePen := FBubblePen;
|
|
Self.BubbleRadiusUnits := FBubbleRadiusUnits;
|
|
Self.BubbleRadiusPercentage := FBubbleRadiusPercentage;
|
|
Self.OverrideColor := FOverrideColor;
|
|
end;
|
|
inherited Assign(ASource);
|
|
end;
|
|
|
|
{ Adjusts a scaling factor such that the largest bubble radius is the
|
|
given percentage (FBubbleRadiusPercentage) of the smallest edge of
|
|
the chart area (ARect). }
|
|
function TBubbleSeries.CalcBubbleScalingFactor(const ARect: TRect): Double;
|
|
var
|
|
rMin: Double = 0.0;
|
|
rMax: Double = 0.0;
|
|
begin
|
|
if FBubbleRadiusUnits in [bruPercentageRadius, bruPercentageArea] then
|
|
begin
|
|
Source.YRange(1, rMin, rMax);
|
|
if FBubbleRadiusUnits = bruPercentageArea then
|
|
rMax := sqrt(abs(rMax));
|
|
Result := Min(ARect.Width, ARect.Height) * FBubbleRadiusPercentage * PERCENT / abs(rMax);
|
|
end else
|
|
Result := 1.0;
|
|
end;
|
|
|
|
constructor TBubbleSeries.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ToolTargets := [nptPoint, nptYList, nptCustom];
|
|
FBubblePen := TPen.Create;
|
|
FBubblePen.OnChange := @StyleChanged;
|
|
FBubbleBrush := TBrush.Create;
|
|
FBubbleBrush.OnChange := @StyleChanged;
|
|
FBubbleRadiusPercentage := 20;
|
|
FBubbleRadiusUnits := bruXY;
|
|
FBubbleScalingFactor := 1.0;
|
|
end;
|
|
|
|
destructor TBubbleSeries.Destroy;
|
|
begin
|
|
FreeAndNil(FBubbleBrush);
|
|
FreeAndNil(FBubblePen);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TBubbleSeries.Draw(ADrawer: IChartDrawer);
|
|
var
|
|
i: Integer;
|
|
item: PChartDataItem;
|
|
clipR: TRect;
|
|
irect: TRect;
|
|
dummyR: TRect = (Left:0; Top:0; Right:0; Bottom:0);
|
|
ext: TDoubleRect;
|
|
nx, ny: Cardinal;
|
|
begin
|
|
if IsEmpty or (not Active) then exit;
|
|
if not RequestValidChartScaling then exit;
|
|
|
|
ADrawer.Pen := BubblePen;
|
|
if BubblePen.Color = clDefault then
|
|
ADrawer.SetPenColor(FChart.GetDefaultColor(dctFont))
|
|
else
|
|
ADrawer.SetPenColor(BubblePen.Color);
|
|
ADrawer.Brush := BubbleBrush;
|
|
if BubbleBrush.Color = clDefault then
|
|
ADrawer.SetBrushColor(FChart.GetDefaultColor(dctBrush))
|
|
else
|
|
ADrawer.SetBrushColor(BubbleBrush.Color);
|
|
|
|
ext := ParentChart.CurrentExtent;
|
|
clipR.TopLeft := ParentChart.GraphToImage(ext.a);
|
|
clipR.BottomRight := ParentChart.GraphToImage(ext.b);
|
|
NormalizeRect(clipR);
|
|
ADrawer.ClippingStart(clipR);
|
|
|
|
FBubbleScalingFactor := CalcBubbleScalingFactor(clipR);
|
|
|
|
for i := 0 to Count - 1 do begin
|
|
item := Source[i];
|
|
if not GetBubbleRect(item, FBubbleScalingFactor, irect) then
|
|
continue;
|
|
if not IntersectRect(dummyR, clipR, irect) then
|
|
continue;
|
|
if bocPen in OverrideColor then
|
|
ADrawer.SetPenParams(BubblePen.Style, ColorDef(item^.Color, BubblePen.Color));
|
|
if bocBrush in OverrideColor then
|
|
ADrawer.SetBrushColor(ColorDef(item^.Color, BubbleBrush.Color));
|
|
|
|
if Styles <> nil then
|
|
Styles.Apply(ADrawer, i);
|
|
|
|
ADrawer.Ellipse(irect.Left, irect.Top, irect.Right, irect.Bottom);
|
|
end;
|
|
|
|
GetXYCountNeeded(nx, ny);
|
|
if Source.YCount >= ny then
|
|
for i := 0 to ny - 1 do DrawLabels(ADrawer, i)
|
|
else
|
|
DrawLabels(ADrawer);
|
|
|
|
ADrawer.ClippingStop;
|
|
end;
|
|
|
|
{ Calculates the extent of the series such that bubbles are not clipped.
|
|
But note that this method is correct only for BubbleRadiusUnits bruXY, it
|
|
would crash for bruX and bruY. Adjust Chart.Margins or Chart.ExpandPercentage
|
|
in these cases. }
|
|
function TBubbleSeries.Extent: TDoubleRect;
|
|
var
|
|
i: Integer;
|
|
r: Double;
|
|
sp, gp, gq, rp: TDoublePoint;
|
|
item: PChartDataItem;
|
|
begin
|
|
Result := EmptyExtent;
|
|
if IsEmpty then exit;
|
|
if not RequestValidChartScaling then exit;
|
|
|
|
if FBubbleRadiusUnits = bruXY then
|
|
begin
|
|
for i := 0 to Count - 1 do begin
|
|
item := Source[i];
|
|
sp := item^.Point;
|
|
if TAChartUtils.IsNaN(sp) then
|
|
continue;
|
|
r := item^.YList[0];
|
|
if Math.IsNaN(r) then
|
|
continue;
|
|
rp := DoublePoint(r, r);
|
|
gp := AxisToGraph(sp);
|
|
gq := AxisToGraph(sp + rp);
|
|
rp := gq - gp;
|
|
|
|
Result.a.X := Min(Result.a.X, sp.x - rp.x);
|
|
Result.b.X := Max(Result.b.X, sp.x + rp.x);
|
|
Result.a.Y := Min(Result.a.Y, sp.y - rp.y);
|
|
Result.b.Y := Max(Result.b.Y, sp.y + rp.y);
|
|
end;
|
|
end else
|
|
Result := Source.BasicExtent;
|
|
end;
|
|
|
|
function TBubbleSeries.GetBubbleRect(AItem: PChartDataItem;
|
|
AFactor: Double; out ARect: TRect): Boolean;
|
|
var
|
|
sp: TDoublePoint; // source point in axis units
|
|
p: TPoint; // bubble center in image units
|
|
q: TPoint; // bubble center offset by 1 radius, in image units
|
|
r: Double; // radius in axis units
|
|
ri: Integer; // radius in image units
|
|
begin
|
|
Result := false;
|
|
sp := AItem^.Point;
|
|
if TAChartUtils.IsNaN(sp) then
|
|
exit;
|
|
r := AItem^.YList[0];
|
|
if Math.IsNaN(r) then
|
|
exit;
|
|
|
|
case FBubbleRadiusUnits of
|
|
bruX:
|
|
begin
|
|
p := ParentChart.GraphToImage(AxisToGraph(sp));
|
|
q := ParentChart.GraphToImage(AxisToGraph(sp + DoublePoint(r, 0))); // offset along x
|
|
if IsRotated then ri := q.y - p.y else ri := q.x - p.x;
|
|
ARect := Rect(p.x - ri, p.y - ri, p.x + ri, p.y + ri);
|
|
end;
|
|
bruY:
|
|
begin
|
|
p := ParentChart.GraphToImage(AxisToGraph(sp));
|
|
q := ParentChart.GraphToImage(AxisToGraph(sp + DoublePoint(0, r))); // offset along y
|
|
if IsRotated then ri := q.x - p.x else ri := q.y - p.y;
|
|
ARect := Rect(p.x - ri, p.y - ri, p.x + ri, p.y + ri);
|
|
end;
|
|
bruXY:
|
|
begin
|
|
ARect.TopLeft := ParentChart.GraphToImage(AxisToGraph(DoublePoint(sp.x - r, sp.y - r)));
|
|
ARect.BottomRight := ParentChart.GraphToImage(AxisToGraph(DoublePoint(sp.x + r, sp.y + r)));
|
|
end;
|
|
bruPercentageRadius:
|
|
begin
|
|
p := ParentChart.GraphToImage(AxisToGraph(sp));
|
|
ri := round(r * AFactor);
|
|
ARect := Rect(p.x - ri, p.y - ri, p.x + ri, p.y + ri);
|
|
end;
|
|
bruPercentageArea:
|
|
begin
|
|
p := ParentChart.GraphToImage(AxisToGraph(sp));
|
|
ri := round(sqrt(abs(r)) * AFactor);
|
|
ARect := Rect(p.x - ri, p.y - ri, p.x + ri, p.y + ri);
|
|
end;
|
|
end;
|
|
NormalizeRect(ARect);
|
|
Result := true;
|
|
end;
|
|
|
|
function TBubbleSeries.GetLabelDataPoint(AIndex, AYIndex: Integer): TDoublePoint;
|
|
const
|
|
DIRECTION: array [Boolean, Boolean] of TLabelDirection =
|
|
((ldTop, ldBottom), (ldRight, ldLeft));
|
|
IS_NEGATIVE: array[TLinearMarkPositions] of boolean =
|
|
(true, false, true, false);
|
|
//lmpOutside, lmpPositive, lmpNegative, lmpInside
|
|
var
|
|
R: TRect;
|
|
RArray: array[0..3] of Integer absolute R;
|
|
isneg: Boolean;
|
|
dir: TLabelDirection;
|
|
begin
|
|
if (AYIndex = 1) and GetBubbleRect(Source.Item[AIndex + FLoBound], FBubbleScalingFactor, R) then begin
|
|
isNeg := IS_NEGATIVE[MarkPositions];
|
|
if Assigned(GetAxisY) then
|
|
if (IsRotated and ParentChart.IsRightToLeft) xor GetAxisY.Inverted then
|
|
isNeg := not isNeg;
|
|
dir := DIRECTION[IsRotated, isNeg];
|
|
if IsRotated then
|
|
Result := ParentChart.ImageToGraph(Point(RArray[ord(dir)], (R.Top + R.Bottom) div 2))
|
|
else
|
|
Result := ParentChart.ImageToGraph(Point((R.Left + R.Right) div 2, RArray[ord(dir)]));
|
|
end else
|
|
Result := GetGraphPoint(AIndex, 0, 0);
|
|
end;
|
|
|
|
procedure TBubbleSeries.GetLegendItems(AItems: TChartLegendItems);
|
|
begin
|
|
GetLegendItemsRect(AItems, BubbleBrush, BubblePen);
|
|
end;
|
|
|
|
function TBubbleSeries.GetNearestPoint(const AParams: TNearestPointParams;
|
|
out AResults: TNearestPointResults): Boolean;
|
|
var
|
|
i: Integer;
|
|
item: PChartDataItem;
|
|
iRect: TRect;
|
|
p: TPoint;
|
|
dperim: Integer; // Distance of perimeter point from center of bubble
|
|
d, dist: Integer;
|
|
phi: Double;
|
|
rx, ry: Integer;
|
|
cosphi, sinphi: Math.float;
|
|
begin
|
|
Result := inherited;
|
|
if IsEmpty or not RequestValidChartScaling then exit;
|
|
if Result and (nptPoint in AParams.FTargets) and (nptPoint in ToolTargets) then
|
|
if (AResults.FYIndex = 0) then
|
|
exit;
|
|
|
|
if Result and (nptYList in AParams.FTargets) and (nptYList in ToolTargets) then
|
|
if (AResults.FYIndex = 1) then begin
|
|
item := Source[AResults.FIndex];
|
|
GetBubbleRect(item, FBubbleScalingFactor, iRect);
|
|
rx := (iRect.Right - iRect.Left) div 2;
|
|
ry := (iRect.Bottom - iRect.Top) div 2;
|
|
p := ParentChart.GraphToImage(AxisToGraph(item^.Point));
|
|
phi := arctan2(AParams.FPoint.Y - p.y, AParams.FPoint.X - p.x);
|
|
SinCos(phi, sinphi, cosphi);
|
|
AResults.FImg := p + Point(round(rx * cosPhi), round(ry * sinPhi));
|
|
exit;
|
|
end;
|
|
|
|
if (nptCustom in AParams.FTargets) and (nptCustom in ToolTargets) then begin
|
|
dist := MaxInt;
|
|
for i := 0 to Count - 1 do begin
|
|
item := Source[i];
|
|
if not GetBubbleRect(item, FBubbleScalingFactor, irect) then
|
|
continue;
|
|
rx := (iRect.Right - iRect.Left) div 2;
|
|
ry := (iRect.Bottom - iRect.Top) div 2;
|
|
p := ParentChart.GraphToImage(AxisToGraph(item^.Point));
|
|
phi := -arctan2(AParams.FPoint.Y - p.y, AParams.FPoint.X - p.x);
|
|
SinCos(phi, sinphi, cosphi);
|
|
dperim := round(sqrt(sqr(rx * cosPhi) + sqr(ry * sinPhi)));
|
|
d := round(sqrt(PointDistSq(p, AParams.FPoint)));
|
|
if (d < dist) and (d < dperim + AParams.FRadius) then begin // not quite exact...
|
|
dist := d;
|
|
AResults.FDist := d;
|
|
AResults.FIndex := i;
|
|
AResults.FYIndex := -1;
|
|
AResults.FValue := item^.Point;
|
|
AResults.FImg := AParams.FPoint;
|
|
if d = 0 then break;
|
|
end;
|
|
end;
|
|
if AResults.FIndex <> -1 then begin
|
|
AResults.FDist := sqr(AResults.FDist); // we need sqr for comparison with other series
|
|
Result := true;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TBubbleSeries.GetSeriesColor: TColor;
|
|
begin
|
|
Result := FBubbleBrush.Color;
|
|
end;
|
|
|
|
class procedure TBubbleSeries.GetXYCountNeeded(out AXCount, AYCount: Cardinal);
|
|
begin
|
|
AXCount := 1;
|
|
AYCount := 2;
|
|
end;
|
|
|
|
procedure TBubbleSeries.MovePointEx(var AIndex: Integer;
|
|
AXIndex, AYIndex: Integer; const ANewPos: TDoublePoint);
|
|
var
|
|
np: TDoublePoint; // ANewPos, in axis units
|
|
sp: TDoublePoint; // Orig data point (source point), in axis units
|
|
gp: TDoublePoint; // Orig data point, in graph units
|
|
ip: TPoint; // original data point, in image units
|
|
r: Double; // radius, in axis units
|
|
inp: TPoint; // NewPos in image units
|
|
rvec: TDoublePoint; // Rotated radius vector
|
|
begin
|
|
Unused(AXIndex);
|
|
|
|
ParentChart.DisableRedrawing;
|
|
ListSource.BeginUpdate;
|
|
try
|
|
case AYIndex of
|
|
-1,
|
|
0: begin
|
|
np := GraphToAxis(ANewPos);
|
|
ListSource.SetXValue(AIndex, np.X);
|
|
ListSource.SetYValue(AIndex, np.Y);
|
|
end;
|
|
1: begin
|
|
sp := ListSource.Item[AIndex]^.Point;
|
|
gp := AxisToGraph(sp);
|
|
case FBubbleRadiusUnits of
|
|
bruX:
|
|
begin
|
|
inp := ParentChart.GraphToImage(ANewPos);
|
|
ip := ParentChart.GraphToImage(gp);
|
|
// Distance data pt to ANewPos, in image units
|
|
r := sqrt(sqr(ip.X - inp.X) + sqr(ip.Y - inp.Y));
|
|
// Vector from bubble center to right bubble perimeter, in axis units
|
|
rvec := GraphToAxis(ParentChart.ImageToGraph(Point(ip.x + round(r), ip.y))) - sp;
|
|
// Radius of the circle
|
|
r := abs(rvec.x);
|
|
end;
|
|
bruY:
|
|
begin
|
|
// like bruX, but with y instead of x
|
|
inp := ParentChart.GraphToImage(ANewPos);
|
|
ip := ParentChart.GraphToImage(gp);
|
|
r := sqrt(sqr(ip.X - inp.X) + sqr(ip.Y - inp.Y));
|
|
rvec := GraphToAxis(ParentChart.ImageToGraph(Point(ip.x, ip.y + round(r)))) - sp;
|
|
r := abs(rvec.y);
|
|
end;
|
|
bruXY:
|
|
begin
|
|
// Blubble radius is the distance between data pt and mouse pt, in axis units
|
|
np := GraphToAxis(ANewPos);
|
|
rvec := np - sp;
|
|
r := sqrt(sqr(rvec.x) + sqr(rvec.y));
|
|
end;
|
|
end;
|
|
ListSource.SetYList(AIndex, [r]);
|
|
end;
|
|
end;
|
|
finally
|
|
ListSource.EndUpdate;
|
|
ParentChart.EnableRedrawing;
|
|
UpdateParentChart;
|
|
end;
|
|
end;
|
|
|
|
procedure TBubbleSeries.SetBubbleBrush(AValue: TBrush);
|
|
begin
|
|
if FBubbleBrush = AValue then exit;
|
|
FBubbleBrush.Assign(AValue);
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBubbleSeries.SetBubblePen(AValue: TPen);
|
|
begin
|
|
if FBubblePen = AValue then exit;
|
|
FBubblePen.Assign(AValue);
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBubbleSeries.SetBubbleRadiusPercentage(AValue: Integer);
|
|
begin
|
|
if FBubbleRadiusPercentage = AValue then exit;
|
|
FBubbleRadiusPercentage := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBubbleSeries.SetBubbleRadiusUnits(AValue: TBubbleRadiusUnits);
|
|
begin
|
|
if FBubbleRadiusUnits = AValue then exit;
|
|
FBubbleRadiusUnits := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBubbleSeries.SetOverrideColor(AValue: TBubbleOverrideColors);
|
|
begin
|
|
if FOverrideColor = AValue then exit;
|
|
FOverrideColor := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
function TBubbleSeries.ToolTargetDistance(const AParams: TNearestPointParams;
|
|
AGraphPt: TDoublePoint; APointIdx, AXIdx, AYIdx: Integer): Integer;
|
|
var
|
|
item: PChartDataItem;
|
|
iRect: TRect;
|
|
rx, ry: Integer;
|
|
d, dPerim: Integer;
|
|
p: TPoint;
|
|
phi, sinPhi, cosPhi: Math.float;
|
|
begin
|
|
if AYIdx = 0 then begin
|
|
Result := inherited;
|
|
exit;
|
|
end;
|
|
|
|
item := Source[APointIdx];
|
|
GetBubbleRect(item, FBubbleScalingFactor, iRect);
|
|
rx := (iRect.Right - iRect.Left) div 2;
|
|
ry := (iRect.Bottom - iRect.Top) div 2;
|
|
p := ParentChart.GraphToImage(AxisToGraph(item^.Point));
|
|
d := round(sqrt(PointDistSq(p, AParams.FPoint))); // dist between data pt and clicked pt
|
|
phi := -arctan2(AParams.FPoint.Y - p.y, AParams.FPoint.X - p.x);
|
|
SinCos(phi, sinphi, cosphi);
|
|
dperim := round(sqrt((sqr(rx * cosPhi) + sqr(ry * sinPhi))));
|
|
|
|
if AYIdx = 1 then
|
|
Result := sqr(abs(d - dperim))
|
|
else begin
|
|
Result := PointDistSq(p, AParams.FPoint);
|
|
if sqrt(Result) > dperim then
|
|
Result := MaxInt;
|
|
end;
|
|
end;
|
|
|
|
procedure TBubbleSeries.UpdateLabelDirectionReferenceLevel(AIndex, AYIndex: Integer;
|
|
var ALevel: Double);
|
|
begin
|
|
Unused(AIndex);
|
|
case AYIndex of
|
|
0: ALevel := -Infinity;
|
|
1: ALevel := +Infinity;
|
|
end;
|
|
end;
|
|
|
|
procedure TBubbleSeries.UpdateMargins(ADrawer: IChartDrawer;
|
|
var AMargins: TRect);
|
|
var
|
|
i, dist, j: Integer;
|
|
labelText: String;
|
|
dir: TLabelDirection;
|
|
m: array [TLabelDirection] of Integer absolute AMargins;
|
|
gp: TDoublePoint;
|
|
scMarksDistance: Integer;
|
|
center: Double;
|
|
begin
|
|
if not Marks.IsMarkLabelsVisible or not Marks.AutoMargins then exit;
|
|
if IsEmpty then exit;
|
|
if not RequestValidChartScaling then exit;
|
|
|
|
FindExtentInterval(ParentChart.CurrentExtent, Source.IsSortedByXAsc);
|
|
with Extent do
|
|
center := AxisToGraphY((a.y + b.y) * 0.5);
|
|
UpdateLabelDirectionReferenceLevel(0, 0, center);
|
|
scMarksDistance := ADrawer.Scale(Marks.Distance);
|
|
|
|
for i := FLoBound to FUpBound do begin
|
|
for j := 0 to Min(1, Source.YCount-1) do begin
|
|
gp := GetLabelDataPoint(i, j);
|
|
if not ParentChart.IsPointInViewPort(gp) then break;
|
|
labelText := FormattedMark(i, '', j);
|
|
if labelText = '' then break;
|
|
UpdateLabelDirectionReferenceLevel(i, j, center);
|
|
dir := GetLabelDirection(TDoublePointBoolArr(gp)[not IsRotated], center);
|
|
with Marks.MeasureLabel(ADrawer, labelText) do
|
|
dist := Math.IfThen(dir in [ldLeft, ldRight], cx, cy);
|
|
if Marks.DistanceToCenter then
|
|
dist := dist div 2;
|
|
m[dir] := Max(m[dir], dist + scMarksDistance);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{ TBoxAndWhiskerSeries }
|
|
|
|
function TBoxAndWhiskerSeries.AddXY(
|
|
AX, AYLoWhisker, AYLoBox, AY, AYHiBox, AYHiWhisker: Double; AXLabel: String;
|
|
AColor: TColor): Integer;
|
|
var
|
|
y: Double;
|
|
begin
|
|
if FYIndexWhiskerMin = 0 then
|
|
y := AYLoWhisker
|
|
else if FYIndexBoxMin = 0 then
|
|
y := AYLoBox
|
|
else if FYIndexCenter = 0 then
|
|
y := AY
|
|
else if FYIndexBoxMax = 0 then
|
|
y := AYHiBox
|
|
else if FYIndexWhiskerMax = 0 then
|
|
y := AYHiWhisker
|
|
else
|
|
raise Exception.Create('[TBoxAndWhiskerSeries.AddXY] Ordinary y value missing');
|
|
|
|
Result := ListSource.Add(AX, y, AXLabel, AColor);
|
|
with ListSource.Item[Result]^ do begin
|
|
SetY(FYIndexWhiskerMin, AYLoWhisker);
|
|
SetY(FYIndexBoxMin, AYLoBox);
|
|
SetY(FYIndexCenter, AY);
|
|
SetY(FYIndexBoxMax, AYHiBox);
|
|
SetY(FYIndexWhiskerMax, AYHiWhisker);
|
|
end;
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.Assign(ASource: TPersistent);
|
|
begin
|
|
if ASource is TBoxAndWhiskerSeries then
|
|
with TBoxAndWhiskerSeries(ASource) do begin
|
|
Self.BoxBrush.Assign(FBoxBrush);
|
|
Self.BoxPen.Assign(FBoxPen);
|
|
Self.FBoxWidth := FBoxWidth;
|
|
Self.MedianPen.Assign(FMedianPen);
|
|
Self.WhiskersPen.Assign(FWhiskersPen);
|
|
Self.FWhiskersWidth := FWhiskersWidth;
|
|
Self.FYDataLayout := FYDataLayout;
|
|
Self.FYIndexWhiskerMin := FYIndexWhiskerMin;
|
|
Self.FYIndexBoxMin := FYIndexBoxMin;
|
|
Self.FYIndexCenter := FYIndexCenter;
|
|
Self.FYIndexBoxMax := FYIndexBoxMax;
|
|
Self.FYIndexWhiskerMax := FYIndexWhiskerMax;
|
|
end;
|
|
inherited Assign(ASource);
|
|
end;
|
|
|
|
constructor TBoxAndWhiskerSeries.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ToolTargets := [nptPoint, nptYList, nptCustom];
|
|
FOptimizeX := false;
|
|
FBoxBrush := TBrush.Create;
|
|
FBoxBrush.OnChange := @StyleChanged;
|
|
FBoxPen := TPen.Create;
|
|
FBoxPen.OnChange := @StyleChanged;
|
|
FBoxWidth := DEF_BOX_WIDTH;
|
|
FMedianPen := TPen.Create;
|
|
FMedianPen.OnChange := @StyleChanged;
|
|
FWhiskersPen := TPen.Create;
|
|
FWhiskersPen.OnChange := @StyleChanged;
|
|
FWhiskersWidth := DEF_WHISKERS_WIDTH;
|
|
FYDataLayout := bwlLegacy;
|
|
FYIndexWhiskerMin := DEF_YINDEX_WHISKERMIN;
|
|
FYIndexBoxMin := DEF_YINDEX_BOXMIN;
|
|
FYIndexCenter := DEF_YINDEX_CENTER;
|
|
FYIndexBoxMax := DEF_YINDEX_BOXMAX;
|
|
FYIndexWhiskerMax := DEF_YINDEX_WHISKERMAX;
|
|
end;
|
|
|
|
destructor TBoxAndWhiskerSeries.Destroy;
|
|
begin
|
|
FreeAndNil(FBoxBrush);
|
|
FreeAndNil(FBoxPen);
|
|
FreeAndNil(FMedianPen);
|
|
FreeAndNil(FWhiskersPen);
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.Draw(ADrawer: IChartDrawer);
|
|
|
|
procedure GraphToImage_Whisker(X, XW, Y1, Y2: Double;
|
|
out iX1, iX, iX2, iY1, iY2: Integer);
|
|
begin
|
|
if IsRotated then
|
|
begin
|
|
iX1 := ParentChart.YGraphToImage(X - XW);
|
|
iX2 := ParentChart.YGraphToImage(X + XW);
|
|
if iX1 <> iX2 then
|
|
iX := ParentChart.YGraphToImage(X)
|
|
else
|
|
iX := iX1;
|
|
iY1 := ParentChart.XGraphToImage(Y1);
|
|
iY2 := ParentChart.XGraphToImage(Y2);
|
|
end else
|
|
begin
|
|
iX1 := ParentChart.XGraphToImage(X - XW);
|
|
iX2 := ParentChart.XGraphToImage(X + XW);
|
|
if iX1 <> iX2 then
|
|
iX := ParentChart.XGraphToImage(X)
|
|
else
|
|
iX := iX1;
|
|
iY1 := ParentChart.YGraphToImage(Y1);
|
|
iY2 := ParentChart.YGraphToImage(Y2);
|
|
end;
|
|
end;
|
|
|
|
procedure GraphToImage_Bar(X1, X2, Y1, Y2: Double;
|
|
out iX1, iX2, iY1, iY2: Integer);
|
|
begin
|
|
if IsRotated then
|
|
begin
|
|
iX1 := ParentChart.YGraphToImage(X1);
|
|
iX2 := ParentChart.YGraphToImage(X2);
|
|
iY1 := ParentChart.XGraphToImage(Y1);
|
|
iY2 := ParentChart.XGraphToImage(Y2);
|
|
end else
|
|
begin
|
|
iX1 := ParentChart.XGraphToImage(X1);
|
|
iX2 := ParentChart.XGraphToImage(X2);
|
|
iY1 := ParentChart.YGraphToImage(Y1);
|
|
iY2 := ParentChart.YGraphToImage(Y2);
|
|
end;
|
|
end;
|
|
|
|
procedure GraphToImage_Median(Y: Double; out iY: Integer);
|
|
begin
|
|
if IsRotated then
|
|
iY := ParentChart.XGraphToImage(Y)
|
|
else
|
|
iY := ParentChart.YGraphToImage(Y);
|
|
end;
|
|
|
|
procedure PrepareLine(i: Integer; APen: TPen);
|
|
begin
|
|
ADrawer.Pen := APen;
|
|
if (Source[i]^.Color <> clTAColor) and (APen.Color = clTAColor) then
|
|
ADrawer.SetPenColor(Source[i]^.Color);
|
|
ADrawer.SetBrushParams(bsClear, clTAColor);
|
|
end;
|
|
|
|
procedure PrepareBox(i: Integer);
|
|
begin
|
|
ADrawer.Pen := BoxPen;
|
|
if Source[i]^.Color <> clTAColor then
|
|
begin
|
|
if BoxPen.Color = clTAColor then
|
|
ADrawer.SetPenColor(Source[i]^.Color);
|
|
ADrawer.SetBrushParams(bsSolid, Source[i]^.Color);
|
|
end
|
|
else
|
|
ADrawer.Brush := BoxBrush;
|
|
end;
|
|
|
|
{ X1 X X2
|
|
|----+----| Y
|
|
|
|
|
+-----+-----+ YBox
|
|
| |
|
|
| |
|
|
}
|
|
procedure DrawWhisker(X1, X, X2, Y, YBox: Integer);
|
|
begin
|
|
if IsRotated then
|
|
begin
|
|
if X1 <> X2 then
|
|
ADrawer.Line(Y, X1, Y, X2);
|
|
ADrawer.Line(Y, X, YBox, X);
|
|
end else
|
|
begin
|
|
if X1 <> X2 then
|
|
ADrawer.Line(X1, Y, X2, Y);
|
|
ADrawer.Line(X, Y, X, YBox);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawBox(XBox1, XBox2, YBox1, YBox2: Integer);
|
|
begin
|
|
if (XBox1 = XBox2) or (YBox1 = YBox2) then
|
|
begin
|
|
if IsRotated then
|
|
ADrawer.Line(YBox1, XBox1, YBox2, XBox2)
|
|
else
|
|
ADrawer.Line(XBox1, YBox1, XBox2, YBox2);
|
|
end else
|
|
begin
|
|
if IsRotated then
|
|
ADrawer.Rectangle(YBox1, XBox1, YBox2, XBox2)
|
|
else
|
|
ADrawer.Rectangle(XBox1, YBox1, XBox2, YBox2);
|
|
end;
|
|
end;
|
|
|
|
procedure DrawMedian(X1, X2, Y: Integer);
|
|
begin
|
|
if IsRotated then
|
|
ADrawer.Line(Y, X1, Y, X2)
|
|
else
|
|
ADrawer.Line(X1, Y, X2, Y);
|
|
end;
|
|
|
|
function GetY(AItem: PChartDataItem; AYIndex: Integer; out AY: Double): Boolean;
|
|
var
|
|
y: Double;
|
|
begin
|
|
Result := false;
|
|
if AYIndex = 0 then
|
|
y := AItem^.Y
|
|
else
|
|
y := AItem^.YList[AYIndex-1];
|
|
if IsNaN(y) then
|
|
exit;
|
|
|
|
AY := AxisToGraphY(y);
|
|
Result := true;
|
|
end;
|
|
|
|
var
|
|
ext2: TDoubleRect;
|
|
x, ymin, yqmin, ymed, yqmax, ymax, wb, ww, w: Double;
|
|
i: Integer;
|
|
ix, ixb1, ixb2, ixw1, ixw2: Integer;
|
|
iymin, iyqmin, iymed, iyqmax, iymax: Integer;
|
|
nx, ny: Cardinal;
|
|
item: PChartDataItem;
|
|
begin
|
|
if IsEmpty or (not Active) then exit;
|
|
|
|
if FWidthStyle = bwsPercentMin then
|
|
UpdateMinXRange;
|
|
|
|
ext2 := ParentChart.CurrentExtent;
|
|
ExpandRange(ext2.a.X, ext2.b.X, 1.0);
|
|
ExpandRange(ext2.a.Y, ext2.b.Y, 1.0);
|
|
|
|
PrepareGraphPoints(ext2, true);
|
|
|
|
for i := FLoBound to FUpBound do begin
|
|
// Get values from source and convert to graph units.
|
|
item := Source[i];
|
|
x := GetGraphPointX(i);
|
|
if IsNaN(x) then continue;
|
|
if not GetY(item, FYIndexWhiskerMin, ymin) then continue;
|
|
if not GetY(item, FYIndexBoxMin, yqmin) then continue;
|
|
if not GetY(item, FYIndexCenter, ymed) then continue;
|
|
if not GetY(item, FYIndexBoxMax, yqmax) then continue;
|
|
if not GetY(item, FYIndexWhiskerMax, ymax) then continue;
|
|
|
|
case FWidthStyle of
|
|
bwsPercent: w := GetXRange(x, i) * PERCENT / 2;
|
|
bwsPercentMin: w := FMinXRange * PERCENT / 2;
|
|
end;
|
|
wb := w * BoxWidth;
|
|
ww := w * WhiskersWidth;
|
|
|
|
// Calculate image coordiantes
|
|
GraphToImage_Whisker(x, ww, ymin, ymax, ixw1, ix, ixw2, iymin, iymax);
|
|
GraphToImage_Bar(x-wb, x+wb, yqmin, yqmax, ixb1, ixb2, iyqmin, iyqmax);
|
|
GraphToImage_Median(ymed, iymed);
|
|
|
|
// Draw whisker
|
|
PrepareLine(i, WhiskersPen);
|
|
DrawWhisker(ixw1, ix, ixw2, iymin, iyqmin);
|
|
DrawWhisker(ixw1, ix, ixw2, iymax, iyqmax);
|
|
|
|
// Draw box
|
|
PrepareBox(i);
|
|
DrawBox(ixb1, ixb2, iyqmin, iyqmax);
|
|
ADrawer.Pen := WhiskersPen;
|
|
ADrawer.SetPenColor(WhiskersPen.Color);
|
|
|
|
// Draw median line
|
|
PrepareLine(i, MedianPen);
|
|
DrawMedian(ixb1, ixb2, iymed);
|
|
end;
|
|
|
|
GetXYCountNeeded(nx, ny);
|
|
if Source.YCount > ny then
|
|
for i := 0 to ny-1 do DrawLabels(ADrawer, i)
|
|
else
|
|
DrawLabels(ADrawer);
|
|
end;
|
|
|
|
function TBoxAndWhiskerSeries.Extent: TDoubleRect;
|
|
var
|
|
x: Double;
|
|
j: Integer;
|
|
|
|
function ExtraWidth(AIndex: Integer): Double;
|
|
begin
|
|
Result := GetXRange(x, AIndex) * Max(BoxWidth, WhiskersWidth) * PERCENT / 2;
|
|
end;
|
|
|
|
begin
|
|
Result := Source.ExtentList;
|
|
if Source.Count = 0 then
|
|
exit;
|
|
|
|
// Show first and last boxes fully.
|
|
j := -1;
|
|
x := NaN;
|
|
while IsNaN(x) and (j < Source.Count-1) do begin
|
|
inc(j);
|
|
x := GetGraphPointX(j);
|
|
end;
|
|
Result.a.X := Min(Result.a.X, GraphToAxisX(x - ExtraWidth(j)));
|
|
j := Count;
|
|
x := NaN;
|
|
while IsNaN(x) and (j > 0) do begin
|
|
dec(j);
|
|
x := GetGraphPointX(j);
|
|
end;
|
|
Result.b.X := Max(Result.b.X, GraphToAxisX(x + ExtraWidth(j)));
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.GetLegendItems(AItems: TChartLegendItems);
|
|
begin
|
|
AItems.Add(TLegendItemBoxAndWhiskers.Create(Self, LegendTextSingle));
|
|
end;
|
|
|
|
function TBoxAndWhiskerSeries.GetNearestPoint(const AParams: TNearestPointParams;
|
|
out AResults: TNearestPointResults): Boolean;
|
|
var
|
|
i, j: Integer;
|
|
graphClickPt, pt: TDoublePoint;
|
|
x, w, wb: Double;
|
|
y: Array[0..4] of Double;
|
|
pImg: TPoint;
|
|
R: TDoubleRect;
|
|
xImg, dist: Integer;
|
|
begin
|
|
Result := inherited;
|
|
|
|
if Result then begin
|
|
if (nptPoint in AParams.FTargets) and (nptPoint in ToolTargets) then
|
|
exit;
|
|
if (nptYList in AParams.FTargets) and (nptYList in ToolTargets) then
|
|
exit;
|
|
end;
|
|
|
|
if not ((nptCustom in AParams.FTargets) and (nptCustom in ToolTargets))
|
|
then
|
|
exit;
|
|
|
|
pImg := AParams.FPoint;
|
|
graphClickPt := ParentChart.ImageToGraph(AParams.FPoint);
|
|
if IsRotated then begin
|
|
Exchange(graphclickpt.X, graphclickpt.Y);
|
|
pImg := ParentChart.GraphToImage(graphclickPt);
|
|
end;
|
|
|
|
// Iterate through all points of the series
|
|
for i := 0 to Count - 1 do begin
|
|
x := GetGraphPointX(i);
|
|
for j := 0 to High(y) do
|
|
y[j] := GetGraphPointY(i, j);
|
|
case FWidthStyle of
|
|
bwsPercent : w := GetXRange(x, i) * PERCENT / 2;
|
|
bwsPercentMin : w := FMinXRange * PERCENT / 2;
|
|
end;
|
|
wb := w * BoxWidth;
|
|
|
|
dist := MaxInt;
|
|
|
|
// click inside box
|
|
R.a := DoublePoint(x - wb, y[FYIndexBoxMin]);
|
|
R.b := DoublePoint(x + wb, y[FYIndexBoxMax]);
|
|
if InRange(graphClickPt.X, R.a.x, R.b.x) and InRange(graphClickPt.Y, R.a.Y, R.b.Y) then
|
|
begin
|
|
dist := 0;
|
|
AResults.FYIndex := -1;
|
|
end;
|
|
|
|
// click on whisker line
|
|
xImg := ParentChart.XGraphToImage(x);
|
|
if InRange(graphClickPt.Y, y[FYIndexWhiskerMin], y[FYIndexBoxMin]) or
|
|
InRange(graphClickPt.Y, y[FYIndexWhiskerMax], y[FYIndexBoxMax])
|
|
then begin
|
|
dist := sqr(pImg.X - xImg);
|
|
AResults.FYIndex := -1;
|
|
end;
|
|
|
|
// Sufficiently close?
|
|
if dist < AResults.FDist then begin
|
|
AResults.FDist := dist;
|
|
AResults.FIndex := i;
|
|
pt := DoublePoint(x, y[2]); // Median
|
|
AResults.FValue := pt;
|
|
if IsRotated then Exchange(pt.X, pt.Y);
|
|
AResults.FImg := ParentChart.GraphToImage(pt);
|
|
if dist = 0 then break;
|
|
end;
|
|
end;
|
|
Result := AResults.FIndex > -1;
|
|
end;
|
|
|
|
function TBoxAndWhiskerSeries.GetSeriesColor: TColor;
|
|
begin
|
|
Result := BoxBrush.Color;
|
|
end;
|
|
|
|
class procedure TBoxAndWhiskerSeries.GetXYCountNeeded(out AXCount, AYCount: Cardinal);
|
|
begin
|
|
AXCount := 0;
|
|
AYCount := 5;
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.SetBoxBrush(AValue: TBrush);
|
|
begin
|
|
if FBoxBrush = AValue then exit;
|
|
FBoxBrush.Assign(AValue);
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.SetBoxPen(AValue: TPen);
|
|
begin
|
|
if FBoxPen = AValue then exit;
|
|
FBoxPen.Assign(AValue);
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.SetBoxWidth(AValue: Integer);
|
|
begin
|
|
if FBoxWidth = AValue then exit;
|
|
FBoxWidth := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.SetLegendDirection(
|
|
AValue: TBoxAndWhiskerSeriesLegendDir);
|
|
begin
|
|
if FLegendDirection = AValue then exit;
|
|
FLegendDirection := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.SetMedianPen(AValue: TPen);
|
|
begin
|
|
if FMedianPen = AValue then exit;
|
|
FMedianPen.Assign(AValue);
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.SetWhiskersPen(AValue: TPen);
|
|
begin
|
|
if FWhiskersPen = AValue then exit;
|
|
FWhiskersPen.Assign(AValue);
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.SetWhiskersWidth(AValue: Integer);
|
|
begin
|
|
if FWhiskersWidth = AValue then exit;
|
|
FWhiskersWidth := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.SetYIndexBoxMax(AValue: Integer);
|
|
begin
|
|
if FYIndexBoxMax = AValue then exit;
|
|
FYIndexBoxMax := AValue;
|
|
UpdateYDataLayout;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.SetYIndexBoxMin(AValue: Integer);
|
|
begin
|
|
if FYIndexBoxMin = AValue then exit;
|
|
FYIndexBoxMin := AValue;
|
|
UpdateYDataLayout;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.SetYIndexCenter(AValue: Integer);
|
|
begin
|
|
if FYIndexCenter = AValue then exit;
|
|
FYIndexCenter := AValue;
|
|
UpdateYDataLayout;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.SetYIndexWhiskerMax(AValue: Integer);
|
|
begin
|
|
if FYIndexWhiskerMax = AValue then exit;
|
|
FYIndexWhiskerMax := AValue;
|
|
UpdateYDataLayout;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.SetYIndexWhiskerMin(AValue: Integer);
|
|
begin
|
|
if FYIndexWhiskerMin = AValue then exit;
|
|
FYIndexWhiskerMin := AValue;
|
|
UpdateYDataLayout;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.SetYDataLayout(AValue: TBoxAndWhiskerYDataLayout);
|
|
|
|
procedure SetYIndices(AWhiskerMin, ABoxMin, ACenter, ABoxMax, AWhiskerMax: Integer);
|
|
begin
|
|
FYIndexWhiskerMin := AWhiskerMin;
|
|
FYIndexBoxMin := ABoxMin;
|
|
FYIndexCenter := ACenter;
|
|
FYIndexBoxMax := ABoxMax;
|
|
FYIndexWhiskerMax := AWhiskerMax;
|
|
end;
|
|
|
|
begin
|
|
if FYDataLayout = AValue then exit;
|
|
FYDataLayout := AValue;
|
|
case FYDataLayout of
|
|
bwlNormal: SetYIndices(1, 2, 0, 3, 4);
|
|
bwlLegacy: SetYIndices(0, 1, 2, 3, 4);
|
|
bwlCustom: ;
|
|
end;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
function TBoxAndWhiskerSeries.SkipMissingValues(AIndex: Integer): Boolean;
|
|
begin
|
|
Result := IsNaN(Source[AIndex]^.Point);
|
|
if not Result then
|
|
Result := HasMissingYValue(AIndex, 5);
|
|
end;
|
|
|
|
function TBoxAndWhiskerSeries.ToolTargetDistance(
|
|
const AParams: TNearestPointParams; AGraphPt: TDoublePoint;
|
|
APointIdx, AXIdx, AYIdx: Integer): Integer;
|
|
|
|
// All in image coordinates transformed to have a horizontal x axis
|
|
function DistanceToLine(Pt: TPoint; x1, x2, y: Integer): Integer;
|
|
begin
|
|
if InRange(Pt.X, x1, x2) then
|
|
Result := sqr(Pt.Y - y) // FDistFunc does not calc sqrt
|
|
else
|
|
Result := Min(
|
|
AParams.FDistFunc(Pt, Point(x1, y)),
|
|
AParams.FDistFunc(Pt, Point(x2, y))
|
|
);
|
|
end;
|
|
|
|
var
|
|
xw1, xw2, xb1, xb2, y: Integer;
|
|
w, wb, ww: Double;
|
|
clickPt: TPoint;
|
|
gp: TDoublePoint;
|
|
begin
|
|
Unused(AXIdx);
|
|
|
|
if IsRotated then begin
|
|
gp := ParentChart.ImageToGraph(AParams.FPoint);
|
|
Exchange(gp.X, gp.Y);
|
|
clickPt := ParentChart.GraphToImage(gp);
|
|
Exchange(AGraphPt.X, AGraphPt.Y);
|
|
end else
|
|
clickPt := AParams.FPoint;
|
|
|
|
case FWidthStyle of
|
|
bwsPercent : w := GetXRange(AGraphPt.X, APointIdx) * PERCENT / 2;
|
|
bwsPercentMin : w := FMinXRange * PERCENT / 2;
|
|
end;
|
|
wb := w * BoxWidth;
|
|
ww := w * WhiskersWidth;
|
|
|
|
xw1 := ParentChart.XGraphToImage(AGraphPt.X - ww);
|
|
xw2 := ParentChart.XGraphToImage(AGraphPt.X + ww);
|
|
xb1 := ParentChart.XGraphToImage(AGraphPt.X - wb);
|
|
xb2 := ParentChart.XGraphToImage(AGraphPt.X + wb);
|
|
y := ParentChart.YGraphToImage(AGraphPt.Y);
|
|
|
|
if AYIdx in [FYIndexWhiskerMax, FYIndexWhiskerMin] then
|
|
Result := DistanceToLine(clickPt, xw1, xw2, y)
|
|
else if AYIdx in [FYIndexBoxMax, FYIndexCenter, FYIndexBoxMin] then
|
|
Result := DistanceToLine(clickPt, xb1, xb2, y)
|
|
else
|
|
raise Exception.Create('[TBoxAndWhiskerSeries.ToolTargetDistance] Unknown y index.');
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.UpdateLabelDirectionReferenceLevel(
|
|
AIndex, AYIndex: Integer; var ALevel: Double);
|
|
var
|
|
item: PChartDataItem;
|
|
y0, y3: Double;
|
|
begin
|
|
{ ToDo: The version before introducing FYIndex* variables had used the values
|
|
0 and 3 here. 3 means: FYIndexBoxMax. Interpreted this as a typo, but there
|
|
is some chance that it would be correct --> needs to be checked. }
|
|
if (AYIndex = FYIndexWhiskerMin) then
|
|
ALevel := +Infinity
|
|
else if (AYIndex = FYIndexWhiskerMax) then
|
|
ALevel := -Infinity
|
|
else
|
|
begin
|
|
item := Source.Item[AIndex];
|
|
y0 := AxisToGraphY(item^.GetY(FYIndexWhiskerMin));
|
|
y3 := AxisToGraphY(item^.GetY(FYIndexWhiskerMax));
|
|
ALevel := (y0 + y3) * 0.5;
|
|
end;
|
|
end;
|
|
|
|
procedure TBoxAndWhiskerSeries.UpdateYDataLayout;
|
|
begin
|
|
if (FYIndexWhiskerMin = 0) and (FYIndexBoxMin = 1) and (FYIndexCenter = 2) and
|
|
(FYIndexBoxMax = 3) and (FYIndexWhiskerMax = 4)
|
|
then
|
|
FYDataLayout := bwlLegacy
|
|
else
|
|
if (FYIndexCenter = 0) and (FYIndexWhiskerMin = 1) and (FYIndexBoxMin = 2) and
|
|
(FYIndexBoxMax = 3) and (FYIndexWhiskerMax = 4)
|
|
then
|
|
FYDataLayout := bwlNormal
|
|
else
|
|
FYDataLayout := bwlCustom;
|
|
end;
|
|
|
|
{ TOHLCBrush }
|
|
|
|
function TOHLCBrush.IsColorStored: Boolean;
|
|
begin
|
|
Result := (Color = DEFAULT_COLORS[FBrushKind]);
|
|
end;
|
|
|
|
procedure TOHLCBrush.SetBrushKind(AValue: TOHLCBrushKind);
|
|
begin
|
|
FBrushKind := AValue;
|
|
Color := DEFAULT_COLORS[FBrushKind];
|
|
end;
|
|
|
|
{ TOHLCPen }
|
|
|
|
function TOHLCPen.IsColorStored: Boolean;
|
|
begin
|
|
Result := (Color = DEFAULT_COLORS[FPenKind]);
|
|
end;
|
|
|
|
procedure TOHLCPen.SetPenKind(AValue: TOHLCPenKind);
|
|
begin
|
|
FPenKind := AValue;
|
|
Color := DEFAULT_COLORS[FPenKind];
|
|
end;
|
|
|
|
{ TOpenHighLowCloseSeries }
|
|
|
|
function TOpenHighLowCloseSeries.AddXOHLC(
|
|
AX, AOpen, AHigh, ALow, AClose: Double;
|
|
ALabel: String; AColor: TColor): Integer;
|
|
var
|
|
y: Double;
|
|
begin
|
|
if YIndexOpen = 0 then
|
|
y := AOpen
|
|
else if YIndexHigh = 0 then
|
|
y := AHigh
|
|
else if YIndexLow = 0 then
|
|
y := ALow
|
|
else if YIndexClose = 0 then
|
|
y := AClose
|
|
else
|
|
raise Exception.Create('TOpenHighLowCloseSeries: Ordinary y value missing');
|
|
|
|
Result := ListSource.Add(AX, y, ALabel, AColor);
|
|
with ListSource.Item[Result]^ do begin
|
|
SetY(YIndexOpen, AOpen);
|
|
SetY(YIndexHigh, AHigh);
|
|
SetY(YIndexLow, ALow);
|
|
SetY(YIndexClose, AClose);
|
|
end;
|
|
end;
|
|
|
|
procedure TOpenHighLowCloseSeries.Assign(ASource: TPersistent);
|
|
var
|
|
bk: TOHLCBrushKind;
|
|
pk: TOHLCPenKind;
|
|
begin
|
|
if ASource is TOpenHighLowCloseSeries then
|
|
with TOpenHighLowCloseSeries(ASource) do begin
|
|
for bk in TOHLCBrushKind do
|
|
Self.FBrush[bk] := FBrush[bk];
|
|
for pk in TOHLCPenKind do
|
|
Self.FPen[pk] := FPen[pk];
|
|
Self.FMode := FMode;
|
|
Self.FTickWidth := FTickWidth;
|
|
Self.FYIndexClose := FYIndexClose;
|
|
Self.FYIndexHigh := FYIndexHigh;
|
|
Self.FYIndexLow := FYIndexLow;
|
|
Self.FYIndexOpen := FYIndexOpen;
|
|
end;
|
|
inherited Assign(ASource);
|
|
end;
|
|
|
|
constructor TOpenHighLowCloseSeries.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
ToolTargets := [nptPoint, nptYList, nptCustom];
|
|
FOptimizeX := false;
|
|
FStacked := false;
|
|
FTickWidth := DEF_OHLC_TICK_WIDTH;
|
|
FYIndexClose := DEF_YINDEX_CLOSE;
|
|
FYIndexHigh := DEF_YINDEX_HIGH;
|
|
FYIndexLow := DEF_YINDEX_LOW;
|
|
FYIndexOpen := DEF_YINDEX_OPEN;
|
|
|
|
// Candlestick up brush
|
|
FBrush[obkCandleUp] := TOHLCBrush.Create;
|
|
FBrush[obkCandleUp].BrushKind := obkCandleUp;
|
|
FBrush[obkCandleUp].OnChange := @StyleChanged;
|
|
// Candlestick down brush
|
|
FBrush[obkCandleDown] := TOHLCBrush.Create;
|
|
FBrush[obkCandleDown].BrushKind := obkCandleDown;
|
|
FBrush[obkCandleDown].OnChange := @StyleChanged;
|
|
// Candlestick up border pen
|
|
FPen[opkCandleUp] := TOHLCPen.Create;
|
|
FPen[opkCandleUp].PenKind := opkCandleUp;
|
|
FPen[opkCandleUp].OnChange := @StyleChanged;
|
|
// Candlestick down border pen
|
|
FPen[opkCandleDown] := TOHLCPen.Create;
|
|
FPen[opkCandleDown].PenKind := opkCandleDown;
|
|
FPen[opkCandleDown].OnChange := @StyleChanged;
|
|
// Candlestick range pen
|
|
FPen[opkCandleLine] := TOHLCPen.Create;
|
|
FPen[opkCandleLine].PenKind := opkCandleLine;
|
|
FPen[opkCandleLine].OnChange := @StyleChanged;
|
|
// OHLC up pen
|
|
FPen[opkLineUp] := TOHLCPen.Create;
|
|
FPen[opkLineUp].PenKind := opkLineUp;
|
|
FPen[opkLineUp].OnChange := @StyleChanged;
|
|
// OHLC down pen
|
|
FPen[opkLineDown] := TOHLCPen.Create;
|
|
FPen[opkLineDown].PenKind := opkLineDown;
|
|
FPen[opkLineDown].OnChange := @StyleChanged;
|
|
end;
|
|
|
|
destructor TOpenHighLowCloseSeries.Destroy;
|
|
var
|
|
bk: TOHLCBrushKind;
|
|
pk: TOHLCPenKind;
|
|
begin
|
|
for bk in TOHLCBrushKind do
|
|
FreeAndNil(FBrush[bk]);
|
|
for pk in TOHLCPenKind do
|
|
FreeAndNil(FPen[pk]);
|
|
inherited;
|
|
end;
|
|
|
|
function TOpenHighLowCloseSeries.CalcTickWidth(AX: Double; AIndex: Integer): Double;
|
|
begin
|
|
case FTickWidthStyle of
|
|
twsPercent:
|
|
Result := GetXRange(AX, AIndex) * PERCENT * TickWidth;
|
|
twsPercentMin:
|
|
begin
|
|
if FMinXRange = 0 then
|
|
UpdateMinXRange;
|
|
Result := FMinXRange * PERCENT * TickWidth;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TOpenHighLowCloseSeries.Draw(ADrawer: IChartDrawer);
|
|
|
|
function MaybeRotate(AX, AY: Double): TPoint;
|
|
begin
|
|
if IsRotated then
|
|
Exchange(AX, AY);
|
|
Result := ParentChart.GraphToImage(DoublePoint(AX, AY));
|
|
end;
|
|
|
|
procedure DoLine(AX1, AY1, AX2, AY2: Double);
|
|
begin
|
|
ADrawer.Line(MaybeRotate(AX1, AY1), MaybeRotate(AX2, AY2));
|
|
end;
|
|
|
|
procedure NoZeroRect(var R: TRect);
|
|
begin
|
|
if IsRotated then
|
|
begin
|
|
if R.Left = R.Right then inc(R.Right);
|
|
end else
|
|
begin
|
|
if R.Top = R.Bottom then inc(R.Bottom);
|
|
end;
|
|
end;
|
|
|
|
procedure DoRect(AX1, AY1, AX2, AY2: Double);
|
|
var
|
|
r: TRect;
|
|
begin
|
|
r.TopLeft := MaybeRotate(AX1, AY1);
|
|
r.BottomRight := MaybeRotate(AX2, AY2);
|
|
NoZeroRect(r);
|
|
ADrawer.FillRect(r.Left, r.Top, r.Right, r.Bottom);
|
|
ADrawer.Rectangle(r);
|
|
end;
|
|
|
|
procedure DrawOHLC(x, yopen, yhigh, ylow, yclose, tw: Double);
|
|
begin
|
|
DoLine(x, yhigh, x, ylow);
|
|
DoLine(x, yclose, x + tw, yclose);
|
|
if not IsNaN(yopen) then
|
|
DoLine(x - tw, yopen, x, yopen);
|
|
end;
|
|
|
|
procedure DrawCandleStick(x, yopen, yhigh, ylow, yclose, tw: Double; APenIdx: Integer);
|
|
begin
|
|
if CandleStickLinePen.Color = clDefault then
|
|
// use linepen and linedown pen for range line
|
|
ADrawer.Pen := FPen[TOHLCPenKind(APenIdx + 3)]
|
|
else
|
|
ADrawer.Pen := CandleStickLinePen;
|
|
DoLine(x, yhigh, x, ylow);
|
|
ADrawer.Pen := FPen[TOHLCPenKind(APenIdx)];
|
|
DoRect(x - tw, yopen, x + tw, yclose);
|
|
end;
|
|
|
|
const
|
|
UP_INDEX = 0;
|
|
DOWN_INDEX = 1;
|
|
var
|
|
my: Cardinal;
|
|
ext2: TDoubleRect;
|
|
i: Integer;
|
|
x, tw, yopen, yhigh, ylow, yclose, prevclose: Double;
|
|
idx: Integer;
|
|
nx, ny: Cardinal;
|
|
begin
|
|
if IsEmpty or (not Active) then exit;
|
|
my := MaxIntValue([YIndexOpen, YIndexHigh, YIndexLow, YIndexClose]);
|
|
if my >= Source.YCount then exit;
|
|
|
|
ext2 := ParentChart.CurrentExtent;
|
|
ExpandRange(ext2.a.X, ext2.b.X, 1.0);
|
|
ExpandRange(ext2.a.Y, ext2.b.Y, 1.0);
|
|
|
|
PrepareGraphPoints(ext2, true);
|
|
|
|
prevclose := -Infinity;
|
|
for i := FLoBound to FUpBound do begin
|
|
x := GetGraphPointX(i);
|
|
if IsNaN(x) then Continue;
|
|
yopen := GetGraphPointY(i, YIndexOpen);
|
|
if IsNaN(yopen) and (FMode = mCandleStick) then Continue;
|
|
yhigh := GetGraphPointY(i, YIndexHigh);
|
|
if IsNaN(yhigh) then Continue;
|
|
ylow := GetGraphPointY(i, YIndexLow);
|
|
if IsNaN(ylow) then Continue;
|
|
yclose := GetGraphPointY(i, YIndexClose);
|
|
if IsNaN(yclose) then Continue;
|
|
tw := CalcTickWidth(x, i);
|
|
|
|
if IsNaN(yopen) then
|
|
begin
|
|
// HLC chart: compare with close value of previous data point
|
|
if prevclose < yclose then
|
|
idx := UP_INDEX
|
|
else
|
|
idx := DOWN_INDEX;
|
|
end else
|
|
if (yopen <= yclose) then
|
|
idx := UP_INDEX
|
|
else
|
|
idx := DOWN_INDEX;
|
|
ADrawer.Brush := FBrush[TOHLCBrushKind(idx)];
|
|
case FMode of
|
|
mOHLC: ADrawer.Pen := FPen[TOHLCPenKind(idx + 3)];
|
|
mCandlestick: ADrawer.Pen := FPen[TOHLCPenKind(idx)];
|
|
end;
|
|
if Source[i]^.Color <> clTAColor then
|
|
begin
|
|
ADrawer.SetPenParams(FPen[TOHLCPenKind(idx)].Style, Source[i]^.Color, FPen[TOHLCPenKind(idx)].Width);
|
|
ADrawer.SetBrushParams(FBrush[TOHLCBrushKind(idx)].Style, Source[i]^.Color);
|
|
end;
|
|
|
|
case FMode of
|
|
mOHLC: DrawOHLC(x, yopen, yhigh, ylow, yclose, tw);
|
|
mCandleStick: DrawCandleStick(x, yopen, yhigh, ylow, yclose, tw, idx);
|
|
end;
|
|
|
|
prevclose := yclose;
|
|
end;
|
|
|
|
GetXYCountNeeded(nx, ny);
|
|
if Source.YCount > ny then
|
|
for i := 0 to ny-1 do DrawLabels(ADrawer, i)
|
|
else
|
|
DrawLabels(ADrawer);
|
|
end;
|
|
|
|
function TOpenHighLowCloseSeries.Extent: TDoubleRect;
|
|
var
|
|
x: Double;
|
|
tw: Double;
|
|
j: Integer;
|
|
begin
|
|
Result := Source.ExtentList; // axis units
|
|
|
|
// Enforce recalculation of tick/candlebox width
|
|
FMinXRange := 0;
|
|
|
|
// Show first and last open/close ticks and candle boxes fully.
|
|
j := -1;
|
|
x := NaN;
|
|
while IsNaN(x) and (j < Source.Count-1) do begin
|
|
inc(j);
|
|
x := GetGraphPointX(j); // graph units
|
|
end;
|
|
tw := CalcTickWidth(x, j);
|
|
Result.a.X := Min(Result.a.X, GraphToAxisX(x - tw)); // axis units
|
|
// Result.a.X := Min(Result.a.X, x - tw);
|
|
j := Count;
|
|
x := NaN;
|
|
While IsNaN(x) and (j > 0) do begin
|
|
dec(j);
|
|
x := GetGraphPointX(j);
|
|
end;
|
|
tw := CalcTickWidth(x, j);
|
|
Result.b.X := Max(Result.b.X, AxisToGraphX(x + tw));
|
|
// Result.b.X := Max(Result.b.X, x + tw);
|
|
end;
|
|
|
|
function TOpenHighLowCloseSeries.GetBrush(AIndex: TOHLCBrushKind): TOHLCBrush;
|
|
begin
|
|
Result := FBrush[AIndex];
|
|
end;
|
|
|
|
procedure TOpenHighLowCloseSeries.GetLegendItems(AItems: TChartLegendItems);
|
|
begin
|
|
AItems.Add(TLegendItemOHLCLine.Create(Self, LegendTextSingle));
|
|
end;
|
|
|
|
function TOpenHighLowCloseSeries.GetNearestPoint(const AParams: TNearestPointParams;
|
|
out AResults: TNearestPointResults): Boolean;
|
|
var
|
|
i: Integer;
|
|
graphClickPt, p: TDoublePoint;
|
|
pImg: TPoint;
|
|
x, yopen, yhigh, ylow, yclose, tw: Double;
|
|
xImg, dist: Integer;
|
|
R: TDoubleRect;
|
|
begin
|
|
Result := inherited;
|
|
|
|
if Result then begin
|
|
if (nptPoint in AParams.FTargets) and (nptPoint in ToolTargets) then
|
|
exit;
|
|
if (nptYList in AParams.FTargets) and (nptYList in ToolTargets) then
|
|
exit;
|
|
end;
|
|
if not ((nptCustom in AParams.FTargets) and (nptCustom in ToolTargets))
|
|
then
|
|
exit;
|
|
|
|
graphClickPt := ParentChart.ImageToGraph(AParams.FPoint);
|
|
pImg := AParams.FPoint;
|
|
if IsRotated then begin
|
|
// Exchange(pImg.X, pImg.Y);
|
|
Exchange(graphclickpt.X, graphclickpt.Y);
|
|
pImg := ParentChart.GraphToImage(graphClickPt);
|
|
end;
|
|
|
|
// Iterate through all points of the series
|
|
for i := 0 to Count - 1 do begin
|
|
x := GetGraphPointX(i);
|
|
yopen := GetGraphPointY(i, YIndexOpen);
|
|
yhigh := GetGraphPointY(i, YIndexHigh);
|
|
ylow := GetGraphPointY(i, YIndexLow);
|
|
yclose := GetGraphPointY(i, YIndexClose);
|
|
tw := CalcTickWidth(x, i);
|
|
|
|
dist := MaxInt;
|
|
|
|
// click on vertical line
|
|
if InRange(graphClickPt.Y, ylow, yhigh) then begin
|
|
xImg := ParentChart.XGraphToImage(x);
|
|
dist := sqr(pImg.X - xImg);
|
|
AResults.FYIndex := -1;
|
|
end;
|
|
|
|
// click on candle box
|
|
if FMode = mCandlestick then begin
|
|
R.a := DoublePoint(x - tw, Min(yopen, yclose));
|
|
R.b := DoublePoint(x + tw, Max(yopen, yclose));
|
|
if InRange(graphClickPt.X, R.a.x, R.b.x) and InRange(graphClickPt.Y, R.a.Y, R.b.Y) then
|
|
begin
|
|
dist := 0;
|
|
AResults.FYIndex := -1;
|
|
end;
|
|
end;
|
|
|
|
// Sufficiently close?
|
|
if dist < AResults.FDist then begin
|
|
AResults.FDist := dist;
|
|
AResults.FIndex := i;
|
|
p := DoublePoint(x, yclose); // "Close" value
|
|
AResults.FValue := p;
|
|
if IsRotated then Exchange(p.X, p.Y);
|
|
AResults.FImg := ParentChart.GraphToImage(p);
|
|
if dist = 0 then break;
|
|
end;
|
|
end;
|
|
Result := AResults.FIndex > -1;
|
|
end;
|
|
|
|
function TOpenHighLowCloseSeries.GetPen(AIndex: TOHLCPenKind): TOHLCPen;
|
|
begin
|
|
Result := FPen[AIndex];
|
|
end;
|
|
|
|
function TOpenHighLowCloseSeries.GetSeriesColor: TColor;
|
|
begin
|
|
Result := LinePen.Color;
|
|
end;
|
|
|
|
class procedure TOpenHighLowCloseSeries.GetXYCountNeeded(out AXCount, AYCount: Cardinal);
|
|
begin
|
|
AXCount := 0;
|
|
AYCount := 4;
|
|
end;
|
|
|
|
procedure TOpenHighLowCloseSeries.SetBrush(AIndex: TOHLCBrushKind; AValue: TOHLCBrush);
|
|
begin
|
|
if GetBrush(AIndex) = AValue then exit;
|
|
FBrush[AIndex].Assign(AValue);
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TOpenHighLowCloseSeries.SetPen(AIndex: TOHLCPenKind; AValue: TOHLCPen);
|
|
begin
|
|
if GetPen(AIndex) = AValue then exit;
|
|
FPen[AIndex].Assign(AValue);
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TOpenHighLowCloseSeries.SetOHLCMode(AValue: TOHLCMode);
|
|
begin
|
|
if FMode = AValue then exit;
|
|
FMode := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TOpenHighLowCloseSeries.SetTickWidth(AValue: Integer);
|
|
begin
|
|
if FTickWidth = AValue then exit;
|
|
FTickWidth := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TOpenHighLowCloseSeries.SetTickWidthStyle(AValue: TTickWidthStyle);
|
|
begin
|
|
if FTickWidthStyle = AValue then exit;
|
|
FTickWidthStyle := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TOpenHighLowCloseSeries.SetYIndexClose(AValue: Integer);
|
|
begin
|
|
if FYIndexClose = AValue then exit;
|
|
FYIndexClose := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TOpenHighLowCloseSeries.SetYIndexHigh(AValue: Integer);
|
|
begin
|
|
if FYIndexHigh = AValue then exit;
|
|
FYIndexHigh := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TOpenHighLowCloseSeries.SetYIndexLow(AValue: Integer);
|
|
begin
|
|
if FYIndexLow = AValue then exit;
|
|
FYIndexLow := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TOpenHighLowCloseSeries.SetYIndexOpen(AValue: Integer);
|
|
begin
|
|
if FYIndexOpen = AValue then exit;
|
|
FYIndexOpen := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
function TOpenHighLowCloseSeries.SkipMissingValues(AIndex: Integer): Boolean;
|
|
begin
|
|
Result := IsNaN(Source[AIndex]^.Point);
|
|
if not Result then
|
|
Result := HasMissingYValue(AIndex, 4);
|
|
end;
|
|
|
|
function TOpenHighLowCloseSeries.ToolTargetDistance(
|
|
const AParams: TNearestPointParams; AGraphPt: TDoublePoint;
|
|
APointIdx, AXIdx, AYIdx: Integer): Integer;
|
|
|
|
// All in image coordinates transformed to have a horizontal x axis
|
|
function DistanceToLine(Pt: TPoint; x1, x2, y: Integer): Integer;
|
|
begin
|
|
if InRange(Pt.X, x1, x2) then // FDistFunc does not calculate sqrt
|
|
Result := sqr(Pt.Y - y)
|
|
else
|
|
Result := Min(
|
|
AParams.FDistFunc(Pt, Point(x1, y)),
|
|
AParams.FDistFunc(Pt, Point(x2, y))
|
|
);
|
|
end;
|
|
|
|
var
|
|
x1, x2: Integer;
|
|
w: Double;
|
|
p, clickPt: TPoint;
|
|
gp: TDoublePoint;
|
|
begin
|
|
Unused(AXIdx);
|
|
|
|
// Convert the "clicked" and "test" point to non-rotated axes
|
|
if IsRotated then begin
|
|
gp := ParentChart.ImageToGraph(AParams.FPoint);
|
|
Exchange(gp.X, gp.Y);
|
|
clickPt := ParentChart.GraphToImage(gp);
|
|
Exchange(AGraphPt.X, AGraphPt.Y);
|
|
end else
|
|
clickPt := AParams.FPoint;
|
|
|
|
w := CalcTickWidth(AGraphPt.X, APointIdx);
|
|
x1 := ParentChart.XGraphToImage(AGraphPt.X - w);
|
|
x2 := ParentChart.XGraphToImage(AGraphPt.X + w);
|
|
p := ParentChart.GraphToImage(AGraphPt);
|
|
|
|
case FMode of
|
|
mOHLC:
|
|
with ParentChart do
|
|
if (AYIdx = YIndexOpen) then
|
|
Result := DistanceToLine(clickPt, x1, p.x, p.y)
|
|
else if (AYIdx = YIndexClose) then
|
|
Result := DistanceToLine(clickPt, p.x, x2, p.y)
|
|
else if (AYIdx = YIndexHigh) or (AYIdx = YIndexLow) then
|
|
Result := AParams.FDistFunc(clickPt, p)
|
|
else
|
|
raise Exception.Create('TOpenHighLowCloseSeries.ToolTargetDistance: Illegal YIndex.');
|
|
mCandleStick:
|
|
with ParentChart do
|
|
if (AYIdx = YIndexOpen) or (AYIdx = YIndexClose) then
|
|
Result := DistanceToLine(clickPt, x1, x2, p.y)
|
|
else if (AYIdx = YIndexHigh) or (AYIdx = YIndexLow) then
|
|
Result := AParams.FDistFunc(clickPt, p)
|
|
else
|
|
raise Exception.Create('TOpenHighLowCloseSeries.ToolTargetDistance: Illegal YIndex.');
|
|
end;
|
|
end;
|
|
|
|
procedure TOpenHighLowCloseSeries.UpdateLabelDirectionReferenceLevel(
|
|
AIndex, AYIndex: Integer; var ALevel: Double);
|
|
var
|
|
item: PChartDataItem;
|
|
begin
|
|
if AYIndex = FYIndexLow then
|
|
ALevel := +Infinity
|
|
else if AYIndex = FYIndexHigh then
|
|
ALevel := -Infinity
|
|
else begin
|
|
item := Source.Item[AIndex];
|
|
ALevel := (AxisToGraphY(item^.GetY(FYIndexLow)) + AxisToGraphY(item^.GetY(FYIndexHigh)))*0.5;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TFieldSeries }
|
|
|
|
constructor TFieldSeries.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
ToolTargets := [nptPoint, nptXList, nptYList, nptCustom];
|
|
FArrow := TChartArrow.Create(ParentChart);
|
|
FArrow.Length := 20;
|
|
FArrow.Width := 10;
|
|
FArrow.Visible := true;
|
|
FPen := TPen.Create;
|
|
FPen.OnChange := @StyleChanged;
|
|
end;
|
|
|
|
destructor TFieldSeries.Destroy;
|
|
begin
|
|
FreeAndNil(FArrow);
|
|
FreeAndNil(FPen);
|
|
inherited;
|
|
end;
|
|
|
|
function TFieldSeries.AddVector(AX, AY, AVectorX, AVectorY: Double;
|
|
AXLabel: String = ''; AColor: TColor = clTAColor): Integer;
|
|
begin
|
|
Result := AddXY(AX, AY, AXLabel, AColor);
|
|
SetVector(Result, DoublePoint(AVectorX, AVectorY));
|
|
end;
|
|
|
|
procedure TFieldSeries.AfterAdd;
|
|
begin
|
|
inherited;
|
|
FArrow.SetOwner(ParentChart);
|
|
end;
|
|
|
|
procedure TFieldSeries.Assign(ASource: TPersistent);
|
|
begin
|
|
if ASource is TFieldSeries then
|
|
with TFieldSeries(ASource) do begin
|
|
Self.FArrow.Assign(FArrow);
|
|
Self.FPen := FPen;
|
|
end;
|
|
inherited Assign(ASource);
|
|
end;
|
|
|
|
procedure TFieldSeries.Draw(ADrawer: IChartDrawer);
|
|
var
|
|
ext: TDoubleRect;
|
|
i: Integer;
|
|
p1, p2: TDoublePoint;
|
|
lPen: TPen;
|
|
begin
|
|
if IsEmpty or (not Active) then exit;
|
|
with Extent do begin
|
|
ext.a := AxisToGraph(a);
|
|
ext.b := AxisToGraph(b);
|
|
end;
|
|
NormalizeRect(ext);
|
|
// Do not draw anything if the series extent does not intersect CurrentExtent.
|
|
if not RectIntersectsRect(ext, ParentChart.CurrentExtent) then exit;
|
|
|
|
lPen := TPen.Create;
|
|
try
|
|
lPen.Assign(FPen);
|
|
if (AxisIndexX < 0) and (AxisIndexY < 0) then begin
|
|
// Optimization: bypass transformations in the default case
|
|
for i := 0 to Count - 1 do
|
|
if GetVectorPoints(i, p1, p2) then begin
|
|
lPen.Color := GetColor(i);
|
|
DrawVector(ADrawer, p1, p2, lPen);
|
|
end;
|
|
end else begin
|
|
for i := 0 to Count - 1 do
|
|
if GetVectorPoints(i, p1, p2) then begin
|
|
p1 := AxisToGraph(p1);
|
|
p2 := AxisToGraph(p2);
|
|
lPen.Color := GetColor(i);
|
|
DrawVector(ADrawer, p1, p2, lPen);
|
|
end;
|
|
end;
|
|
DrawLabels(ADrawer, 0);
|
|
finally
|
|
lPen.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TFieldSeries.DrawVector(ADrawer: IChartDrawer;
|
|
AStartPt, AEndPt: TDoublePoint; APen: TPen);
|
|
var
|
|
p1, p2: TPoint;
|
|
arr: TChartArrow;
|
|
len: Double;
|
|
begin
|
|
p1 := ParentChart.GraphToImage(AStartPt);
|
|
p2 := ParentChart.GraphToImage(AEndPt);
|
|
ADrawer.Pen := APen;
|
|
if APen.Color = clDefault then
|
|
ADrawer.SetPenColor(FChart.GetDefaultColor(dctFont))
|
|
else
|
|
ADrawer.SetPenColor(APen.Color);
|
|
ADrawer.Line(p1.x, p1.y, p2.x, p2.y);
|
|
if FArrow.Visible then begin
|
|
len := sqrt(sqr(p2.x - p1.x) + sqr(p2.y - p1.y)) * 0.01 / ADrawer.Scale(1);
|
|
// Be aware that the drawer scales pixels. But the arrow length here is
|
|
// already at the correct size!
|
|
arr := TChartArrow.Create(nil);
|
|
arr.Assign(FArrow);
|
|
arr.SetOwner(nil); // avoid repainting due to next commands
|
|
arr.BaseLength := round(FArrow.BaseLength * len);
|
|
arr.Length := round(FArrow.Length * len);
|
|
arr.Width := round(FArrow.Width * len);
|
|
arr.Draw(ADrawer, p2, arctan2(p2.y-p1.y, p2.x-p1.x), APen);
|
|
arr.Free;
|
|
end;
|
|
end;
|
|
|
|
function TFieldSeries.Extent: TDoubleRect;
|
|
var
|
|
p1, p2: TDoublePoint;
|
|
i: Integer;
|
|
begin
|
|
Result := Source.Extent;
|
|
for i := 0 to Source.Count - 1 do
|
|
if GetVectorPoints(i, p1, p2) then begin
|
|
UpdateMinMax(p1.X, Result.a.X, Result.b.X);
|
|
UpdateMinMax(p2.X, Result.a.X, Result.b.X);
|
|
UpdateMinMax(p1.Y, Result.a.Y, Result.b.Y);
|
|
UpdateMinMax(p2.Y, Result.a.Y, Result.b.Y);
|
|
end;
|
|
end;
|
|
|
|
function TFieldSeries.GetColor(AIndex: Integer): TColor;
|
|
begin
|
|
with Source.Item[AIndex]^ do
|
|
Result := TColor(Math.IfThen(Color = clTAColor, FPen.Color, Color));
|
|
end;
|
|
|
|
procedure TFieldSeries.GetLegendItems(AItems: TChartLegendItems);
|
|
begin
|
|
AItems.Add(TLegendItemField.Create(FPen, FArrow, LegendTextSingle));
|
|
end;
|
|
|
|
function TFieldSeries.GetNearestPoint(const AParams: TNearestPointParams;
|
|
out AResults: TNearestPointResults): Boolean;
|
|
var
|
|
dist, d, i, xidx, yidx: Integer;
|
|
pt1, pt2: TPoint;
|
|
sp1, sp2: TDoublePoint;
|
|
R: TRect;
|
|
img: TPoint;
|
|
begin
|
|
AResults.FDist := Sqr(AParams.FRadius) + 1;
|
|
AResults.FIndex := -1;
|
|
AResults.FXIndex := 0;
|
|
AResults.FYIndex := 0;
|
|
if IsEmpty then exit(false);
|
|
|
|
for i := 0 to Count - 1 do begin
|
|
if not GetVectorPoints(i, sp1, sp2) then
|
|
Continue;
|
|
// End points of the vector arrow
|
|
pt1 := ParentChart.GraphToImage(AxisToGraph(sp1));
|
|
pt2 := ParentChart.GraphToImage(AxisToGraph(sp2));
|
|
// At first we check if the point is in the rect spanned by the vector.
|
|
R := Rect(pt1.x, pt1.y, pt2.x, pt2.y);
|
|
NormalizeRect(R);
|
|
R.TopLeft := R.TopLeft - Point(AParams.FRadius, AParams.FRadius);
|
|
R.BottomRight := R.BottomRight + Point(AParams.FRadius, AParams.FRadius);
|
|
if not IsPointInRect(AParams.FPoint, R) then continue;
|
|
|
|
dist := MaxInt;
|
|
xidx := -1;
|
|
yidx := -1;
|
|
if (nptPoint in AParams.FTargets) and (nptPoint in ToolTargets) then begin
|
|
dist := AParams.FDistFunc(AParams.FPoint, pt1);
|
|
xidx := 0;
|
|
yidx := 0;
|
|
img := pt1;
|
|
end;
|
|
|
|
if (AParams.FTargets * [nptXList, nptYList] <> []) and
|
|
(ToolTargets * [nptXList, nptYList] <> [])
|
|
then begin
|
|
d := AParams.FDistFunc(AParams.FPoint, pt2);
|
|
if d < dist then begin
|
|
dist := d;
|
|
xidx := 1;
|
|
yidx := 1;
|
|
img := pt2;
|
|
end;
|
|
end;
|
|
// give priority to end points
|
|
if (dist > AResults.FDist) and
|
|
(nptCustom in AParams.FTargets) and
|
|
(nptCustom in ToolTargets)
|
|
then begin
|
|
d := PointLineDistSq(AParams.FPoint, pt1, pt2); // distance of point from line
|
|
if d < dist then begin
|
|
dist := d;
|
|
xidx := -1;
|
|
yidx := -1;
|
|
img := ProjToLine(AParams.FPoint, pt1, pt2);
|
|
end;
|
|
end;
|
|
if dist >= AResults.FDist then continue;
|
|
|
|
AResults.FDist := dist;
|
|
AResults.FIndex := i;
|
|
AResults.FXIndex := xidx;
|
|
AResults.FYIndex := yidx;
|
|
AResults.FImg := img;
|
|
AResults.FValue := Source[i]^.Point;
|
|
break;
|
|
end;
|
|
Result := AResults.FIndex >= 0;
|
|
end;
|
|
|
|
function TFieldSeries.GetVector(AIndex: Integer): TDoublePoint;
|
|
begin
|
|
with Source.Item[AIndex]^ do
|
|
case FCoordKind of
|
|
vckCenterDir: Result := DoublePoint(XList[0], YList[0]);
|
|
vckStartEnd: Result := DoublePoint(XList[0]-X, YList[0]-Y);
|
|
end;
|
|
end;
|
|
|
|
function TFieldSeries.GetVectorPoints(AIndex: Integer;
|
|
out AStartPt, AEndPt: TDoublePoint): Boolean;
|
|
var
|
|
dx, dy: Double;
|
|
begin
|
|
with Source.Item[AIndex]^ do begin
|
|
if isNaN(X) or IsNaN(Y) or IsNaN(XList[0]) or IsNaN(YList[0]) then
|
|
exit(false)
|
|
else begin
|
|
case FCoordKind of
|
|
vckCenterDir:
|
|
begin
|
|
dx := XList[0] * 0.5;
|
|
dy := YList[0] * 0.5;
|
|
AStartPt := DoublePoint(X - dx, Y - dy);
|
|
AEndPt := DoublePoint(X + dx, Y + dy);
|
|
end;
|
|
vckStartEnd:
|
|
begin
|
|
AStartPt := DoublePoint(X, Y);
|
|
AEndPt := DoublePoint(XList[0], YList[0]);
|
|
end;
|
|
end;
|
|
Result := true;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
class procedure TFieldSeries.GetXYCountNeeded(out AXCount, AYCount: Cardinal);
|
|
begin
|
|
AXCount := 2;
|
|
AYCount := 2;
|
|
end;
|
|
|
|
procedure TFieldSeries.MovePointEx(var AIndex: Integer;
|
|
AXIndex, AYIndex: Integer; const ANewPos: TDoublePoint);
|
|
var
|
|
np, p: TDoublePoint;
|
|
begin
|
|
Unused(AXIndex);
|
|
|
|
if not InRange(AIndex, 0, Count - 1) then
|
|
exit;
|
|
|
|
p := DoublePoint(XValue[AIndex], YValue[AIndex]);
|
|
np := GraphToAxis(ANewPos);
|
|
|
|
ParentChart.DisableRedrawing;
|
|
try
|
|
case AYIndex of
|
|
-1: begin
|
|
ListSource.SetXValue(AIndex, np.X);
|
|
ListSource.SetYValue(AIndex, np.Y);
|
|
end;
|
|
0: SetVector(AIndex, (p - np) * 2);
|
|
1: SetVector(AIndex, (np - p) * 2);
|
|
end;
|
|
finally
|
|
ParentChart.EnableRedrawing;
|
|
UpdateParentChart;
|
|
end;
|
|
end;
|
|
|
|
procedure TFieldSeries.NormalizeVectors(ALength: Double);
|
|
var
|
|
factor, maxlen, len: Double;
|
|
i: Integer;
|
|
v: TDoublePoint;
|
|
begin
|
|
maxLen := 0;
|
|
for i := 0 to Count - 1 do begin
|
|
v := GetVector(i);
|
|
len := v.x * v.x + v.y * v.y;
|
|
len := sqrt(v.x*v.x + v.y*v.y);
|
|
// len := sqrt(sqr(v.x) + sqr(v.y));
|
|
maxLen := Max(len, maxlen);
|
|
end;
|
|
if maxLen = 0 then
|
|
exit;
|
|
factor := ALength / maxLen;
|
|
for i := 0 to Count - 1 do begin
|
|
v := GetVector(i);
|
|
SetVector(i, v*factor);
|
|
end;
|
|
end;
|
|
|
|
procedure TFieldSeries.SetArrow(AValue: TChartArrow);
|
|
begin
|
|
FArrow.Assign(AValue);
|
|
UpdateParentChart;
|
|
end;
|
|
|
|
procedure TFieldSeries.SetCoordKind(AValue: TVectorCoordkind);
|
|
begin
|
|
if AValue <> FCoordKind then
|
|
begin
|
|
FCoordKind := AValue;
|
|
UpdateParentChart;
|
|
end;
|
|
end;
|
|
|
|
procedure TFieldSeries.SetPen(AValue: TPen);
|
|
begin
|
|
FPen.Assign(AValue);
|
|
end;
|
|
|
|
procedure TFieldSeries.SetVector(AIndex: Integer; const AValue: TDoublePoint);
|
|
begin
|
|
with ListSource.Item[AIndex]^ do begin
|
|
case FCoordKind of
|
|
vckCenterDir:
|
|
begin
|
|
XList[0] := AValue.X;
|
|
YList[0] := AValue.Y;
|
|
end;
|
|
vckStartEnd:
|
|
begin
|
|
XList[0] := X + AValue.X;
|
|
YList[0] := Y + AValue.Y;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
initialization
|
|
RegisterSeriesClass(TBubbleSeries, @rsBubbleSeries);
|
|
RegisterSeriesClass(TBoxAndWhiskerSeries, @rsBoxAndWhiskerSeries);
|
|
RegisterSeriesClass(TOpenHighLowCloseSeries, @rsOpenHighLowCloseSeries);
|
|
RegisterSeriesClass(TFieldSeries, @rsFieldSeries);
|
|
|
|
end.
|