pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

fpspreadsheet: Add the ohlcseries of Laz/main as TStockseries in unit fpsstockseries for supporting the HLC series of Excel and Calc.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9075 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-12-07 22:53:48 +00:00
parent e8a24a0cf0
commit 9914514709
6 changed files with 839 additions and 62 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
components/fpspreadsheet/examples/visual/fpschart/fpschartlink/main.lfm
View File

@ -2,17 +2,17 @@ object Form1: TForm1
Left = 314
Height = 527
Top = 130
Width = 1101
Width = 1351
Caption = 'Form1'
ClientHeight = 527
ClientWidth = 1101
ClientWidth = 1351
LCLVersion = '3.99.0.0'
OnCreate = FormCreate
object sWorksheetGrid1: TsWorksheetGrid
Left = 0
Height = 489
Top = 38
Width = 402
Width = 563
FrozenCols = 0
FrozenRows = 0
PageBreakPen.Color = clBlue
@ -28,16 +28,16 @@ object Form1: TForm1
TabOrder = 0
end
object Splitter1: TSplitter
Left = 402
Left = 563
Height = 489
Top = 38
Width = 5
end
object Chart1: TChart
Left = 407
Left = 568
Height = 489
Top = 38
Width = 694
Width = 783
AxisList = <
item
Marks.LabelBrush.Style = bsClear
@ -60,12 +60,12 @@ object Form1: TForm1
Left = 0
Height = 38
Top = 0
Width = 1101
Width = 1351
Align = alTop
AutoSize = True
BevelOuter = bvNone
ClientHeight = 38
ClientWidth = 1101
ClientWidth = 1351
TabOrder = 3
object Label1: TLabel
AnchorSideLeft.Control = Panel1
@ -87,9 +87,10 @@ object Form1: TForm1
Left = 63
Height = 23
Top = 8
Width = 911
Width = 1161
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
DropDownCount = 32
ItemHeight = 15
Items.Strings = (
'../../../other/chart/area.ods'
@ -111,7 +112,7 @@ object Form1: TForm1
AnchorSideTop.Control = Panel1
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Button2
Left = 980
Left = 1230
Height = 25
Top = 7
Width = 35
@ -127,7 +128,7 @@ object Form1: TForm1
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 1021
Left = 1271
Height = 25
Top = 7
Width = 74

6
components/fpspreadsheet/laz_fpspreadsheet_visual.lpk
View File

@ -21,7 +21,7 @@
It provides graphical components like a grid and chart."/>
<License Value="LGPL with static linking exception. This is the same license as is used in the LCL (Lazarus Component Library)."/>
<Version Major="1" Minor="17"/>
<Files Count="5">
<Files Count="6">
<Item1>
<Filename Value="source\visual\fpspreadsheetchart.pas"/>
<UnitName Value="fpspreadsheetchart"/>
@ -42,6 +42,10 @@ It provides graphical components like a grid and chart."/>
<Filename Value="source\visual\fpsactions.pas"/>
<UnitName Value="fpsActions"/>
</Item5>
<Item6>
<Filename Value="source\visual\fpsstockseries.pas"/>
<UnitName Value="fpsstockseries"/>
</Item6>
</Files>
<CompatibilityMode Value="True"/>
<RequiredPkgs Count="4">

47
components/fpspreadsheet/source/common/fpschart.pas
View File

@ -266,6 +266,7 @@ type
public
constructor Create(AChart: TsChart);
destructor Destroy; override;
function OtherAxis: TsChartAxis;
property AutomaticMax: Boolean read FAutomaticMax write FAutomaticMax;
property AutomaticMin: Boolean read FAutomaticMin write FAutomaticMin;
property AutomaticMajorInterval: Boolean read FAutomaticMajorInterval write FAutomaticMajorInterval;
@ -351,11 +352,11 @@ type
FYAxis: TsChartAxisLink;
FTitleAddr: TsChartCellAddr;
FLabelFormat: String;
FLine: TsChartLine;
FFill: TsChartFill;
FDataLabels: TsChartDataLabels;
FDataPointStyles: TsChartDataPointStyleList;
protected
FLine: TsChartLine;
FFill: TsChartFill;
function GetChartType: TsChartType; virtual;
public
constructor Create(AChart: TsChart); virtual;
@ -551,7 +552,9 @@ type
FHighRange: TsChartRange;
FLowRange: TsChartRange; // close = normal y range
FCandleStickDownFill: TsChartFill;
FRangeLine: TsChartLine;
FCandleStickDownBorder: TsChartLine;
FCandleStickUpBorder: TsChartLine;
// fill is CandleStickUpFill, line is RangeLine
public
constructor Create(AChart: TsChart); override;
destructor Destroy; override;
@ -560,8 +563,11 @@ type
procedure SetLowRange (ASheet1: String; ARow1, ACol1: Cardinal; ASheet2: String; ARow2, ACol2: Cardinal);
procedure SetCloseRange(ASheet1: String; ARow1, ACol1: Cardinal; ASheet2: String; ARow2, ACol2: Cardinal);
property CandleStick: Boolean read FCandleStick write FCandleStick;
property CandleStickDownFill: TsChartfill read FCandleStickDownFill write FCandleStickDownFill;
property RangeLine: TsChartLine read FRangeLine write FRangeLine;
property CandleStickDownFill: TsChartFill read FCandleStickDownFill write FCandleStickDownFill;
property CandleStickUpFill: TsChartFill read FFill write FFill;
property CandleStickDownBorder: TsChartLine read FCandleStickDownBorder write FCandleStickDownBorder;
property CandleStickUpBorder: TsChartLine read FCandleStickUpBorder write FCandleStickUpBorder;
property RangeLine: TsChartLine read FLine write FLine;
property OpenRange: TsChartRange read FOpenRange;
property HighRange: TsChartRange read FHighRange;
property LowRange: TsChartRange read FLowRange;
@ -1230,6 +1236,21 @@ begin
inherited;
end;
{@@ ----------------------------------------------------------------------------
Returns the other axis in the same direction, i.e. when the axis is the
primary x axis the function returns the secondary x axis, etc.
-------------------------------------------------------------------------------}
function TsChartAxis.OtherAxis: TsChartAxis;
begin
if Chart.XAxis = self then
Result := Chart.X2Axis
else if Chart.X2Axis = self then
Result := Chart.XAxis
else if Chart.YAxis = self then
Result := Chart.Y2Axis
else if Chart.Y2Axis = self then
Result := Chart.YAxis;
end;
{ TsChartLegend }
@ -1772,18 +1793,24 @@ begin
FHighRange := TsChartRange.Create(AChart);
FLowRange := TsChartRange.Create(AChart);
// FFill is CandleStickUp
// FFill is CandleStickUp, FLine is RangeLine
FCandleStickDownFill := TsChartFill.Create;
FCandleStickDownFill.Style := cfsSolid;
FCandleStickDownFill.Color := scBlack;
FRangeLine := TsChartLine.Create;
FRangeLine.Style := clsSolid;
FRangeLine.Color := scBlack;
FCandleStickDownBorder := TsChartLine.Create;
FCandleStickDownBorder.Style := clsSolid;
FCandleStickDownBorder.Color := scBlack;
FCandleStickUpBorder := TsChartLine.Create;
FCandleStickUpBorder.Style := clsSolid;
FCandleStickUpBorder.Color := scBlack;
FLine.Style := clsSolid;
FLine.Color := scBlack;
end;
destructor TsStockSeries.Destroy;
begin
FRangeLine.Free;
FCandleStickUpBorder.Free;
FCandleStickDownBorder.Free;
FCandleStickDownFill.Free;
FOpenRange.Free;
FHighRange.Free;

19
components/fpspreadsheet/source/common/fpsopendocumentchart.pas
View File

@ -1327,15 +1327,16 @@ begin
ReadChartCellAddr(ANode, 'chart:label-cell-address', series.TitleAddr);
if (series is TsStockSeries) then
begin
// The file contains the range in the order Open-Low-High-Close
if FStockSeries.OpenRange.IsEmpty and FStockSeries.CandleStick then
ReadChartCellRange(ANode, 'chart:values-cell-range-address', FStockSeries.OpenRange)
else
if FStockSeries.HighRange.IsEmpty then
ReadChartCellRange(ANode, 'chart:values-cell-range-address', FStockSeries.HighRange)
else
if FStockSeries.LowRange.IsEmpty then
ReadChartCellRange(ANode, 'chart:values-cell-range-address', FStockSeries.LowRange)
else
if FStockSeries.HighRange.IsEmpty then
ReadChartCellRange(ANode, 'chart:values-cell-range-address', FStockSeries.HighRange)
else
if FStockSeries.CloseRange.IsEmpty then
ReadChartCellRange(ANode, 'chart:values-cell-range-address', FStockSeries.CloseRange);
end
@ -1563,11 +1564,15 @@ begin
if nodeName = 'style:graphic-properties' then
begin
if ANodeName = 'chart:stock-gain-marker' then
GetChartFillProps(AStyleNode, AChart, ASeries.Fill)
else
begin
GetChartFillProps(AStyleNode, AChart, ASeries.CandleStickUpFill);
GetChartLineProps(AStyleNode, AChart, ASeries.CandleStickUpBorder);
end else
if ANodeName = 'chart:stock-loss-marker' then
GetChartFillProps(AStyleNode, AChart, ASeries.CandleStickDownFill)
else
begin
GetChartFillProps(AStyleNode, AChart, ASeries.CandleStickDownFill);
GetChartLineProps(AStyleNode, AChart, ASeries.CandleStickDownBorder);
end else
if ANodeName = 'chart:stock-range-line' then
GetChartLineProps(AStyleNode, AChart, ASeries.RangeLine);
end;

70
components/fpspreadsheet/source/visual/fpspreadsheetchart.pas
View File

@ -27,7 +27,7 @@ uses
TASeries, TARadialSeries, TAFitUtils, TAFuncSeries, TAMultiSeries,
TATransformations, TAChartAxisUtils, TAChartAxis, TAStyles, TATools, TAGraph,
// FPSpreadsheet
fpsTypes, fpSpreadsheet, fpsUtils, fpsNumFormat, fpsChart,
fpsTypes, fpSpreadsheet, fpsUtils, fpsNumFormat, fpsChart, fpsStockSeries,
// FPSpreadsheet Visual
fpSpreadsheetCtrls, fpSpreadsheetGrid, fpsVisualUtils;
@ -158,10 +158,10 @@ type
procedure UpdateBarSeries(AWorkbookSeries: TsBarSeries; AChartSeries: TBarSeries);
procedure UpdateBubbleSeries(AWorkbookSeries: TsBubbleSeries; AChartSeries: TBubbleSeries);
procedure UpdateCustomLineSeries(AWorkbookSeries: TsCustomLineSeries; AChartSeries: TLineSeries);
procedure UpdateOHLCSeries(AWorkbookSeries: TsStockSeries; AChartSeries: TOpenHighLowCloseSeries);
procedure UpdatePieSeries(AWorkbookSeries: TsPieSeries; AChartSeries: TPieSeries);
procedure UpdatePolarSeries(AWorkbookSeries: TsRadarSeries; AChartSeries: TPolarSeries);
procedure UpdateScatterSeries(AWorkbookSeries: TsScatterSeries; AChartSeries: TLineSeries);
procedure UpdateStockSeries(AWorkbookSeries: TsStockSeries; AChartSeries: TStockSeries);
public
constructor Create(AOwner: TComponent); override;
@ -468,7 +468,7 @@ var
begin
for i := 0 to XCount-1 do
begin
if FRanges[rngX, i] <> nil then
if (FRanges[rngX, i] <> nil) then
begin
GetXYItem(rngX, i, AIndex, value, tmpLabel);
if FIntegerX then
@ -1100,7 +1100,7 @@ begin
Result := TPieSeries.Create(FChart);
ctStock:
begin
Result := TOpenHighLowCloseSeries.Create(FChart);
Result := TStockSeries.Create(FChart);
src.YCount := 4;
src.IntegerX := true;
src.SetXRange(0, ASeries.Chart.XAxis.CategoryRange);
@ -1114,7 +1114,7 @@ begin
end;
// Get x and y ranges (except for OHLC which already has been handled)
if not (Result is TOpenHighLowCloseSeries) then
if not (Result is TStockSeries) then
begin
if not ASeries.XRange.IsEmpty then
src.SetXRange(0, ASeries.XRange);
@ -1201,7 +1201,7 @@ begin
ctScatter:
UpdateScatterSeries(TsScatterSeries(ASeries), TLineSeries(ser));
ctStock:
UpdateOHLCSeries(TsStockSeries(ASeries), TOpenHighLowCloseSeries(ser));
UpdateStockSeries(TsStockSeries(ASeries), TStockSeries(ser));
ctPie, ctRing:
UpdatePieSeries(TsPieSeries(ASeries), TPieSeries(ser));
ctRadar, ctFilledRadar:
@ -1525,18 +1525,19 @@ function TsWorkbookChartLink.GetAxisTransform(AChartAxis: TChartAxis;
var
T: TAxisTransform;
begin
for T in AChartAxis.Transformations.List do
if T is AClass then
begin
Result := T;
exit;
end;
if AChartAxis.Transformations <> nil then
for T in AChartAxis.Transformations.List do
if T is AClass then
begin
Result := T;
exit;
end;
Result := nil;
end;
function TsWorkbookChartLink.GetLogAxisTransform(AChartAxis: TChartAxis): TLogarithmAxisTransform;
begin
Result := TLogarithmAxisTransform(GetAxisTransform(AChartAxis, TLogarithmAxisTransform));
Result := TLogarithmAxisTransform(GetAxisTransform(AChartAxis, TLogarithmAxisTransform))
end;
function TsWorkbookChartLink.GetWorkbookChart: TsChart;
@ -1759,7 +1760,7 @@ begin
// Usually not needed, but axis handling is simplified when there is
// an axis transformations object at each axis with all transforms prepared.
if axis.Transformations = nil then
if (axis.Transformations = nil) then
begin
axis.Transformations := TChartAxisTransformations.Create(FChart);
@ -1772,8 +1773,7 @@ begin
// Autoscale transformation for primary and secondary axes
T := TAutoScaleAxisTransform.Create(axis.Transformations);
T.Transformations := axis.Transformations;
if AWorkbookAxis.Logarithmic or (AWorkbookAxis.Chart.GetChartType in [ctRadar, ctFilledRadar]) then
T.Enabled := false;
T.Enabled := AWorkbookAxis.Visible and AWorkbookAxis.OtherAxis.Visible;
end;
// Axis title
@ -1828,7 +1828,8 @@ begin
// Logarithmic
logTransf := GetLogAxisTransform(axis);
logTransf.Enabled := AWorkbookAxis.Logarithmic;
if logTransf <> nil then
logTransf.Enabled := AWorkbookAxis.Logarithmic;
if AWorkbookAxis.Logarithmic then
begin
axis.Intervals.Options := axis.Intervals.Options + [aipGraphCoords];
@ -2114,22 +2115,6 @@ begin
TCalculatedChartSource(AChartSeries.Source).Percentage := (AWorkbookSeries.Chart.StackMode = csmStackedPercentage);
end;
procedure TsWorkbookChartLink.UpdateOHLCSeries(AWorkbookSeries: TsStockSeries;
AChartSeries: TOpenHighLowCloseSeries);
begin
if AWorkbookSeries.CandleStick then
begin
AChartSeries.Mode := mCandleStick;
UpdateChartBrush(AWorkbookSeries.Chart, AWorkbookSeries.Fill, AChartSeries.CandleStickUpBrush);
UpdateChartBrush(AWorkbookseries.Chart, AWorkbookseries.CandleStickDownFill, AChartSeries.CandleStickDownBrush);
end else
begin
AChartSeries.Mode := mOHLC;
end;
UpdateChartPen(AWorkbookSeries.Chart, AWorkbookSeries.RangeLine, AChartSeries.LinePen);
UpdateChartPen(AWorkbookSeries.Chart, AWorkbookSeries.RangeLine, AChartSeries.DownLinePen);
end;
procedure TsWorkbookChartLink.UpdatePieSeries(AWorkbookSeries: TsPieSeries;
AChartSeries: TPieSeries);
begin
@ -2232,4 +2217,23 @@ begin
end;
end;
procedure TsWorkbookChartLink.UpdateStockSeries(AWorkbookSeries: TsStockSeries;
AChartSeries: TStockSeries);
begin
if AWorkbookSeries.CandleStick then
begin
AChartSeries.Mode := mCandleStick;
UpdateChartBrush(AWorkbookseries.Chart, AWorkbookseries.CandleStickDownFill, AChartSeries.CandleStickDownBrush);
UpdateChartBrush(AWorkbookSeries.Chart, AWorkbookSeries.CandleStickUpFill, AChartSeries.CandleStickUpBrush);
UpdateChartPen(AWorkbookSeries.Chart, AWorkbookSeries.CandleStickDownBorder, AChartSeries.CandleStickDownPen);
UpdateChartPen(AWorkbookSeries.Chart, AWorkbookSeries.CandleStickUpBorder, AChartSeries.CandleStickUpPen);
end else
begin
AChartSeries.Mode := mOHLC;
end;
UpdateChartPen(AWorkbookSeries.Chart, AWorkbookSeries.RangeLine, AChartSeries.LinePen);
UpdateChartPen(AWorkbookSeries.Chart, AWorkbookSeries.RangeLine, AChartSeries.DownLinePen);
AChartSeries.TickWidthStyle := twsPercentMin;
end;
end.

736
components/fpspreadsheet/source/visual/fpsstockseries.pas Normal file
View File

@ -0,0 +1,736 @@
unit fpsStockSeries;
{$mode objfpc}{$H+}
interface
uses
LCLVersion, Classes, SysUtils, Graphics, Math,
TAChartUtils, TAMath, TAGeometry, TADrawUtils, TALegend,
TACustomSource, TACustomSeries, TAMultiSeries;
type
{$IF LCL_FullVersion >= 3990000}
TStockSeries = class(TOpenHighLowCloseSeries);
{$ELSE}
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);
TStockSeries = 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;
{$ENDIF}
implementation
{$IF LCL_FullVersion < 3990000}
uses
FPCanvas;
type
TLegendItemOHLCLine = class(TLegendItemLine)
strict private
FMode: TOHLCMode;
FCandleStickUpColor: TColor;
FCandleStickDownColor: TColor;
public
constructor Create(ASeries: TStockSeries; const AText: String);
procedure Draw(ADrawer: IChartDrawer; const ARect: TRect); override;
end;
constructor TLegendItemOHLCLine.Create(ASeries: TStockSeries; 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;
{ 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;
{ TStockSeries }
function TStockSeries.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 TStockSeries.Assign(ASource: TPersistent);
var
bk: TOHLCBrushKind;
pk: TOHLCPenKind;
begin
if ASource is TStockSeries 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 TStockSeries.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 TStockSeries.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 TStockSeries.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 TStockSeries.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 DoRect(AX1, AY1, AX2, AY2: Double);
var
r: TRect;
begin
with ParentChart do begin
r.TopLeft := MaybeRotate(AX1, AY1);
r.BottomRight := MaybeRotate(AX2, AY2);
end;
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 TStockSeries.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 TStockSeries.GetBrush(AIndex: TOHLCBrushKind): TOHLCBrush;
begin
Result := FBrush[AIndex];
end;
procedure TStockSeries.GetLegendItems(AItems: TChartLegendItems);
begin
AItems.Add(TLegendItemOHLCLine.Create(Self, LegendTextSingle));
end;
function TStockSeries.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 TStockSeries.GetPen(AIndex: TOHLCPenKind): TOHLCPen;
begin
Result := FPen[AIndex];
end;
function TStockSeries.GetSeriesColor: TColor;
begin
Result := LinePen.Color;
end;
class procedure TStockSeries.GetXYCountNeeded(out AXCount, AYCount: Cardinal);
begin
AXCount := 0;
AYCount := 4;
end;
procedure TStockSeries.SetBrush(AIndex: TOHLCBrushKind; AValue: TOHLCBrush);
begin
if GetBrush(AIndex) = AValue then exit;
FBrush[AIndex].Assign(AValue);
UpdateParentChart;
end;
procedure TStockSeries.SetPen(AIndex: TOHLCPenKind; AValue: TOHLCPen);
begin
if GetPen(AIndex) = AValue then exit;
FPen[AIndex].Assign(AValue);
UpdateParentChart;
end;
procedure TStockSeries.SetOHLCMode(AValue: TOHLCMode);
begin
if FMode = AValue then exit;
FMode := AValue;
UpdateParentChart;
end;
procedure TStockSeries.SetTickWidth(AValue: Integer);
begin
if FTickWidth = AValue then exit;
FTickWidth := AValue;
UpdateParentChart;
end;
procedure TStockSeries.SetTickWidthStyle(AValue: TTickWidthStyle);
begin
if FTickWidthStyle = AValue then exit;
FTickWidthStyle := AValue;
UpdateParentChart;
end;
procedure TStockSeries.SetYIndexClose(AValue: Integer);
begin
if FYIndexClose = AValue then exit;
FYIndexClose := AValue;
UpdateParentChart;
end;
procedure TStockSeries.SetYIndexHigh(AValue: Integer);
begin
if FYIndexHigh = AValue then exit;
FYIndexHigh := AValue;
UpdateParentChart;
end;
procedure TStockSeries.SetYIndexLow(AValue: Integer);
begin
if FYIndexLow = AValue then exit;
FYIndexLow := AValue;
UpdateParentChart;
end;
procedure TStockSeries.SetYIndexOpen(AValue: Integer);
begin
if FYIndexOpen = AValue then exit;
FYIndexOpen := AValue;
UpdateParentChart;
end;
function TStockSeries.SkipMissingValues(AIndex: Integer): Boolean;
begin
Result := IsNaN(Source[AIndex]^.Point);
if not Result then
Result := HasMissingYValue(AIndex, 4);
end;
function TStockSeries.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 TStockSeries.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;
{$ENDIF}
end.