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

fpspreadsheet: Initial version of stockseries (ods reader and chart link)

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9071 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-12-05 18:40:10 +00:00
parent 95c2e4c505
commit 2af4b6d034
3 changed files with 266 additions and 26 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -232,7 +232,7 @@ type
TsChartAxisTick = (catInside, catOutside);
TsChartAxisTicks = set of TsChartAxisTick;
TsChartType = (ctEmpty, ctBar, ctLine, ctArea, ctBarLine, ctScatter, ctBubble,
ctRadar, ctFilledRadar, ctPie, ctRing);
ctRadar, ctFilledRadar, ctPie, ctRing, ctStock);
TsChartAxis = class(TsChartFillElement)
private
@ -538,6 +538,30 @@ type
property BubbleRange: TsChartRange read FBubbleRange;
end;
TsStockSeries = class(TsCustomScatterSeries)
private
FCandleStick: Boolean;
FOpenRange: TsChartRange;
FHighRange: TsChartRange;
FLowRange: TsChartRange; // close = normal y range
FCandleStickDownFill: TsChartFill;
FRangeLine: TsChartLine;
public
constructor Create(AChart: TsChart); override;
destructor Destroy; override;
procedure SetOpenRange(ASheet1: String; ARow1, ACol1: Cardinal; ASheet2: String; ARow2, ACol2: Cardinal);
procedure SetHighRange(ASheet1: String; ARow1, ACol1: Cardinal; ASheet2: String; ARow2, ACol2: Cardinal);
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 OpenRange: TsChartRange read FOpenRange;
property HighRange: TsChartRange read FHighRange;
property LowRange: TsChartRange read FLowRange;
property CloseRange: TsChartRange read FYRange;
end;
TsChartSeriesList = class(TFPObjectList)
private
function GetItem(AIndex: Integer): TsChartSeries;
@ -1602,7 +1626,6 @@ begin
FFill := Value;
end;
{ TsPieSeries }
constructor TsPieSeries.Create(AChart: TsChart);
begin
@ -1731,6 +1754,81 @@ begin
end;
{ TsStockSeries }
constructor TsStockSeries.Create(AChart: TsChart);
begin
inherited Create(AChart);
FChartType := ctStock;
FOpenRange := TsChartRange.Create(AChart);
FHighRange := TsChartRange.Create(AChart);
FLowRange := TsChartRange.Create(AChart);
// FFill is CandleStickUp
FCandleStickDownFill := TsChartFill.Create;
FCandleStickDownFill.Style := cfsSolid;
FCandleStickDownFill.Color := scBlack;
FRangeLine := TsChartLine.Create;
FRangeLine.Style := clsSolid;
FRangeLine.Color := scBlack;
end;
destructor TsStockSeries.Destroy;
begin
FRangeLine.Free;
FCandleStickDownFill.Free;
FOpenRange.Free;
FHighRange.Free;
FLowRange.Free;
inherited;
end;
procedure TsStockSeries.SetOpenRange(ASheet1: String; ARow1, ACol1: Cardinal;
ASheet2: String; ARow2, ACol2: Cardinal);
begin
if (ARow1 <> ARow2) and (ACol1 <> ACol2) then
raise Exception.Create('Stock series values can only be located in a single column or row.');
FOpenRange.Sheet1 := ASheet1;
FOpenRange.Row1 := ARow1;
FOpenRange.Col1 := ACol1;
FOpenRange.Sheet2 := ASheet2;
FOpenRange.Row2 := ARow2;
FOpenRange.Col2 := ACol2;
end;
procedure TsStockSeries.SetHighRange(ASheet1: String; ARow1, ACol1: Cardinal;
ASheet2: String; ARow2, ACol2: Cardinal);
begin
if (ARow1 <> ARow2) and (ACol1 <> ACol2) then
raise Exception.Create('Stock series values can only be located in a single column or row.');
FHighRange.Sheet1 := ASheet1;
FHighRange.Row1 := ARow1;
FHighRange.Col1 := ACol1;
FHighRange.Sheet2 := ASheet2;
FHighRange.Row2 := ARow2;
FHighRange.Col2 := ACol2;
end;
procedure TsStockSeries.SetLowRange(ASheet1: String; ARow1, ACol1: Cardinal;
ASheet2: String; ARow2, ACol2: Cardinal);
begin
if (ARow1 <> ARow2) and (ACol1 <> ACol2) then
raise Exception.Create('Stock series values can only be located in a single column or row.');
FLowRange.Sheet1 := ASheet1;
FLowRange.Row1 := ARow1;
FLowRange.Col1 := ACol1;
FLowRange.Sheet2 := ASheet2;
FLowRange.Row2 := ARow2;
FLowRange.Col2 := ACol2;
end;
procedure TsStockSeries.SetCloseRange(ASheet1: String; ARow1, ACol1: Cardinal;
ASheet2: String; ARow2, ACol2: Cardinal);
begin
SetYRange(ASheet1, ARow1, ACol1, ASheet2, ARow2, ACol2);
end;
{ TsChart }
constructor TsChart.Create;

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

@ -25,6 +25,8 @@ type
FNumberFormatList: TStrings;
FPieSeriesStartAngle: Integer;
FStreamList: TFPObjectList;
FChartType: TsChartType;
FStockSeries: TsStockSeries;
function FindStyleNode(AStyleNodes: TDOMNode; AStyleName: String): TDOMNode;
function GetChartFillProps(ANode: TDOMNode; AChart: TsChart; AFill: TsChartFill): Boolean;
function GetChartLineProps(ANode: TDOMNode; AChart: TsChart; ALine: TsChartLine): Boolean;
@ -49,6 +51,8 @@ type
ASeries: TsChartSeries; var AFill: TsChartFill; var ALine: TsChartLine);
procedure ReadChartSeriesProps(ANode, AStyleNode: TDOMNode; AChart: TsChart);
procedure ReadChartSeriesStyle(AStyleNode: TDOMNode; AChart: TsChart; ASeries: TsChartSeries);
procedure ReadChartStockSeriesStyle(AStyleNode: TDOMNode; AChart: TsChart;
ASeries: TsStockSeries; ANodeName: String);
procedure ReadChartTitleProps(ANode, AStyleNode: TDOMNode; AChart: TsChart; ATitle: TsChartText);
procedure ReadChartTitleStyle(AStyleNode: TDOMNode; AChart: TsChart; ATitle: TsChartText);
@ -155,7 +159,7 @@ const
CHART_TYPE_NAMES: array[TsChartType] of string = (
'', 'bar', 'line', 'area', 'barLine', 'scatter', 'bubble',
'radar', 'filled-radar', 'circle', 'ring'
'radar', 'filled-radar', 'circle', 'ring', 'stock'
);
SYMBOL_NAMES: array[TsChartSeriesSymbol] of String = (
@ -939,12 +943,41 @@ end;
procedure TsSpreadOpenDocChartReader.ReadChartProps(AChartNode, AStyleNode: TDOMNode;
AChart: TsChart);
var
ct: TsChartType;
s: String;
styleName: String;
styleNode: TDOMNode;
begin
s := GetAttrValue(AChartNode, 'chart:class');
if s <> '' then
begin
Delete(s, 1, Pos(':', s)); // remove "chart:"
for ct in TsChartType do
if CHART_TYPE_NAMES[ct] = s then
begin
FChartType := ct;
if FChartType = ctStock then
begin
FStockSeries := TsStockSeries.Create(AChart);
FStockSeries.Fill.Style := cfsSolid;
FStockSeries.Fill.Color := scWhite;
FStockSeries.Line.Style := clsSolid;
FStockSeries.Line.Color := scBlack;
FStockSeries.RangeLine.Style := clsSolid;
FStockSeries.RangeLine.Color := scBlack;
FStockSeries.CandleStickDownFill.Style := cfsSolid;
FStockSeries.CandleStickDownFill.Color := scBlack;
break;
end;
end;
end;
styleName := GetAttrValue(AChartNode, 'chart:style-name');
styleNode := FindStyleNode(AStyleNode, styleName);
ReadChartBackgroundStyle(styleNode, AChart, AChart);
if styleName <> '' then
begin
styleNode := FindStyleNode(AStyleNode, styleName);
ReadChartBackgroundStyle(styleNode, AChart, AChart);
end;
end;
procedure TsSpreadOpenDocChartReader.ReadChartPlotAreaProps(ANode, AStyleNode: TDOMNode;
@ -979,6 +1012,17 @@ begin
ReadChartBackgroundProps(ANode, AStyleNode, AChart, AChart.PlotArea);
'chart:floor':
ReadChartBackgroundProps(ANode, AStyleNode, AChart, AChart.Floor);
'chart:stock-gain-marker',
'chart:stock-loss-marker',
'chart:stock-range-line':
begin
styleName := GetAttrValue(ANode, 'chart:style-name');
if (styleName <> '') and (FStockSeries <> nil) then
begin
styleNode := FindStyleNode(AStyleNode, styleName);
ReadChartStockSeriesStyle(styleNode, AChart, FStockSeries, nodeName);
end;
end;
end;
ANode := ANode.NextSibling;
end;
@ -1004,6 +1048,9 @@ begin
s := GetAttrValue(AStyleNode, 'chart:angle-offset');
if s <> '' then
FPieSeriesStartAngle := StrToInt(s);
s := GetAttrValue(AStyleNode, 'chart:japanese-candle-stick');
if (s <> '') and (FStockSeries <> nil) then
FStockSeries.CandleStick := true;
end;
end;
AStyleNode := AStyleNode.NextSibling;
@ -1252,20 +1299,38 @@ var
n: Integer;
begin
s := GetAttrValue(ANode, 'chart:class');
case s of
'chart:area': series := TsAreaSeries.Create(AChart);
'chart:bar': series := TsBarSeries.Create(AChart);
'chart:bubble': series := TsBubbleSeries.Create(AChart);
'chart:circle': series := TsPieSeries.Create(AChart);
'chart:filled-radar': series := TsRadarSeries.Create(AChart);
'chart:line': series := TsLineSeries.Create(AChart);
'chart:radar': series := TsRadarSeries.Create(AChart);
'chart:ring': series := TsRingSeries.Create(AChart);
'chart:scatter': series := TsScatterSeries.Create(AChart);
else raise Exception.Create('Unknown/unsupported series type.');
end;
if (FChartType = ctStock) then
series := FStockSeries
else
case s of
'chart:area': series := TsAreaSeries.Create(AChart);
'chart:bar': series := TsBarSeries.Create(AChart);
'chart:bubble': series := TsBubbleSeries.Create(AChart);
'chart:circle': series := TsPieSeries.Create(AChart);
'chart:filled-radar': series := TsRadarSeries.Create(AChart);
'chart:line': series := TsLineSeries.Create(AChart);
'chart:radar': series := TsRadarSeries.Create(AChart);
'chart:ring': series := TsRingSeries.Create(AChart);
'chart:scatter': series := TsScatterSeries.Create(AChart);
else raise Exception.Create('Unknown/unsupported series type.');
end;
ReadChartCellAddr(ANode, 'chart:label-cell-address', series.TitleAddr);
if (series is TsStockSeries) then
begin
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.CloseRange.IsEmpty then
ReadChartCellRange(ANode, 'chart:values-cell-range-address', FStockSeries.CloseRange);
end
else
if (series is TsBubbleSeries) then
ReadChartCellRange(ANode, 'chart:values-cell-range-address', TsBubbleSeries(series).BubbleRange)
else
@ -1333,8 +1398,11 @@ begin
if series.LabelRange.IsEmpty then series.LabelRange.Assign(AChart.XAxis.CategoryRange);
s := GetAttrValue(ANode, 'chart:style-name');
styleNode := FindStyleNode(AStyleNode, s);
ReadChartSeriesStyle(styleNode, AChart, series);
if s <> '' then
begin
styleNode := FindStyleNode(AStyleNode, s);
ReadChartSeriesStyle(styleNode, AChart, series);
end;
if (series is TsPieSeries) and (FPieSeriesStartAngle <> 999) then
TsPieSeries(series).StartAngle := FPieSeriesStartAngle;
@ -1471,6 +1539,34 @@ begin
end;
end;
procedure TsSpreadOpenDocChartReader.ReadChartStockSeriesStyle(AStyleNode: TDOMNode;
AChart: TsChart; ASeries: TsStockSeries; ANodeName: String);
var
nodeName: String;
begin
nodeName := AStyleNode.NodeName;
if nodeName = 'style:style' then
begin
AStyleNode := AStyleNode.Firstchild;
while AStyleNode <> nil do
begin
nodeName := AStyleNode.NodeName;
if nodeName = 'style:graphic-properties' then
begin
if ANodeName = 'chart:stock-gain-marker' then
GetChartFillProps(AStyleNode, AChart, ASeries.Fill)
else
if ANodeName = 'chart:stock-loss-marker' then
GetChartFillProps(AStyleNode, AChart, ASeries.CandleStickDownFill)
else
if ANodeName = 'chart:stock-range-line' then
GetChartLineProps(AStyleNode, AChart, ASeries.RangeLine);
end;
AStyleNode := AStyleNode.NextSibling;
end;
end;
end;
procedure TsSpreadOpenDocChartReader.ReadChartTitleProps(ANode, AStyleNode: TDOMNode;
AChart: TsChart; ATitle: TsChartText);
var

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

@ -77,10 +77,11 @@ type
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function RangeIsEmpty(ARange: TsCellRange): Boolean;
procedure Reset;
procedure SetColorRange(ARange: TsChartRange);
procedure SetLabelRange(ARange: TsChartRange);
procedure SetXRange(XIndex: Integer;ARange: TsChartRange);
procedure SetXRange(XIndex: Integer; ARange: TsChartRange);
procedure SetYRange(YIndex: Integer; ARange: TsChartRange);
procedure SetTitleAddr(Addr: TsChartCellAddr);
procedure UseDataPointColors(ASeries: TsChartSeries);
@ -155,6 +156,7 @@ 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);
@ -561,9 +563,9 @@ begin
ANumber := NaN;
AText := '';
if FRanges[ARangeIndex, AListIndex] = nil then
if (FRanges[ARangeIndex, AListIndex] = nil) then
exit;
if FWorksheets[ARangeIndex] = nil then
if (FWorksheets[ARangeIndex] = nil) or (FWorksheets[ARangeIndex, AListIndex] = nil) then
exit;
cell := nil;
@ -571,6 +573,9 @@ begin
for range in FRanges[ARangeIndex, AListIndex] do
begin
if RangeIsEmpty(range) then
Continue;
if (range.Col1 = range.Col2) then // vertical range
begin
len := range.Row2 - range.Row1 + 1;
@ -803,6 +808,16 @@ begin
FRangeStr[AIndex] := BuildRangeStr(AIndex);
end;
{@@ ----------------------------------------------------------------------------
Returns true when the specified cell range is empty
-------------------------------------------------------------------------------}
function TsWorkbookChartSource.RangeIsEmpty(ARange: TsCellRange): Boolean;
begin
Result :=
(ARange.Row1 = UNASSIGNED_ROW_COL_INDEX) and (ARange.Col1 = UNASSIGNED_ROW_COL_INDEX) and
(ARange.Row2 = UNASSIGNED_ROW_COL_INDEX) and (ARange.Col2 = UNASSIGNED_ROW_COL_INDEX);
end;
{@@ ----------------------------------------------------------------------------
Removes the link of the ChartSource to the WorkbookSource.
Required before destruction.
@ -1080,14 +1095,27 @@ begin
end;
ctPie:
Result := TPieSeries.Create(FChart);
ctStock:
begin
Result := TOpenHighLowCloseSeries.Create(FChart);
src.YCount := 4;
src.SetYRange(0, TsStockSeries(ASeries).LowRange); // 0=Low
src.SetYRange(1, TsStockSeries(ASeries).OpenRange); // 1=Open
src.SetYRange(2, TsStockSeries(ASeries).CloseRange); // 2=Close (= Y)
src.SetYRange(3, TsStockSeries(ASeries).HighRange); // 3=High
end;
else
exit(nil);
end;
if not ASeries.LabelRange.IsEmpty then src.SetLabelRange(ASeries.LabelRange);
if not ASeries.XRange.IsEmpty then src.SetXRange(0, ASeries.XRange);
if not ASeries.YRange.IsEmpty then src.SetYRange(0, ASeries.YRange);
if not ASeries.FillColorRange.IsEmpty then src.SetColorRange(ASeries.FillColorRange);
if not ASeries.LabelRange.IsEmpty then
src.SetLabelRange(ASeries.LabelRange);
if not ASeries.XRange.IsEmpty then
src.SetXRange(0, ASeries.XRange);
if not ASeries.YRange.IsEmpty and not (Result is TOpenHighLowCloseSeries) then
src.SetYRange(0, ASeries.YRange);
if not ASeries.FillColorRange.IsEmpty then
src.SetColorRange(ASeries.FillColorRange);
src.SetTitleAddr(ASeries.TitleAddr);
// Copy individual data point colors to the chart series.
@ -1162,6 +1190,8 @@ begin
UpdateCustomLineSeries(TsLineSeries(ASeries), TLineSeries(ser));
ctScatter:
UpdateScatterSeries(TsScatterSeries(ASeries), TLineSeries(ser));
ctStock:
UpdateOHLCSeries(TsStockSeries(ASeries), TOpenHighLowCloseSeries(ser));
ctPie, ctRing:
UpdatePieSeries(TsPieSeries(ASeries), TPieSeries(ser));
ctRadar, ctFilledRadar:
@ -2050,6 +2080,22 @@ 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