From 623d0bd4c5c4380675de7685a3d956e0a4fecc02 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Mon, 23 Oct 2023 00:03:45 +0000 Subject: [PATCH] fpspreadsheet: Introducing ChartStyles for ods writer. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8971 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../examples/other/chart/write_chart_demo.lpr | 11 +++ .../fpspreadsheet/laz_fpspreadsheet.lpk | 6 +- .../fpspreadsheet/source/common/fpschart.pas | 22 ++++- .../source/common/fpschartstyles.pas | 98 +++++++++++++++++++ .../source/common/fpsopendocument.pas | 80 ++++++++++++++- 5 files changed, 209 insertions(+), 8 deletions(-) create mode 100644 components/fpspreadsheet/source/common/fpschartstyles.pas diff --git a/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr b/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr index 2bf0e3352..adae1f950 100644 --- a/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr +++ b/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr @@ -8,6 +8,8 @@ var ch: TsChart; ser: TsChartSeries; i: Integer; + bg: TsChartFill; + frm: TsChartLine; begin b := TsWorkbook.Create; try @@ -25,6 +27,15 @@ begin ser.SetTitleAddr(0, 1); ser.SetLabelRange(1, 0, 7, 0); ser.SetYRange(1, 1, 7, 1); + + bg.FgColor := scYellow; + bg.Style := fsSolidFill; + ch.Background := bg; + + frm.color := scRed; + frm.Style := clsSolid; + ch.Border := frm; + ch.Title.Caption := 'HALLO'; ch.Title.Visible := true; ch.SubTitle.Caption := 'hallo'; diff --git a/components/fpspreadsheet/laz_fpspreadsheet.lpk b/components/fpspreadsheet/laz_fpspreadsheet.lpk index a9d3f21da..97366824d 100644 --- a/components/fpspreadsheet/laz_fpspreadsheet.lpk +++ b/components/fpspreadsheet/laz_fpspreadsheet.lpk @@ -33,7 +33,7 @@ This package is all you need if you don't want graphical components (such as grids and charts)."/> - + @@ -305,6 +305,10 @@ This package is all you need if you don't want graphical components (such a + + + + diff --git a/components/fpspreadsheet/source/common/fpschart.pas b/components/fpspreadsheet/source/common/fpschart.pas index a3ec0d3b9..9d02f60de 100644 --- a/components/fpspreadsheet/source/common/fpschart.pas +++ b/components/fpspreadsheet/source/common/fpschart.pas @@ -1,6 +1,7 @@ unit fpschart; {$mode objfpc}{$H+} +{$modeswitch advancedrecords} interface @@ -13,7 +14,7 @@ const {@@ Pre-defined chart line styles given as indexes into the chart's LineStyles list. Get their value in the constructor of TsChart. Default here to -1 - while is the code for a solid line, just in case that something goes wrong } + which is the code for a solid line, just in case that something goes wrong } var clsFineDot: Integer = -1; clsDot: Integer = -1; @@ -30,6 +31,7 @@ type Style: TsFillStyle; FgColor: TsColor; BgColor: TsColor; + class operator = (A, B: TsChartFill): Boolean; end; TsChartLineSegment = record @@ -193,7 +195,8 @@ type end; TsChartSeriesSymbol = ( - cssRect, cssDiamond, cssTriangle, cssTriangleDown, cssCircle, cssStar + cssRect, cssDiamond, cssTriangle, cssTriangleDown, cssTriangleLeft, + cssTriangleRight, cssCircle, cssStar, cssX, cssPlus, cssAsterisk ); TsLineSeries = class(TsChartSeries) @@ -282,6 +285,10 @@ type { Height of the chart, in mm } property Height: double read FHeight write FHeight; + { Attributes of the entire chart background } + property Background: TsChartFill read FBackground write FBackground; + property Border: TsChartLine read FBorder write FBorder; + { Attributes of the plot area (rectangle enclosed by axes) } property PlotArea: TsChartFillElement read FPlotArea write FPlotArea; { Attributes of the floor of a 3D chart } @@ -323,6 +330,14 @@ implementation const DEFAULT_LINE_WIDTH = 0.75; // pts +{ TsChartFill } + +class operator TsChartFill.= (A, B: TsChartFill): Boolean; +begin + Result := (A.Style = B.Style) and (A.FgColor = B.FgColor) and (A.BgColor = B.BgColor); +end; + + { TsChartLineStyle } function TsChartLineStyle.GetID: String; @@ -648,6 +663,9 @@ begin FWidth := 12; FHeight := 9; + FBackground.Style := fsNoFill; + FBorder.Style := clsNoLine; + FPlotArea := TsChartFillElement.Create(self); FFloor := TsChartFillElement.Create(self); diff --git a/components/fpspreadsheet/source/common/fpschartstyles.pas b/components/fpspreadsheet/source/common/fpschartstyles.pas new file mode 100644 index 000000000..3a45be860 --- /dev/null +++ b/components/fpspreadsheet/source/common/fpschartstyles.pas @@ -0,0 +1,98 @@ +unit fpsChartStyles; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, SysUtils, fpsTypes, fpsChart; + +type + TsChartStyle = class + public + procedure ApplyToChart(AChart: TsChart); virtual; abstract; + procedure ExtractFromChart(AChart: TsChart); virtual; abstract; + end; + + TsChartBackgroundStyle = class(TsChartStyle) + private + FBackground: TsChartFill; + FBorder: TsChartLine; + public + procedure ApplyToChart(AChart: TsChart); override; + procedure ExtractFromChart(AChart: TsChart); override; + property Background: TsChartFill read FBackground; + property Border: TsChartLine read FBorder; + end; + + TsChartStyleList = class(TFPList) + public + destructor Destroy; override; + procedure Clear; + function FindChartBackgroundStyle(AChart: TsChart): Integer; + end; + +implementation + +{ TsChartBackgroundstyle } + +procedure TsChartBackgroundStyle.ApplyToChart(AChart: TsChart); +begin + AChart.Background := FBackground; + AChart.Border := FBorder; +end; + +procedure TsChartBackgroundStyle.ExtractFromChart(AChart: TsChart); +begin + FBackground := AChart.Background; + FBorder := AChart.Border; +end; + +{ TsChartStyleList } + +destructor TsChartStyleList.Destroy; +begin + Clear; + inherited; +end; + +procedure TsChartStyleList.Clear; +var + j: Integer; +begin + for j := 0 to Count-1 do + TsChartStyle(Items[j]).Free; + inherited Clear; +end; + +{ Searches whether the background style of the specified chart is already in the + list. If not, a new style is created and added. + Returns the index of the style. } +function TsChartStyleList.FindChartBackgroundStyle(AChart: TsChart): Integer; +var + newStyle, style: TsChartBackgroundStyle; + i: Integer; +begin + Result := -1; + newStyle := TsChartBackgroundStyle.Create; + newStyle.ExtractFromChart(AChart); + for i := 0 to Count-1 do + begin + if (TsChartStyle(Items[i]) is TsChartBackgroundStyle) then + begin + style := TsChartBackgroundStyle(Items[i]); + if style.FBackground = newStyle.FBackground then + begin + Result := i; + break; + end; + end; + end; + if Result = -1 then + Result := Add(newStyle) + else + newStyle.Free; +end; + +end. + diff --git a/components/fpspreadsheet/source/common/fpsopendocument.pas b/components/fpspreadsheet/source/common/fpsopendocument.pas index 12cab99b1..1029eff3e 100644 --- a/components/fpspreadsheet/source/common/fpsopendocument.pas +++ b/components/fpspreadsheet/source/common/fpsopendocument.pas @@ -224,6 +224,7 @@ type TsSpreadOpenDocWriter = class(TsCustomSpreadWriter) private + FChartStyleList: TFPList; FColumnStyleList: TFPList; FRowStyleList: TFPList; FRichTextFontList: TStringList; @@ -318,6 +319,7 @@ type out AStyleName: String; out AHeight: Single); } procedure InternalWriteToStream(AStream: TStream); + procedure ListAllChartStyles; procedure ListAllColumnStyles; procedure ListAllHeaderFooterFonts; procedure ListAllNumFormats; override; @@ -374,7 +376,7 @@ uses StrUtils, Variants, LazFileUtils, URIParser, LazUTF8, {%H-}fpsPatches, fpsStrings, fpsStreams, fpsCrypto, fpsClasses, fpspreadsheet, - fpsExprParser, fpsImages, fpsConditionalFormat; + fpsExprParser, fpsImages, fpsConditionalFormat, fpsChartStyles; const LE = LineEnding; @@ -509,6 +511,11 @@ const '', 'bar', 'line', 'area', 'barLine', 'scatter' ); + CHART_SYMBOL_NAMES: array[TsChartSeriesSymbol] of String = ( + 'square', 'diamond', 'arrow-up', 'arrow-down', 'arrow-left', + 'arrow-right', 'circle', 'star', 'x', 'plus', 'asterisk' + ); // unsupported: bow-tie, hourglass, horizontal-bar, vertical-bar + function CFOperandToStr(v: variant; AWorksheet: TsWorksheet; const AFormatSettings: TFormatSettings): String; @@ -5823,6 +5830,7 @@ var begin { Analyze the workbook and collect all information needed } ListAllNumFormats; + ListAllChartStyles; ListAllColumnStyles; ListAllRowStyles; ListAllHeaderFooterFonts; @@ -5864,6 +5872,22 @@ begin end; end; +procedure TsSpreadOpenDocWriter.ListAllChartStyles; +var + book: TsWorkbook; + chart: TsChart; + i: Integer; + styles: TsChartStyleList; +begin + book := TsWorkbook(FWorkbook); + styles := TsChartStyleList(FChartStyleList); + for i := 0 to book.GetChartCount-1 do + begin + chart := book.GetChartByIndex(i); + styles.FindChartBackGroundStyle(chart); + end; +end; + procedure TsSpreadOpenDocWriter.ListAllColumnStyles; var i, j, c: Integer; @@ -6677,6 +6701,7 @@ end; procedure TsSpreadOpenDocWriter.WriteChart(AStream: TStream; AChart: TsChart); var chartClass: String; + idx: Integer; begin AppendToStream(AStream, XML_HEADER + LE); @@ -6731,12 +6756,14 @@ begin if chartClass <> '' then chartClass := ' chart:class="chart:' + chartClass + '"'; + idx := TsChartStyleList(FChartStyleList).FindChartBackgroundStyle(AChart); AppendToStream(AStream, Format( ' ' + LE, + ' xlink:type="simple"' + chartClass + ' chart:style-name="ch%d"> ' + LE, [ AChart.Width, // Width, Height are in mm - AChart.Height + AChart.Height, + idx + 1 ], FPointSeparatorSettings )); @@ -6941,6 +6968,45 @@ end; { To do: The list of styles must be updated to the real chart element settings. } procedure TsSpreadOpenDocWriter.WriteChartStyles(AStream: TStream; AChart: TsChart; AIndent: Integer); + + function GetChartBackgroundStyleXML(AIndent: Integer): String; + var + ind: String; + idx: Integer; + style: TsChartBackgroundStyle; + s, drawStroke, strokeColor, drawFillColor: String; + begin + idx := TsChartStyleList(FChartStyleList).FindChartBackgroundStyle(AChart); + if idx = -1 then + raise Exception.Create('Chart background style not found.'); + style := TsChartBackgroundStyle(FChartStyleList[idx]); + + case style.Border.Style of + clsNoLine: s := 'none'; + clsSolid: s := 'solid'; + else s := 'none'; // FIXME: get correct line styles from chart + end; + drawStroke := 'draw:stroke="' + s + '" '; + + if style.Border.Style <> clsNoLine then + strokeColor := 'svg:stroke-color="' + ColorToHTMLColorStr(style.Border.Color) + '" ' + else + strokeColor := ''; + + if style.Background.Style = fsSolidFill then + drawFillColor := 'draw:fill-color="' + ColorToHTMLColorStr(style.Background.FGColor) + '" ' + else + drawFillColor := ''; + + ind := DupeString(' ', AIndent); + Result := Format( + ind + '' + LE + + ind + ' ' + LE + + ind + '' + LE, + [ idx+1, drawStroke, strokeColor, drawFillColor ] + ); + end; + var ind: String; begin @@ -6953,10 +7019,12 @@ begin ind + ' ' + LE + // ch1: style for element + GetChartBackgroundStyleXML(AIndent + 2) + + { ind + ' ' + LE + - ind + ' ' + LE + + ind + ' ' + LE + // ' ind + ' ' + LE + - + } // ch2: style for element ind + ' ' + LE + ind + ' ' + LE + @@ -8956,6 +9024,7 @@ constructor TsSpreadOpenDocWriter.Create(AWorkbook: TsBasicWorkbook); begin inherited Create(AWorkbook); + FChartStyleList := TsChartStyleList.Create; FColumnStyleList := TFPList.Create; FRowStyleList := TFPList.Create; FRichTextFontList := TStringList.Create; @@ -8980,6 +9049,7 @@ begin FRichTextFontList.Free; // Do not destroy fonts, they are owned by Workbook FHeaderFooterFontList.Free; + FChartStyleList.Free; inherited Destroy; end;