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

fpspreadsheet: Extended chart display demo. Rework TsWorkbookSource's ListenerNotification to avoid crash when chart destroy a listening chartsource. Chart link can display pie series now.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9053 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-11-28 23:04:27 +00:00
parent 8b51f30e14
commit e041a4109e
7 changed files with 260 additions and 108 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -65,6 +65,7 @@
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
<UseHeaptrc Value="True"/>
</Debugging>
<Options>
<Win32>

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

@ -10,8 +10,8 @@ object Form1: TForm1
OnCreate = FormCreate
object sWorksheetGrid1: TsWorksheetGrid
Left = 0
Height = 527
Top = 0
Height = 489
Top = 38
Width = 402
FrozenCols = 0
FrozenRows = 0
@ -28,14 +28,14 @@ object Form1: TForm1
end
object Splitter1: TSplitter
Left = 402
Height = 527
Top = 0
Height = 489
Top = 38
Width = 5
end
object Chart1: TChart
Left = 407
Height = 527
Top = 0
Height = 489
Top = 38
Width = 694
AxisList = <
item
@ -55,10 +55,96 @@ object Form1: TForm1
)
Align = alClient
end
object Panel1: TPanel
Left = 0
Height = 38
Top = 0
Width = 1101
Align = alTop
AutoSize = True
BevelOuter = bvNone
ClientHeight = 38
ClientWidth = 1101
TabOrder = 3
object Label1: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Panel1
AnchorSideTop.Side = asrCenter
Left = 6
Height = 15
Top = 12
Width = 51
BorderSpacing.Around = 6
Caption = 'File name'
end
object ComboBox1: TComboBox
AnchorSideLeft.Control = Label1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Button1
Left = 63
Height = 23
Top = 8
Width = 911
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Around = 6
ItemHeight = 15
Items.Strings = (
'../../../other/chart/area.ods'
'../../../other/chart/bars.ods'
'../../../other/chart/bubble.ods'
'../../../other/chart/pie.ods'
'../../../other/chart/radar.ods'
'../../../other/chart/regression.ods'
)
TabOrder = 0
TextHint = 'Enter or select file name'
OnCloseUp = ComboBox1CloseUp
end
object Button1: TButton
AnchorSideTop.Control = Panel1
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Button2
Left = 980
Height = 25
Top = 7
Width = 35
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Around = 6
Caption = '...'
TabOrder = 1
OnClick = Button1Click
end
object Button2: TButton
AnchorSideTop.Control = Panel1
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 1021
Height = 25
Top = 7
Width = 74
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Around = 6
Caption = 'Open file'
TabOrder = 2
OnClick = Button2Click
end
end
object sWorkbookSource1: TsWorkbookSource
FileFormat = sfUser
Options = []
Left = 244
Top = 138
end
object OpenDialog1: TOpenDialog
DefaultExt = '.ods'
Filter = 'OpenDocument Spreadsheet Files|*.ods'
Options = [ofFileMustExist, ofEnableSizing, ofViewDetail]
Left = 976
Top = 56
end
end

52
components/fpspreadsheet/examples/visual/fpschart/fpschartlink/main.pas
View File

@ -5,7 +5,7 @@ unit main;
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
TAGraph,
fpSpreadsheet, fpsTypes, fpsOpenDocument,
fpSpreadsheetCtrls, fpSpreadsheetGrid, fpSpreadsheetChart;
@ -15,13 +15,24 @@ type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Chart1: TChart;
ComboBox1: TComboBox;
Label1: TLabel;
OpenDialog1: TOpenDialog;
Panel1: TPanel;
Splitter1: TSplitter;
sWorkbookSource1: TsWorkbookSource;
sWorksheetGrid1: TsWorksheetGrid;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ComboBox1CloseUp(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
sChartLink: TsWorkbookChartLink;
FFileName: String;
procedure LoadFile(AFileName: String);
public
@ -46,11 +57,47 @@ const
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
begin
OpenDialog1.InitialDir := ExtractFilePath(Combobox1.Text);
OpenDialog1.FileName := '';
if OpenDialog1.Execute then
begin
Combobox1.Text := OpenDialog1.FileName;
LoadFile(OpenDialog1.FileName);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
LoadFile(Combobox1.Text);
end;
procedure TForm1.ComboBox1CloseUp(Sender: TObject);
begin
Combobox1.Text := Combobox1.Items[Combobox1.ItemIndex];
LoadFile(Combobox1.Text);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
if ParamCount > 0 then
begin
Combobox1.Text := ParamStr(1);
LoadFile(Combobox1.Text);
end;
end;
procedure TForm1.LoadFile(AFileName: String);
var
fn: String;
begin
fn := ExpandFileName(FILE_NAME);
fn := ExpandFileName(AFileName);
if not FileExists(fn) then
begin
MessageDlg('File "' + fn + '" not found.', mtError, [mbOK], 0);
exit;
end;
sWorkbookSource1.FileFormat := sfOpenDocument;
if FileExists(fn) then
@ -61,6 +108,5 @@ begin
sChartLink.WorkbookSource := sWorkbookSource1;
sChartLink.WorkbookChartIndex := 0;
end;
end.

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

@ -390,24 +390,12 @@ type
constructor Create(AChart: TsChart); override;
end;
TsBubbleSeries = class(TsChartSeries)
// to do: inherited from ScatterSeries, but without symbols
private
FBubbleRange: TsChartRange;
public
constructor Create(AChart: TsChart); override;
destructor Destroy; override;
procedure SetBubbleRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
procedure SetBubbleRange(ASheet1: String; ARow1, ACol1: Cardinal; ASheet2: String; ARow2, ACol2: Cardinal);
property BubbleRange: TsChartRange read FBubbleRange;
end;
TsChartSeriesSymbol = (
cssRect, cssDiamond, cssTriangle, cssTriangleDown, cssTriangleLeft,
cssTriangleRight, cssCircle, cssStar, cssX, cssPlus, cssAsterisk
);
TsLineSeries = class(TsChartSeries)
TsCustomLineSeries = class(TsChartSeries)
private
FSymbol: TsChartSeriesSymbol;
FSymbolHeight: Double; // in mm
@ -417,9 +405,7 @@ type
FBorder: TsChartLine;
function GetSymbolFill: TsChartFill;
procedure SetSymbolFill(Value: TsChartFill);
public
constructor Create(AChart: TsChart); override;
destructor Destroy; override;
protected
property Symbol: TsChartSeriesSymbol read FSymbol write FSymbol;
property SymbolBorder: TsChartLine read FBorder write FBorder;
property SymbolFill: TsChartFill read GetSymbolFill write SetSymbolFill;
@ -427,6 +413,20 @@ type
property SymbolWidth: double read FSymbolWidth write FSymbolWidth;
property ShowLines: Boolean read FShowLines write FShowLines;
property ShowSymbols: Boolean read FShowSymbols write FShowSymbols;
public
constructor Create(AChart: TsChart); override;
destructor Destroy; override;
end;
TsLineSeries = class(TsCustomLineSeries)
public
property Symbol;
property SymbolBorder;
property SymbolFill;
property SymbolHeight;
property SymbolWidth;
property ShowLines;
property ShowSymbols;
end;
TsPieSeries = class(TsChartSeries)
@ -487,7 +487,7 @@ type
destructor Destroy; override;
end;
TsScatterSeries = class(TsLineSeries)
TsCustomScatterSeries = class(TsCustomLineSeries)
private
FRegression: TsChartRegression;
public
@ -496,6 +496,28 @@ type
property Regression: TsChartRegression read FRegression write FRegression;
end;
TsScatterSeries = class(TsCustomScatterSeries)
public
property Symbol;
property SymbolBorder;
property SymbolFill;
property SymbolHeight;
property SymbolWidth;
property ShowLines;
property ShowSymbols;
end;
TsBubbleSeries = class(TsCustomScatterSeries)
private
FBubbleRange: TsChartRange;
public
constructor Create(AChart: TsChart); override;
destructor Destroy; override;
procedure SetBubbleRange(ARow1, ACol1, ARow2, ACol2: Cardinal);
procedure SetBubbleRange(ASheet1: String; ARow1, ACol1: Cardinal; ASheet2: String; ARow2, ACol2: Cardinal);
property BubbleRange: TsChartRange read FBubbleRange;
end;
TsChartSeriesList = class(TFPObjectList)
private
function GetItem(AIndex: Integer): TsChartSeries;
@ -1428,9 +1450,9 @@ begin
end;
{ TsLineSeries }
{ TsCustomLineSeries }
constructor TsLineSeries.Create(AChart: TsChart);
constructor TsCustomLineSeries.Create(AChart: TsChart);
begin
inherited Create(AChart);
FChartType := ctLine;
@ -1445,18 +1467,18 @@ begin
FBorder.Color := scBlack;
end;
destructor TsLineSeries.Destroy;
destructor TsCustomLineSeries.Destroy;
begin
FBorder.Free;
inherited;
end;
function TsLineSeries.GetSymbolFill: TsChartFill;
function TsCustomLineSeries.GetSymbolFill: TsChartFill;
begin
Result := FFill;
end;
procedure TsLineSeries.SetSymbolFill(Value: TsChartFill);
procedure TsCustomLineSeries.SetSymbolFill(Value: TsChartFill);
begin
FFill := Value;
end;
@ -1574,16 +1596,16 @@ begin
end;
{ TsScatterSeries }
{ TsCustomScatterSeries }
constructor TsScatterSeries.Create(AChart: TsChart);
constructor TsCustomScatterSeries.Create(AChart: TsChart);
begin
inherited Create(AChart);
FChartType := ctScatter;
FRegression := TsChartRegression.Create;
end;
destructor TsScatterSeries.Destroy;
destructor TsCustomScatterSeries.Destroy;
begin
FRegression.Free;
inherited;

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

@ -3202,8 +3202,8 @@ begin
series := AChart.Series[ASeriesIndex];
// These are the x values of a scatter or bubble plot.
if (series is TsScatterSeries) or (series is TsBubbleSeries) then
// These are the x values of a scatter plot.
if (series is TsScatterSeries) then
begin
domainRangeX := GetSheetCellRangeString_ODS(
series.XRange.GetSheet1Name, series.XRange.GetSheet2Name,

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

@ -63,6 +63,7 @@ type
protected
FCurItem: TChartDataItem;
function BuildRangeStr(AIndex: TsXYLRange; AListSeparator: char = #0): String;
procedure ClearRanges;
function CountValues(AIndex: TsXYLRange): Integer;
function GetCount: Integer; override;
function GetItem(AIndex: Integer): PChartDataItem; override;
@ -141,7 +142,7 @@ type
procedure UpdateAreaSeries(AWorkbookSeries: TsAreaSeries; AChartSeries: TAreaSeries);
procedure UpdateBarSeries(AWorkbookSeries: TsBarSeries; AChartSeries: TBarSeries);
procedure UpdateBubbleSeries(AWorkbookSeries: TsBubbleSeries; AChartSeries: TBubbleSeries);
procedure UpdateLineSeries(AWorkbookSeries: TsLineSeries; AChartSeries: TLineSeries);
procedure UpdateCustomLineSeries(AWorkbookSeries: TsCustomLineSeries; AChartSeries: TLineSeries);
procedure UpdatePieSeries(AWorkbookSeries: TsPieSeries; AChartSeries: TPieSeries);
procedure UpdatePolarSeries(AWorkbookSeries: TsRadarSeries; AChartSeries: TPolarSeries);
procedure UpdateScatterSeries(AWorkbookSeries: TsScatterSeries; AChartSeries: TLineSeries);
@ -173,6 +174,7 @@ uses
type
TBasicPointSeriesOpener = class(TBasicPointSeries);
TsCustomLineSeriesOpener = class(TsCustomLineSeries);
function mmToPx(mm: Double; ppi: Integer): Integer;
begin
@ -304,15 +306,7 @@ end;
constructor TsWorkbookChartSource.Create(AOwner: TComponent);
begin
inherited;
SetLength(FRanges[rngX], 1);
SetLength(FRanges[rngY], 1);
SetLength(FRanges[rngLabel], 1);
SetLength(FRanges[rngColor], 1);
SetLength(FWorksheets[rngX], 1);
SetLength(FWorksheets[rngY], 1);
SetLength(FWorksheets[rngLabel], 1);
Setlength(FWorksheets[rngColor], 1);
ClearRanges;
end;
{@@ ----------------------------------------------------------------------------
@ -380,6 +374,25 @@ begin
end;
end;
procedure TsWorkbookChartSource.ClearRanges;
begin
SetLength(FRanges[rngX], 1); FRanges[rngX, 0 ] := nil;
SetLength(FRanges[rngY], 1); FRanges[rngY, 0] := nil;
SetLength(FRanges[rngLabel], 1); FRanges[rngLabel, 0] := nil;
SetLength(FRanges[rngColor], 1); FRanges[rngColor, 0] := nil;
SetLength(FWorksheets[rngX], 1); FWorksheets[rngX, 0] := nil;
SetLength(FWorksheets[rngY], 1); FWorksheets[rngY, 0] := nil;
SetLength(FWorksheets[rngLabel], 1); FWorksheets[rngLabel, 0] := nil;
SetLength(FWorksheets[rngColor], 1); FWorksheets[rngColor, 0] := nil;
FRangeStr[rngX] := '';
FRangeStr[rngY] := '';
FRangeStr[rngLabel] := '';
FRangeStr[rngColor] := '';
end;
{@@ ----------------------------------------------------------------------------
Counts the number of x or y values contained in the x/y ranges
@ -620,7 +633,10 @@ begin
// Workbook has been successfully loaded, all sheets are ready
if (lniWorkbook in AChangedItems) then
begin
ClearRanges;
Prepare;
end;
// Used worksheet has been renamed?
if (lniWorksheetRename in AChangedItems) then
@ -896,7 +912,6 @@ begin
FWorkbookSource := AValue;
if FWorkbookSource <> nil then
FWorkbookSource.AddListener(self);
// FWorkbook := GetWorkbook;
ListenerNotification([lniWorkbook, lniWorksheet]);
Prepare;
end;
@ -1017,6 +1032,8 @@ begin
Result := TBubbleSeries.Create(FChart);
src.SetYRange(1, TsBubbleSeries(ASeries).BubbleRange);
end;
ctPie:
Result := TPieSeries.Create(FChart);
else
exit(nil);
end;
@ -1079,7 +1096,7 @@ begin
ctBubble:
UpdateBubbleSeries(TsBubbleSeries(ASeries), TBubbleSeries(ser));
ctLine:
UpdateLineSeries(TsLineSeries(ASeries), TLineSeries(ser));
UpdateCustomLineSeries(TsLineSeries(ASeries), TLineSeries(ser));
ctScatter:
UpdateScatterSeries(TsScatterSeries(ASeries), TLineSeries(ser));
ctPie, ctRing:
@ -1347,7 +1364,11 @@ end;
procedure TsWorkbookChartLink.ListenerNotification(AChangedItems: TsNotificationItems;
AData: Pointer = nil);
begin
// to be completed
Unused(AData);
// Workbook has been successfully loaded, all sheets are ready
if (lniWorkbook in AChangedItems) then
ClearChart;
end;
procedure TsWorkbookChartLink.Notification(AComponent: TComponent; Operation: TOperation);
@ -1561,49 +1582,6 @@ 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(AWorkbookChart: TsChart;
AWorkbookFill: TsChartFill; ABrush: TBrush);
var
@ -1763,7 +1741,7 @@ begin
end;
end;
procedure TsWorkbookChartLink.UpdateLineSeries(AWorkbookSeries: TsLineSeries;
procedure TsWorkbookChartLink.UpdateCustomLineSeries(AWorkbookSeries: TsCustomLineSeries;
AChartSeries: TLineSeries);
const
POINTER_STYLES: array[TsChartSeriesSymbol] of TSeriesPointerstyle = (
@ -1781,19 +1759,20 @@ const
);
var
ppi: Integer;
openedWorkbookSeries: TsCustomLineSeriesOpener absolute AWorkbookSeries;
begin
ppi := GetParentForm(FChart).PixelsPerInch;
UpdateChartPen(AWorkbookSeries.Chart, AWorkbookSeries.Line, AChartSeries.LinePen);
AChartSeries.ShowLines := AWorkbookSeries.Line.Style <> clsNoLine;
AChartSeries.ShowPoints := AWorkbookSeries.ShowSymbols;
AChartSeries.ShowPoints := openedWorkbookSeries.ShowSymbols;
if AChartSeries.ShowPoints then
begin
UpdateChartBrush(AWorkbookSeries.Chart, AWorkbookSeries.Fill, AChartSeries.Pointer.Brush);
AChartSeries.Pointer.Pen.Color := AChartSeries.LinePen.Color;
AChartSeries.Pointer.Style := POINTER_STYLES[AWorkbookSeries.Symbol];
AChartSeries.Pointer.HorizSize := mmToPx(AWorkbookSeries.SymbolWidth, ppi);
AChartSeries.Pointer.VertSize := mmToPx(AWorkbookSeries.SymbolHeight, ppi);
AChartSeries.Pointer.Style := POINTER_STYLES[openedWorkbookSeries.Symbol];
AChartSeries.Pointer.HorizSize := mmToPx(openedWorkbookSeries.SymbolWidth, ppi);
AChartSeries.Pointer.VertSize := mmToPx(openedWorkbookSeries.SymbolHeight, ppi);
end;
AChartSeries.Stacked := AWorkbookSeries.Chart.StackMode <> csmSideBySide;
if AChartSeries.Source is TCalculatedChartSource then
@ -1838,7 +1817,7 @@ var
ser: TFitSeries;
s: String;
begin
UpdateLineSeries(AWorkbookSeries, AChartSeries);
UpdateCustomLineSeries(AWorkbookSeries, AChartSeries);
if AWorkbookSeries.Regression.RegressionType = rtNone then
exit;

20
components/fpspreadsheet/source/visual/fpspreadsheetctrls.pas
View File

@ -1331,12 +1331,21 @@ var
begin
for j:=0 to FListeners.Count-1 do begin
C := TComponent(FListeners[j]);
if (C <> nil) then
begin
if C.GetInterface(GUID_SpreadsheetControl, I) then
I.ListenerNotification(AChangedItems, AData)
else
raise Exception.CreateFmt('[TsWorkbookSource.NotifyListeners] Class %s is not prepared to be a spreadsheet listener.',
[C.ClassName]);
end;
end;
// Cleanup listener list from removed listeners (= set to nil) while
// NotifyListeners was running
for j := FListeners.Count-1 downto 0 do
if FListeners[j] = nil then
FListeners.Delete(j);
end;
{@@ ----------------------------------------------------------------------------
@ -1355,13 +1364,22 @@ begin
C := TComponent(FListeners[j]);
if C = AListener then
begin
FListeners.Delete(j);
FListeners[j] := nil;
// Do not delete the listener here (FListeners.Delete(j)) because
// RemoveListeners may be called while NotifyListeners is still running.
// The problem can be that a chart may destroy a listening chart source
// which would trigger RemoveListener. If the chart source then would be
// deleted from the list the NotifiyListeners loop would access
// unallocated memory --> crash
if C <> nil then
begin
if C.GetInterface(GUID_SpreadsheetControl, I) then
I.RemoveWorkbookSource
else
raise Exception.CreateFmt('Class %s not prepared for listening.',[AListener.ClassName]);
end;
end;
end;
end;
{@@ ----------------------------------------------------------------------------