From 2053c444cbb766d81634e62987077add37353df6 Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Sun, 5 Nov 2023 19:05:11 +0000 Subject: [PATCH] fpspreadsheet: Support hatched fills in charts and writing to ods. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9010 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- .../other/chart/barchart_write_demo.lpi | 73 +++++++++ .../other/chart/barchart_write_demo.lpr | 71 +++++++++ .../other/chart/radarchart_write_demo.lpr | 4 +- .../chart/regressionchart_write_demo.lpr | 4 +- .../examples/other/chart/write_chart_demo.lpr | 10 +- .../fpspreadsheet/source/common/fpschart.pas | 140 ++++++++++++++---- .../source/common/fpsopendocumentchart.pas | 76 ++++++++-- 7 files changed, 324 insertions(+), 54 deletions(-) create mode 100644 components/fpspreadsheet/examples/other/chart/barchart_write_demo.lpi create mode 100644 components/fpspreadsheet/examples/other/chart/barchart_write_demo.lpr diff --git a/components/fpspreadsheet/examples/other/chart/barchart_write_demo.lpi b/components/fpspreadsheet/examples/other/chart/barchart_write_demo.lpi new file mode 100644 index 000000000..97c020093 --- /dev/null +++ b/components/fpspreadsheet/examples/other/chart/barchart_write_demo.lpi @@ -0,0 +1,73 @@ + + + + + + + + + + + + + + <UseAppBundle Value="False"/> + <ResourceType Value="res"/> + </General> + <BuildModes> + <Item Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + </RunParams> + <RequiredPackages> + <Item> + <PackageName Value="laz_fpspreadsheet"/> + </Item> + </RequiredPackages> + <Units> + <Unit> + <Filename Value="barchart_write_demo.lpr"/> + <IsPartOfProject Value="True"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="barchart_write_demo"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf3"/> + </Debugging> + </Linking> + <Other> + <ConfigFile> + <WriteConfigFilePath Value=""/> + </ConfigFile> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions> + <Item> + <Name Value="EAbort"/> + </Item> + <Item> + <Name Value="ECodetoolError"/> + </Item> + <Item> + <Name Value="EFOpenError"/> + </Item> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/components/fpspreadsheet/examples/other/chart/barchart_write_demo.lpr b/components/fpspreadsheet/examples/other/chart/barchart_write_demo.lpr new file mode 100644 index 000000000..2e622801e --- /dev/null +++ b/components/fpspreadsheet/examples/other/chart/barchart_write_demo.lpr @@ -0,0 +1,71 @@ +program barchart_write_demo; + +{.$DEFINE DARK_MODE} + +uses + SysUtils, + fpspreadsheet, fpstypes, fpsUtils, fpschart, xlsxooxml, fpsopendocument; +var + b: TsWorkbook; + sheet: TsWorksheet; + ch: TsChart; + ser: TsChartSeries; +begin + b := TsWorkbook.Create; + try + // worksheet + sheet := b.AddWorksheet('bar_series'); + + // Enter data + sheet.WriteText( 0, 0, 'School Grades'); + sheet.WriteFont( 0, 0, '', 12, [fssBold], scBlack); + sheet.WriteText( 2, 0, ''); sheet.WriteText ( 2, 1, 'Student 1'); sheet.WriteText ( 2, 2, 'Student 2'); + sheet.WriteText( 3, 0, 'Biology'); sheet.WriteNumber( 3, 1, 12); sheet.WriteNumber( 3, 2, 15); + sheet.WriteText( 4, 0, 'History'); sheet.WriteNumber( 4, 1, 11); sheet.WriteNumber( 4, 2, 13); + sheet.WriteText( 5, 0, 'French'); sheet.WriteNumber( 5, 1, 16); sheet.WriteNumber( 5, 2, 11); + sheet.WriteText( 6, 0, 'English'); sheet.WriteNumber( 6, 1, 18); sheet.WriteNumber( 6, 2, 11); + sheet.WriteText( 7, 0, 'Sports'); sheet.WriteNumber( 7, 1, 16); sheet.WriteNumber( 7, 2, 7); + sheet.WriteText( 8, 0, 'Maths'); sheet.WriteNumber( 8, 1, 10); sheet.WriteNumber( 8, 2, 17); + sheet.WriteText( 9, 0, 'Physics'); sheet.WriteNumber( 9, 1, 12); sheet.WriteNumber( 9, 2, 19); + sheet.WriteText(10, 0, 'Computer'); sheet.WriteNumber(10, 1, 16); sheet.WriteNumber(10, 2, 18); + + // Create chart: left/top in cell D4, 160 mm x 100 mm + ch := b.AddChart(sheet, 2, 3, 120, 100); + + // Chart properties + ch.Border.Style := clsNoLine; + ch.Title.Caption := 'School Grades'; + ch.Title.Font.Style := [fssBold]; + ch.Legend.Border.Style := clsNoLine; + ch.XAxis.Caption := ''; + ch.YAxis.Caption := ''; + ch.YAxis.AxisLine.Color := scSilver; + ch.YAxis.MajorTicks := []; + + // Add 1st bar series ("Student 1") + ser := TsBarSeries.Create(ch); + ser.SetTitleAddr(2, 1); + ser.SetLabelRange(3, 0, 10, 0); + ser.SetYRange(3, 1, 10, 1); + ser.Line.Color := scDarkRed; + ser.Fill.Style := cfsHatched; + ser.Fill.Hatch := ch.Hatches.AddHatch('Crossed', chsDouble, scDarkRed, 2, 45, true); + ser.Fill.Color := scRed; + + // Add 2nd bar series ("Student 2") + ser := TsBarSeries.Create(ch); + ser.SetTitleAddr(2, 2); + ser.SetLabelRange(3, 0, 10, 0); + ser.SetYRange(3, 2, 10, 2); + ser.Line.Color := scDarkBlue; + ser.Fill.Style := cfsHatched; + ser.Fill.Hatch := ch.Hatches.AddHatch('Forward', chsSingle, scWhite, 1.5, 45, true); + ser.Fill.Color := scBlue; + +// b.WriteToFile('bars.xlsx', true); // Excel fails to open the file + b.WriteToFile('bars.ods', true); + finally + b.Free; + end; +end. + diff --git a/components/fpspreadsheet/examples/other/chart/radarchart_write_demo.lpr b/components/fpspreadsheet/examples/other/chart/radarchart_write_demo.lpr index 07e709516..cf4371863 100644 --- a/components/fpspreadsheet/examples/other/chart/radarchart_write_demo.lpr +++ b/components/fpspreadsheet/examples/other/chart/radarchart_write_demo.lpr @@ -48,7 +48,7 @@ begin ser.SetLabelRange(3, 0, 10, 0); ser.SetYRange(3, 1, 10, 1); ser.Line.Color := scDarkRed; - ser.Fill.FgColor := scRed; + ser.Fill.Color := scRed; ser.Fill.Transparency := 0.35; // Add 2nd radar series ("Student 2") @@ -57,7 +57,7 @@ begin ser.SetLabelRange(3, 0, 10, 0); ser.SetYRange(3, 2, 10, 2); ser.Line.Color := scDarkBlue; - ser.Fill.FgColor := scBlue; + ser.Fill.Color := scBlue; ser.Fill.Transparency := 0.35; b.WriteToFile('school-grades.xlsx', true); // Excel fails to open the file diff --git a/components/fpspreadsheet/examples/other/chart/regressionchart_write_demo.lpr b/components/fpspreadsheet/examples/other/chart/regressionchart_write_demo.lpr index 1a91452ca..6f25dfc78 100644 --- a/components/fpspreadsheet/examples/other/chart/regressionchart_write_demo.lpr +++ b/components/fpspreadsheet/examples/other/chart/regressionchart_write_demo.lpr @@ -59,8 +59,8 @@ begin ser.Regression.Equation.YName := 'Y'; ser.Regression.Equation.Border.Style := clsSolid; ser.Regression.Equation.Border.Color := scRed; - ser.Regression.Equation.Fill.Style := fsSolidFill; - ser.Regression.Equation.Fill.FgColor := scSilver; + ser.Regression.Equation.Fill.Style := cfsSolid; + ser.Regression.Equation.Fill.Color := scSilver; ser.Regression.Equation.NumberFormat := '0.000'; //ser.Regression.Equation.Top := 5; //ser.Regression.Equation.Left := 5; diff --git a/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr b/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr index c9bfb0620..9cb0cacdc 100644 --- a/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr +++ b/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr @@ -63,7 +63,7 @@ begin ser.SetXRange(r1, 0, r2, 0); // is used only by scatter series ser.SetYRange(r1, 1, r2, 1); ser.Line.Color := scBlue; - ser.Fill.FgColor := scBlue; + ser.Fill.Color := scBlue; ser.SetFillColorRange(r1, 4, r2, 4); ser.DataLabels := [cdlPercentage, cdlSymbol]; if (ser is TsLineSeries) then @@ -88,7 +88,7 @@ begin ser.SetXRange(r1, 0, r2, 0); ser.SetYRange(r1, 2, r2, 2); ser.Line.Color := scRed; - ser.Fill.FgColor := scRed; + ser.Fill.Color := scRed; end; {$IFDEF DARK_MODE} @@ -96,9 +96,9 @@ begin ch.Border.Color := scWhite; ch.PlotArea.Background.FgColor := $1F1F1F; {$ELSE} - ch.Background.FgColor := scWhite; + ch.Background.Color := scWhite; ch.Border.Color := scBlack; - ch.PlotArea.Background.FgColor := $F0F0F0; + ch.PlotArea.Background.Color := $F0F0F0; {$ENDIF} // Background and wall working ch.Background.Style := cfsSolid; @@ -155,7 +155,7 @@ begin ch.Legend.Font.Color := scBlue; ch.Legend.Border.Width := 0.3; // mm ch.Legend.Border.Color := scGray; - ch.Legend.Background.FgColor := $F0F0F0; + ch.Legend.Background.Color := $F0F0F0; ch.Legend.Background.Style := cfsSolid; //ch.Legend.CanOverlapPlotArea := true; ch.Legend.Position := lpBottom; diff --git a/components/fpspreadsheet/source/common/fpschart.pas b/components/fpspreadsheet/source/common/fpschart.pas index 41ff57b38..f837b3aa2 100644 --- a/components/fpspreadsheet/source/common/fpschart.pas +++ b/components/fpspreadsheet/source/common/fpschart.pas @@ -53,7 +53,7 @@ type EndIntensity: Double; // 0.0 ... 1.0 Border: Double; // 0.0 ... 1.0 CenterX, CenterY: Double; // 0.0 ... 1.0 - Angle: Integer; // degrees + Angle: Double; // degrees constructor Create; end; @@ -63,36 +63,56 @@ type procedure SetItem(AIndex: Integer; AValue: TsChartGradient); function AddGradient(AName: String; AStyle: TsChartGradientStyle; AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity: Double; - ABorder, ACenterX, ACenterY: Double; AAngle: Integer): Integer; + ABorder, ACenterX, ACenterY, AAngle: Double): Integer; public function AddAxialGradient(AName: String; AStartColor, AEndColor: TsColor; - AStartIntensity, AEndIntensity, ABorder: Double; AAngle: Integer): Integer; + AStartIntensity, AEndIntensity, ABorder, AAngle: Double): Integer; function AddEllipticGradient(AName: String; AStartColor, AEndColor: TsColor; - AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY: Double; - AAngle: Integer): Integer; + AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY, AAngle: Double): Integer; function AddLinearGradient(AName: String; AStartColor, AEndColor: TsColor; - AStartIntensity, AEndIntensity, ABorder: Double; AAngle: Integer): Integer; + AStartIntensity, AEndIntensity, ABorder, AAngle: Double): Integer; function AddRadialGradient(AName: String; AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity, ABorder: Double; ACenterX, ACenterY: Double): Integer; function AddRectangularGradient(AName: String; AStartColor, AEndColor: TsColor; - AStartIntensity, AEndIntensity: Double; ABorder, ACenterX, ACenterY: Double; - AAngle: Integer): Integer; + AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY, AAngle: Double): Integer; function AddSquareGradient(AName: String; AStartColor, AEndColor: TsColor; - AStartIntensity, AEndIntensity: Double; ABorder, ACenterX, ACenterY: Double; - AAngle: Integer): Integer; + AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY, AAngle: Double): Integer; function IndexOfName(AName: String): Integer; function FindByName(AName: String): TsChartGradient; property Items[AIndex: Integer]: TsChartGradient read GetItem write SetItem; default; end; - TsChartFillStyle = (cfsNoFill, cfsSolid, cfsGradient); + TsChartHatchStyle = (chsSingle, chsDouble, chsTriple); + + TsChartHatch = class + Name: String; + Style: TsChartHatchStyle; + LineColor: TsColor; + LineDistance: Double; // mm + LineAngle: Double; // degrees + Filled: Boolean; // filled with background color or not + end; + + TsChartHatchList = class(TFPObjectList) + private + function GetItem(AIndex: Integer): TsChartHatch; + procedure SetItem(AIndex: Integer; AValue: TsChartHatch); + public + function AddHatch(AName: String; AStyle: TsChartHatchStyle; + ALineColor: TsColor; ALineDistance, ALineAngle: Double; AFilled: Boolean): Integer; + function FindByName(AName: String): TsChartHatch; + function IndexOfName(AName: String): Integer; + property Items[AIndex: Integer]: TsChartHatch read GetItem write SetItem; default; + end; + + TsChartFillStyle = (cfsNoFill, cfsSolid, cfsGradient, cfsHatched); TsChartFill = class Style: TsChartFillStyle; - FgColor: TsColor; - BgColor: TsColor; + Color: TsColor; Gradient: Integer; + Hatch: Integer; Transparency: Double; // 0.0 ... 1.0 end; @@ -447,6 +467,7 @@ type FLineStyles: TsChartLineStyleList; FGradients: TsChartGradientList; + FHatches: TsChartHatchList; function GetCategoryLabelRange: TsCellRange; public @@ -517,6 +538,7 @@ type { Style lists } property LineStyles: TsChartLineStyleList read FLineStyles; property Gradients: TsChartGradientList read FGradients; + property Hatches: TsChartHatchList read FHatches; end; TsChartList = class(TObjectList) @@ -544,23 +566,23 @@ end; function TsChartGradientList.AddAxialGradient(AName: String; AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity, ABorder: Double; - AAngle: Integer): Integer; + AAngle: Double): Integer; begin Result := AddGradient(AName, cgsAxial, AStartColor, AEndColor, AStartIntensity, AEndIntensity, ABorder, 0.0, 0.0, AAngle); end; function TsChartGradientList.AddEllipticGradient(AName: String; - AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity: Double; - ABorder, ACenterX, ACenterY: Double; AAngle: Integer): Integer; + AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity, ABorder: Double; + ACenterX, ACenterY, AAngle: Double): Integer; begin Result := AddGradient(AName, cgsElliptic, AStartColor, AEndColor, AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY, AAngle); end; function TsChartGradientList.AddGradient(AName: String; AStyle: TsChartGradientStyle; - AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity: Double; - ABorder, ACenterX, ACenterY: Double; AAngle: Integer): Integer; + AStartColor, AEndColor: TsColor; + AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY, AAngle: Double): Integer; var item: TsChartGradient; begin @@ -586,32 +608,32 @@ begin end; function TsChartGradientList.AddLinearGradient(AName: String; - AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity, ABorder: Double; - AAngle: Integer): Integer; + AStartColor, AEndColor: TsColor; + AStartIntensity, AEndIntensity, ABorder,AAngle: Double): Integer; begin Result := AddGradient(AName, cgsLinear, AStartColor, AEndColor, AStartIntensity, AEndIntensity, ABorder, 0.0, 0.0, AAngle); end; function TsChartGradientList.AddRadialGradient(AName: String; - AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity, ABorder: Double; - ACenterX, ACenterY: Double): Integer; + AStartColor, AEndColor: TsColor; + AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY: Double): Integer; begin Result := AddGradient(AName, cgsRadial, AStartColor, AEndColor, AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY, 0); end; function TsChartGradientList.AddRectangularGradient(AName: String; - AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity: Double; - ABorder, ACenterX, ACenterY: Double; AAngle: Integer): Integer; + AStartColor, AEndColor: TsColor; + AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY, AAngle: Double): Integer; begin Result := AddGradient(AName, cgsRectangular, AStartColor, AEndColor, AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY, AAngle); end; function TsChartGradientList.AddSquareGradient(AName: String; - AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity: Double; - ABorder, ACenterX, ACenterY: Double; AAngle: Integer): Integer; + AStartColor, AEndColor: TsColor; + AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY, AAngle: Double): Integer; begin Result := AddGradient(AName, cgsSquare, AStartColor, AEndColor, AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY, AAngle); @@ -647,6 +669,60 @@ begin end; +{ TsChartHatchList } + +function TsChartHatchList.AddHatch(AName: String; AStyle: TsChartHatchStyle; + ALineColor: TsColor; ALineDistance, ALineAngle: Double; AFilled: Boolean): Integer; +var + item: TsChartHatch; +begin + if AName = '' then + AName := 'Hatch' + IntToStr(Count+1); + Result := IndexOfName(AName); + if Result = -1 then + begin + item := TsChartHatch.Create; + Result := inherited Add(item); + end else + item := Items[Result]; + item.Name := AName; + item.Style := AStyle; + item.LineColor := ALineColor; + item.LineDistance := ALineDistance; + item.LineAngle := ALineAngle; + item.Filled := AFilled; +end; + +function TsChartHatchList.FindByName(AName: String): TsChartHatch; +var + idx: Integer; +begin + idx := IndexOfName(AName); + if idx > -1 then + Result := Items[idx] + else + Result := nil; +end; + +function TsChartHatchList.GetItem(AIndex: Integer): TsChartHatch; +begin + Result := TsChartHatch(inherited Items[AIndex]); +end; + +function TsChartHatchList.IndexOfName(AName: String): Integer; +begin + for Result := 0 to Count-1 do + if SameText(Items[Result].Name, AName) then + exit; + Result := -1; +end; + +procedure TsChartHatchList.SetItem(AIndex: Integer; AValue: TsChartHatch); +begin + inherited Items[AIndex] := AValue; +end; + + { TsChartLineStyle } function TsChartLineStyle.GetID: String; @@ -708,9 +784,9 @@ begin inherited Create(AChart); FBackground := TsChartFill.Create; FBackground.Style := cfsSolid; - FBackground.BgColor := scWhite; - FBackground.FgColor := scWhite; + FBackground.Color := scWhite; FBackground.Gradient := -1; + FBackground.Hatch := -1; FBorder := TsChartLine.Create; FBorder.Style := clsSolid; FBorder.Width := PtsToMM(DEFAULT_CHART_LINEWIDTH); @@ -832,9 +908,9 @@ begin FFill := TsChartFill.Create; FFill.Style := cfsSolid; - FFill.FgColor := DEFAULT_SERIES_COLORS[idx mod Length(DEFAULT_SERIES_COLORS)]; - FFill.BgColor := DEFAULT_SERIES_COLORS[idx mod Length(DEFAULT_SERIES_COLORS)]; + FFill.Color := DEFAULT_SERIES_COLORS[idx mod Length(DEFAULT_SERIES_COLORS)]; FFill.Gradient := -1; + FFill.Hatch := -1; FLine := TsChartLine.Create; FLine.Style := clsSolid; @@ -1083,7 +1159,7 @@ begin Border.Width := PtsToMM(DEFAULT_CHART_LINEWIDTH); Border.Color := scBlack; Fill := TsChartFill.Create; - Fill.FgColor := scWhite; + Fill.Color := scWhite; XName := 'x'; YName := 'f(x)'; end; @@ -1184,6 +1260,7 @@ begin clsLongDashDotDot := FLineStyles.Add('long dash-dot-dot', 500, 1, 100, 2, 200, true); FGradients := TsChartGradientList.Create; + FHatches := TsChartHatchList.Create; FSheetIndex := 0; FRow := 0; @@ -1249,6 +1326,7 @@ begin FSubtitle.Free; FFloor.Free; FPlotArea.Free; + FHatches.Free; FGradients.Free; FLineStyles.Free; inherited; diff --git a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas index b9839cbca..0c0cae14d 100644 --- a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas +++ b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas @@ -49,6 +49,7 @@ type // Object X/styles.xml procedure WriteObjectStyles(AStream: TStream; AChart: TsChart); procedure WriteObjectGradientStyles(AStream: TStream; AChart: TsChart; AIndent: Integer); + procedure WriteObjectHatchStyles(AStream: TStream; AChart: TsChart; AIndent: Integer); procedure WriteObjectLineStyles(AStream: TStream; AChart: TsChart; AIndent: Integer); // Object X/content.xml @@ -108,6 +109,10 @@ const 'linear', 'axial', 'radial', 'ellipsoid', 'square', 'rectangular' ); + HATCH_STYLES: array[TsChartHatchStyle] of string = ( + 'single', 'double', 'triple' + ); + LABEL_POSITION: array[TsChartLabelPosition] of string = ( '', 'outside', 'inside', 'center'); @@ -432,23 +437,18 @@ end; function TsSpreadOpenDocChartWriter.GetChartFillStyleGraphicPropsAsXML(AChart: TsChart; AFill: TsChartFill): String; var - fillStr: String; - fillColorStr: String; - fillOpacity: String = ''; gradient: TsChartGradient; - gradientStr: String; + hatch: TsChartHatch; + fillStr: String = ''; begin case AFill.Style of cfsNoFill: Result := 'draw:fill="none" '; cfsSolid: - begin - fillStr := 'draw:fill="solid" '; - fillColorStr := 'draw:fill-color="' + ColorToHTMLColorStr(AFill.FgColor) + '" '; - if AFill.Transparency > 0 then - fillOpacity := Format('draw:opacity="%.0f%%" ', [(1.0 - AFill.Transparency)*100], FPointSeparatorSettings); - Result := fillStr + fillColorStr + fillOpacity; - end; + Result := Format( + 'draw:fill="solid" draw:fill-color="%s" ', + [ ColorToHTMLColorStr(AFill.Color) ] + ); cfsGradient: begin gradient := AChart.Gradients[AFill.Gradient]; @@ -459,7 +459,23 @@ begin [ ASCIIName(gradient.Name) ] ); end; + cfsHatched: + begin + hatch := AChart.Hatches[AFill.Hatch]; + if hatch.Filled then + fillStr := 'draw:fill-hatch-solid="true" '; + Result := Format( + 'draw:fill="hatch" draw:fill-color="%s" ' + + 'draw:fill-hatch-name="%s" %s', + [ ColorToHTMLColorStr(AFill.Color), ASCIIName(hatch.Name), fillStr ] + ); + end; end; + if (AFill.Style <> cfsNoFill) and (AFill.Transparency > 0) then + Result := Result + Format('draw:opacity="%.0f%%" ', + [ (1.0 - AFill.Transparency) * 100 ], + FPointSeparatorSettings + ); end; { @@ -1323,12 +1339,13 @@ begin case gradient.Style of cgsLinear, cgsAxial: style := style + Format( - 'draw:angle="%ddeg" ', - [ gradient.Angle ] + 'draw:angle="%.0fdeg" ', + [ gradient.Angle ], + FPointSeparatorSettings ); cgsElliptic, cgsSquare, cgsRectangular: style := style + Format( - 'draw:cx="%.0f%%" draw:cy="%.0f%%" draw:angle="%ddeg" ', + 'draw:cx="%.0f%%" draw:cy="%.0f%%" draw:angle="%.0fdeg" ', [ gradient.CenterX * 100, gradient.CenterY * 100, gradient.Angle ], FPointSeparatorSettings ); @@ -1345,6 +1362,36 @@ begin end; end; +procedure TsSpreadOpenDocChartWriter.WriteObjectHatchStyles(AStream: TStream; + AChart: TsChart; AIndent: Integer); +var + indent: String; + style: String; + i: Integer; + hatch: TsChartHatch; +begin + indent := DupeString(' ', AIndent); + for i := 0 to AChart.Hatches.Count-1 do + begin + hatch := AChart.Hatches[i]; + style := Format(indent + + '<draw:hatch draw:name="%s" draw:display-name="%s" ' + + 'draw:style="%s" ' + + 'draw:color="%s" ' + + 'draw:distance="%.2fmm" ' + + 'draw:rotation="%.0f" />', + [ ASCIIName(hatch.Name), hatch.Name, + HATCH_STYLES[hatch.Style], + ColorToHTMLColorStr(hatch.LineColor), + hatch.LineDistance, + hatch.LineAngle*10 + ], + FPointSeparatorSettings + ); + AppendToStream(AStream, style); + end; +end; + procedure TsSpreadOpenDocChartWriter.WriteObjectLineStyles(AStream: TStream; AChart: TsChart; AIndent: Integer); const @@ -1506,6 +1553,7 @@ begin WriteObjectLineStyles(AStream, AChart, 4); WriteObjectGradientStyles(AStream, AChart, 4); + WriteObjectHatchStyles(AStream, AChart, 4); AppendToStream(AStream, ' </office:styles>' + LE +