From 99145147098cc32d43aa28d6cc46a4e46d1ae06e Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 7 Dec 2023 22:53:48 +0000 Subject: [PATCH] fpspreadsheet: Add the ohlcseries of Laz/main as TStockseries in unit fpsstockseries for supporting the HLC series of Excel and Calc. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9075 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../visual/fpschart/fpschartlink/main.lfm | 23 +- .../laz_fpspreadsheet_visual.lpk | 6 +- .../fpspreadsheet/source/common/fpschart.pas | 47 +- .../source/common/fpsopendocumentchart.pas | 19 +- .../source/visual/fpspreadsheetchart.pas | 70 +- .../source/visual/fpsstockseries.pas | 736 ++++++++++++++++++ 6 files changed, 839 insertions(+), 62 deletions(-) create mode 100644 components/fpspreadsheet/source/visual/fpsstockseries.pas diff --git a/components/fpspreadsheet/examples/visual/fpschart/fpschartlink/main.lfm b/components/fpspreadsheet/examples/visual/fpschart/fpschartlink/main.lfm index d8523edd3..b8d2fb774 100644 --- a/components/fpspreadsheet/examples/visual/fpschart/fpschartlink/main.lfm +++ b/components/fpspreadsheet/examples/visual/fpschart/fpschartlink/main.lfm @@ -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 diff --git a/components/fpspreadsheet/laz_fpspreadsheet_visual.lpk b/components/fpspreadsheet/laz_fpspreadsheet_visual.lpk index 441aa73dd..7ea772452 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet_visual.lpk +++ b/components/fpspreadsheet/laz_fpspreadsheet_visual.lpk @@ -21,7 +21,7 @@ It provides graphical components like a grid and chart."/> - + @@ -42,6 +42,10 @@ It provides graphical components like a grid and chart."/> + + + + diff --git a/components/fpspreadsheet/source/common/fpschart.pas b/components/fpspreadsheet/source/common/fpschart.pas index 1b5dd4050..e107a24f7 100644 --- a/components/fpspreadsheet/source/common/fpschart.pas +++ b/components/fpspreadsheet/source/common/fpschart.pas @@ -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; diff --git a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas index ca80abd51..e01110935 100644 --- a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas +++ b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas @@ -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; diff --git a/components/fpspreadsheet/source/visual/fpspreadsheetchart.pas b/components/fpspreadsheet/source/visual/fpspreadsheetchart.pas index 70310a6a5..729234939 100644 --- a/components/fpspreadsheet/source/visual/fpspreadsheetchart.pas +++ b/components/fpspreadsheet/source/visual/fpspreadsheetchart.pas @@ -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. diff --git a/components/fpspreadsheet/source/visual/fpsstockseries.pas b/components/fpspreadsheet/source/visual/fpsstockseries.pas new file mode 100644 index 000000000..8602e62ef --- /dev/null +++ b/components/fpspreadsheet/source/visual/fpsstockseries.pas @@ -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. +