paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fpspreadsheet: Chart link supports bar, line and area series.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9037 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2023-11-22 14:23:55 +00:00
parent 563d62fda3
commit 18e5bac0da
3 changed files with 305 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
components/fpspreadsheet/examples/visual/fpschart/fpschartlink/chart_demo.lpi
View File

@ -47,6 +47,7 @@
<Filename Value="main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="Form1"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
</Units>

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

@ -1208,6 +1208,8 @@ begin
case nodeName of
'style:graphic-properties':
begin
if ASeries.ChartType in [ctBar] then
ASeries.Line.Style := clsSolid;
GetChartLineProps(AStyleNode, AChart, ASeries.Line);
GetChartFillProps(AStyleNode, AChart, ASeries.Fill);
end;

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

@ -19,7 +19,7 @@ interface
uses
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
// TChart
TATypes, TATextElements, TACustomSource,
TATypes, TATextElements, TAChartUtils, TACustomSource, TACustomSeries, TASeries,
TAChartAxisUtils, TAChartAxis, TALegend, TAGraph,
// FPSpreadsheet Visual
fpSpreadsheetCtrls, fpSpreadsheetGrid, fpsVisualUtils,
@ -36,21 +36,24 @@ type
{ TsWorkbookChartSource }
TsXYLRange = (rngX, rngY, rngLabel);
TsXYLRange = (rngX, rngY, rngLabel, rngColor);
TsWorkbookChartSource = class(TCustomChartSource, IsSpreadsheetControl)
private
FWorkbookSource: TsWorkbookSource;
// FWorkbook: TsWorkbook;
FWorksheets: array[TsXYLRange] of TsWorksheet;
FRangeStr: array[TsXYLRange] of String;
FRanges: array[TsXYLRange] of TsCellRangeArray;
FPointsNumber: Cardinal;
FTitleCol, FTitleRow: Cardinal;
FTitleSheetName: String;
function GetRange(AIndex: TsXYLRange): String;
function GetTitle: String;
function GetWorkbook: TsWorkbook;
procedure GetXYItem(ARangeIndex:TsXYLRange; APointIndex: Integer;
out ANumber: Double; out AText: String);
procedure SetRange(AIndex: TsXYLRange; const AValue: String);
procedure SetRangeFromChart(AIndex: TsXYLRange; const ARange: TsChartRange);
procedure SetWorkbookSource(AValue: TsWorkbookSource);
protected
FCurItem: TChartDataItem;
@ -65,6 +68,11 @@ type
public
destructor Destroy; override;
procedure Reset;
procedure SetColorRange(ARange: TsChartRange);
procedure SetLabelRange(ARange: TsChartRange);
procedure SetXRange(ARange: TsChartRange);
procedure SetYRange(ARange: TsChartRange);
procedure SetTitleAddr(Addr: TsChartCellAddr);
property PointsNumber: Cardinal read FPointsNumber;
property Workbook: TsWorkbook read GetWorkbook;
public
@ -73,9 +81,11 @@ type
procedure RemoveWorkbookSource;
published
property WorkbookSource: TsWorkbookSource read FWorkbookSource write SetWorkbookSource;
property ColorRange: String index rngColor read GetRange write SetRange;
property LabelRange: String index rngLabel read GetRange write SetRange;
property XRange: String index rngX read GetRange write SetRange;
property YRange: String index rngY read GetRange write SetRange;
property Title: String read GetTitle;
end;
{@@ Link between TAChart and the fpspreadsheet chart class }
@ -95,11 +105,14 @@ type
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure AddSeries(ASeries: TsChartSeries);
procedure FixAreaSeries(AWorkbookChart: TsChart);
procedure ClearChart;
function GetWorkbookChart: TsChart;
procedure PopulateChart;
procedure UpdateChartAxis(AWorkbookAxis: TsChartAxis);
procedure UpdateChartAxisLabels(AWorkbookChart: TsChart);
procedure UpdateChartBackground(AWorkbookChart: TsChart);
procedure UpdateBarSeries(AWorkbookChart: TsChart);
procedure UpdateChartBrush(AWorkbookFill: TsChartFill; ABrush: TBrush);
procedure UpdateChartLegend(AWorkbookLegend: TsChartLegend; ALegend: TChartLegend);
procedure UpdateChartPen(AWorkbookLine: TsChartLine; APen: TPen);
@ -109,6 +122,8 @@ type
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure UpdateChart;
{ Interfacing with WorkbookSource}
procedure ListenerNotification(AChangedItems: TsNotificationItems; AData: Pointer = nil);
procedure RemoveWorkbookSource;
@ -126,6 +141,11 @@ implementation
uses
Math;
function mmToPx(mm: Double; ppi: Integer): Integer;
begin
Result := round(mmToIn(mm * ppi));
end;
{------------------------------------------------------------------------------}
{ TsWorkbookChartSource }
{------------------------------------------------------------------------------}
@ -214,11 +234,23 @@ var
dummyString: String;
tmpLabel: String;
begin
GetXYItem(rngX, AIndex, FCurItem.X, tmpLabel);
if FRanges[rngX] <> nil then
GetXYItem(rngX, AIndex, FCurItem.X, tmpLabel)
else
FCurItem.X := AIndex;
GetXYItem(rngY, AIndex, FCurItem.Y, dummyString);
GetXYItem(rngLabel, AIndex, dummyNumber, FCurItem.Text);
if FCurItem.Text = '' then FCurItem.Text := tmpLabel;
FCurItem.Color := clDefault;
if FRanges[rngColor] <> nil then
begin
GetXYItem(rngColor, AIndex, dummyNumber, dummyString);
FCurItem.Color := round(dummyNumber);
end else
FCurItem.Color := clDefault;
Result := @FCurItem;
end;
@ -236,6 +268,18 @@ begin
Result := FRangeStr[AIndex];
end;
function TsWorkbookChartSource.GetTitle: String;
var
sheet: TsWorksheet;
begin
Result := '';
if FWorkbookSource = nil then
exit;
sheet := FWorkbookSource.Workbook.GetWorksheetByName(FTitleSheetName);
if sheet <> nil then
Result := sheet.ReadAsText(FTitleRow, FTitleCol);
end;
{@@ ----------------------------------------------------------------------------
Getter method for the linked workbook
-------------------------------------------------------------------------------}
@ -401,6 +445,7 @@ end;
-------------------------------------------------------------------------------}
procedure TsWorkbookChartSource.Prepare;
begin
Prepare(rngColor);
Prepare(rngLabel);
Prepare(rngX);
Prepare(rngY);
@ -410,21 +455,19 @@ end;
Parses the range string of the data specified by AIndex and extracts internal
information (worksheet used, cell range coordinates)
@param AIndex Identifies whether x or y or label cell ranges are analyzed
@param AIndex Identifies whether x or y or label or color cell ranges are
analyzed
-------------------------------------------------------------------------------}
procedure TsWorkbookChartSource.Prepare(AIndex: TsXYLRange);
{
const
XY: array[TsXYRange] of string = ('x', 'y', '');
}
var
range: TsCellRange;
begin
if (Workbook = nil) or (FRangeStr[AIndex] = '') //or (FWorksheets[AIndex] = nil)
then begin
if (Workbook = nil) or (FRangeStr[AIndex] = '') then
begin
FWorksheets[AIndex] := nil;
SetLength(FRanges[AIndex], 0);
FPointsNumber := 0;
if AIndex = rngY then
FPointsNumber := 0;
Reset;
exit;
end;
@ -443,13 +486,6 @@ begin
if (Workbook.GetWorksheetCount > 0) then begin
if FWorksheets[AIndex] = nil then
exit;
{
raise Exception.CreateFmt('Worksheet of %s cell range "%s" does not exist.',
[XY[AIndex], FRangeStr[AIndex]])
else
raise Exception.CreateFmt('No valid %s cell range in "%s".',
[XY[AIndex], FRangeStr[AIndex]]);
}
end;
end;
@ -472,6 +508,35 @@ begin
Notify;
end;
procedure TsWorkbookChartSource.SetColorRange(ARange: TsChartRange);
begin
SetRangeFromChart(rngColor, ARange);
end;
procedure TsWorkbookChartSource.SetLabelRange(ARange: TsChartRange);
begin
SetRangeFromChart(rngLabel, ARange);
end;
{@@ ----------------------------------------------------------------------------
Shared method to set the cell ranges for x, y, labels or colors directly from
the chart ranges.
-------------------------------------------------------------------------------}
procedure TsWorkbookChartSource.SetRangeFromChart(AIndex: TsXYLRange;
const ARange: TsChartRange);
begin
if ARange.Sheet1 <> ARange.Sheet2 then
raise Exception.Create('A chart cell range can only be from a single worksheet.');
SetLength(FRanges[AIndex], 1);
FRanges[AIndex,0].Row1 := ARange.Row1; // FIXME: Assuming here single-block range !!!
FRanges[AIndex,0].Col1 := ARange.Col1;
FRanges[AIndex,0].Row2 := ARange.Row2;
FRanges[AIndex,0].Col2 := ARange.Col2;
FWorksheets[AIndex] := FworkbookSource.Workbook.GetWorksheetByName(ARange.Sheet1);
if AIndex in [rngX, rngY] then
FPointsNumber := Max(CountValues(rngX), CountValues(rngY));
end;
{@@ ----------------------------------------------------------------------------
Setter method for the cell range used for x or y data (or labels) in the chart
If it does not contain the worksheet name the currently active worksheet of
@ -491,6 +556,23 @@ begin
Prepare;
end;
procedure TsWorkbookChartSource.SetTitleAddr(Addr: TsChartCellAddr);
begin
FTitleRow := Addr.Row;
FTitleCol := Addr.Col;
FTitleSheetName := Addr.GetSheetName;
end;
procedure TsWorkbookChartSource.SetXRange(ARange: TsChartRange);
begin
SetRangeFromChart(rngX, ARange);
end;
procedure TsWorkbookChartSource.SetYRange(ARange: TsChartRange);
begin
SetRangeFromChart(rngY, ARange);
end;
{@@ ----------------------------------------------------------------------------
Setter method for the WorkbookSource
-------------------------------------------------------------------------------}
@ -538,13 +620,92 @@ begin
inherited;
end;
procedure TsWorkbookChartLink.AddSeries(ASeries: TsChartSeries);
const
POINTER_STYLES: array[TsChartSeriesSymbol] of TSeriesPointerstyle = (
psRectangle,
psDiamond,
psTriangle,
psDownTriangle,
psLeftTriangle,
psRightTriangle,
psCircle,
psStar,
psDiagCross,
psCross,
psFullStar
);
var
src: TsWorkbookChartSource;
ser: TChartSeries;
ppi: Integer;
begin
src := TsWorkbookChartSource.Create(self);
src.WorkbookSource := FWorkbookSource;
if not ASeries.LabelRange.IsEmpty then src.SetLabelRange(ASeries.LabelRange);
if not ASeries.XRange.IsEmpty then src.SetXRange(ASeries.XRange);
if not ASeries.YRange.IsEmpty then src.SetYRange(ASeries.YRange);
if not ASeries.FillColorRange.IsEmpty then src.SetColorRange(ASeries.FillColorRange);
ppi := GetParentForm(FChart).PixelsPerInch;
case ASeries.ChartType of
ctBar:
begin
ser := TBarSeries.Create(FChart);
UpdateChartBrush(ASeries.Fill, TBarSeries(ser).BarBrush);
UpdateChartPen(ASeries.Line, TBarSeries(ser).BarPen);
end;
ctLine, ctScatter:
begin
ser := TLineSeries.Create(FChart);
UpdateChartPen(ASeries.Line, TLineSeries(ser).LinePen);
TLineSeries(ser).ShowLines := ASeries.Line.Style <> clsNoLine;
TLineSeries(ser).ShowPoints := TsLineSeries(ASeries).ShowSymbols;
if TLineSeries(ser).ShowPoints then
begin
UpdateChartBrush(ASeries.Fill, TLineSeries(ser).Pointer.Brush);
TLineSeries(ser).Pointer.Pen.Color := TLineSeries(ser).LinePen.Color;
TLineSeries(ser).Pointer.Style := POINTER_STYLES[TsLineSeries(ASeries).Symbol];
TlineSeries(ser).Pointer.HorizSize := mmToPx(TsLineSeries(ASeries).SymbolWidth, ppi);
TlineSeries(ser).Pointer.VertSize := mmToPx(TsLineSeries(ASeries).SymbolHeight, ppi);
end;
end;
ctArea:
begin
ser := TAreaSeries.Create(FChart);
UpdateChartBrush(ASeries.Fill, TAreaSeries(ser).AreaBrush);
UpdateChartPen(ASeries.Line, TAreaSeries(ser).AreaContourPen);
TAreaSeries(ser).AreaLinesPen.Style := psClear;
end;
end;
src.SetTitleAddr(ASeries.TitleAddr);
ser.Source := src;
ser.Title := src.Title;
ser.Transparency := round(ASeries.Fill.Transparency);
FChart.AddSeries(ser);
end;
procedure TsWorkbookChartLink.ClearChart;
var
i, j: Integer;
ser: TChartSeries;
src: TCustomChartSource;
begin
if FChart = nil then
exit;
// Clear chart sources
for i := 0 to FChart.SeriesCount-1 do
begin
if (FChart.Series[i] is TChartSeries) then
begin
ser := TChartSeries(FChart.Series[i]);
src := ser.Source;
if src is TsWorkbookChartSource then
src.Free;
end;
end;
// Clear the series
FChart.ClearSeries;
@ -568,6 +729,29 @@ begin
FChart.Foot.Text.Clear;
end;
// Fix area series zero level not being clipped at chart's plotrect.
procedure TsWorkbookChartLink.FixAreaSeries(AWorkbookChart: TsChart);
var
i: Integer;
ser: TAreaSeries;
ext: TDoubleRect;
begin
if AWorkbookChart.GetChartType <> ctArea then
exit;
ext := FChart.LogicalExtent;
for i := 0 to FChart.SeriesCount-1 do
if FChart.Series[i] is TAreaSeries then
begin
ser := TAreaSeries(FChart.Series[i]);
if ser.ZeroLevel < ext.a.y then
ser.ZeroLevel := ext.a.y;
if ser.ZeroLevel > ext.b.y then
ser.ZeroLevel := ext.b.y;
ser.UseZeroLevel := true;
end;
end;
function TsWorkbookChartLink.GetWorkbookChart: TsChart;
begin
if (FWorkbook <> nil) and (FWorkbookChartIndex > -1) then
@ -600,9 +784,43 @@ begin
SetWorkbookSource(nil);
end;
procedure TsWorkbookChartLink.PopulateChart;
procedure TsWorkbookChartLink.SetChart(AValue: TChart);
begin
if FChart = AValue then
exit;
FChart := AValue;
UpdateChart;
end;
procedure TSWorkbookChartLink.SetWorkbookChartIndex(AValue: Integer);
begin
if AValue = FWorkbookChartIndex then
exit;
FWorkbookChartIndex := AValue;
UpdateChart;
end;
procedure TsWorkbookChartLink.SetWorkbookSource(AValue: TsWorkbookSource);
begin
if AValue = FWorkbookSource then
exit;
if FWorkbookSource <> nil then
FWorkbookSource.RemoveListener(self);
FWorkbookSource := AValue;
if FWorkbookSource <> nil then
begin
FWorkbookSource.AddListener(self);
FWorkbook := FWorkbookSource.Workbook;
end else
FWorkbook := nil;
ListenerNotification([lniWorkbook, lniWorksheet]);
UpdateChart;
end;
procedure TsWorkbookChartLink.UpdateChart;
var
ch: TsChart;
i: Integer;
begin
if (FChart = nil) then
exit;
@ -621,39 +839,14 @@ begin
UpdateChartAxis(ch.YAxis);
UpdateChartAxis(ch.X2Axis);
UpdateChartAxis(ch.Y2Axis);
end;
procedure TsWorkbookChartLink.SetChart(AValue: TChart);
begin
if FChart = AValue then
exit;
FChart := AValue;
PopulateChart;
end;
for i := 0 to ch.Series.Count-1 do
AddSeries(ch.Series[i]);
procedure TSWorkbookChartLink.SetWorkbookChartIndex(AValue: Integer);
begin
if AValue = FWorkbookChartIndex then
exit;
FWorkbookChartIndex := AValue;
PopulateChart;
end;
procedure TsWorkbookChartLink.SetWorkbookSource(AValue: TsWorkbookSource);
begin
if AValue = FWorkbookSource then
exit;
if FWorkbookSource <> nil then
FWorkbookSource.RemoveListener(self);
FWorkbookSource := AValue;
if FWorkbookSource <> nil then
begin
FWorkbookSource.AddListener(self);
FWorkbook := FWorkbookSource.Workbook;
end else
FWorkbook := nil;
ListenerNotification([lniWorkbook, lniWorksheet]);
PopulateChart;
FChart.Prepare;
UpdateChartAxisLabels(ch);
UpdateBarSeries(ch);
FixAreaSeries(ch);
end;
procedure TsWorkbookChartLink.UpdateChartAxis(AWorkbookAxis: TsChartAxis);
@ -736,6 +929,19 @@ begin
axis.Range.Max := AWorkbookAxis.Max;
end;
procedure TsWorkbookChartLink.UpdateChartAxisLabels(AWorkbookChart: TsChart);
begin
if (FChart.SeriesCount > 0) and
(AWorkbookChart.GetChartType in [ctBar, ctLine, ctArea]) then
begin
FChart.BottomAxis.Marks.Source := TChartSeries(FChart.Series[0]).Source;
if not AWorkbookChart.Series[0].LabelRange.IsEmpty then
FChart.BottomAxis.Marks.Style := smsLabel
else
FChart.BottomAxis.Marks.Style := smsXValue;
end;
end;
procedure TsWorkbookChartLink.UpdateChartBackground(AWorkbookChart: TsChart);
begin
FChart.Color := Convert_sColor_to_Color(AWorkbookChart.Background.Color);
@ -744,6 +950,47 @@ begin
FChart.Frame.Visible := AWorkbookChart.PlotArea.Border.Style <> clsNoLine;
end;
procedure TsWorkbookChartLink.UpdateBarSeries(AWorkbookChart: TsChart);
var
i, n: Integer;
ser: TBarSeries;
barWidth, totalBarWidth: Integer;
begin
if AWorkbookChart.GetChartType <> ctBar then
exit;
// Count the bar series
n := 0;
for i := 0 to AWorkbookChart.Series.Count-1 do
begin
if AWorkbookChart.Series[i].ChartType = ctBar then
inc(n);
end;
// Iterate over bar series to put them side-by-side or to stack them
totalBarWidth := 90;
barWidth := round(totalBarWidth / n);
for i := 0 to FChart.SeriesCount-1 do
if FChart.Series[i] is TBarSeries then
begin
ser := TBarSeries(FChart.Series[i]);
case AWorkbookChart.Stackmode of
csmSideBySide:
begin
ser.BarWidthPercent := barWidth;
ser.BarWidthStyle := bwPercentMin;
ser.BarOffsetPercent := round((i - (n - 1)/2)*barWidth);
end;
csmStacked:
ser.Stacked := true;
csmStackedPercentage:
begin
ser.Stacked := true;
end;
end;
end;
end;
procedure TsWorkbookChartLink.UpdateChartBrush(AWorkbookFill: TsChartFill;
ABrush: TBrush);
begin
@ -778,6 +1025,7 @@ begin
ALegend.Alignment := LEG_POS[AWorkbookLegend.Position];
ALegend.UseSidebar := not AWorkbookLegend.CanOverlapPlotArea;
ALegend.Visible := AWorkbookLegend.Visible;
ALegend.Inverted := true;
end;
end;
@ -787,7 +1035,7 @@ begin
if (AWorkbookLine <> nil) and (APen <> nil) then
begin
APen.Color := Convert_sColor_to_Color(AWorkbookLine.Color);
APen.Width := round(mmToIn(AWorkbookLine.Width) * GetParentForm(FChart).PixelsPerInch);
APen.Width := mmToPx(AWorkbookLine.Width, GetParentForm(FChart).PixelsPerInch);
case AWorkbookLine.Style of
clsNoLine:
APen.Style := psClear;