diff --git a/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr b/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr index 4b2ccc7e7..c9bfb0620 100644 --- a/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr +++ b/components/fpspreadsheet/examples/other/chart/write_chart_demo.lpr @@ -24,7 +24,9 @@ var begin b := TsWorkbook.Create; try - // 1st sheet + // ------------------------------------------------------------------------- + // 1st sheet + // ------------------------------------------------------------------------- sheet1 := b.AddWorksheet('test1'); sheet1.WriteText(0, 1, '1+sin(x)'); sheet1.WriteText(0, 2, '1+sin(x/2)'); @@ -99,9 +101,9 @@ begin ch.PlotArea.Background.FgColor := $F0F0F0; {$ENDIF} // Background and wall working - ch.Background.Style := fsSolidFill; + ch.Background.Style := cfsSolid; ch.Border.Style := clsSolid; - ch.PlotArea.Background.Style := fsSolidFill; + ch.PlotArea.Background.Style := cfsSolid; //ch.RotatedAxes := true; //ch.StackMode := csmStackedPercentage; //ch.Interpolation := ciCubicSpline; @@ -154,15 +156,19 @@ begin ch.Legend.Border.Width := 0.3; // mm ch.Legend.Border.Color := scGray; ch.Legend.Background.FgColor := $F0F0F0; - ch.Legend.Background.Style := fsSolidFill; + ch.Legend.Background.Style := cfsSolid; //ch.Legend.CanOverlapPlotArea := true; ch.Legend.Position := lpBottom; - // 2nd sheet + // ------------------------------------------------------------------------- + // 2nd sheet + // ------------------------------------------------------------------------- sheet2 := b.AddWorksheet('test2'); sheet2.WriteText(0, 0, 'abc'); - // 3rd sheet + // ------------------------------------------------------------------------- + // 3rd sheet + // ------------------------------------------------------------------------- sheet3 := b.AddWorksheet('test3'); sheet3.WriteText(0, 1, 'cos(x)'); sheet3.WriteText(0, 2, 'sin(x)'); @@ -173,7 +179,10 @@ begin sheet3.WriteNumber(i, 2, sin(i-1), nfFixed, 2); end; + // Create the chart ch := b.AddChart(sheet3, 1, 3, 125, 95); + + // Add two series ser := TsLineSeries.Create(ch); ser.SetTitleAddr(0, 1); ser.SetLabelRange(1, 0, 7, 0); @@ -182,18 +191,28 @@ begin ser.SetTitleAddr(0, 2); ser.SetLabelRange(1, 0, 7, 0); ser.SetYRange(1, 2, 7, 2); + + // Vertical background gradient (angle = 0) from sky-blue to white: + ch.PlotArea.Background.Style := cfsGradient; + ch.PlotArea.Background.Gradient := ch.Gradients.AddLinearGradient('Sky', $F0CAA6, $FFFFFF, 1, 1, 0, 0); +// ch.PlotArea.Background.Gradient := ch.Gradients.AddAxialGradient('Sky', $F0CAA6, $FFFFFF, 1, 1, 0, 0); +// ch.PlotArea.Background.Gradient := ch.Gradients.AddEllipticGradient('Sky', $F0CAA6, $FFFFFF, 1, 1, 0, 0.5, 0.5, 45); +// ch.PlotArea.Background.Gradient := ch.Gradients.AddRadialGradient('Sky', $F0CAA6, $FFFFFF, 1, 1, 0, 0.5, 0.5); +// ch.PlotArea.Background.Gradient := ch.Gradients.AddRectangularGradient('Sky', $F0CAA6, $FFFFFF, 1, 1, 0, 0.5, 0.5, 0); +// ch.PlotArea.Background.Gradient := ch.Gradients.AddSquareGradient('Sky', $F0CAA6, $FFFFFF, 1, 1, 0, 0.5, 0.5, 0); + ch.Border.Style := clsNoLine; ch.Title.Caption := 'HALLO'; + ch.Title.Font.Size := 18; + ch.Title.Font.Style := [fssBold]; ch.Title.Visible := true; - ch.SubTitle.Caption := 'hallo'; - ch.Subtitle.Visible := true; ch.XAxis.MajorGridLines.Style := clsSolid; //NoLine; ch.XAxis.MinorGridLines.Style := clsNoLine; ch.YAxis.MajorGridLines.Style := clsNoLine; ch.YAxis.MinorGridLines.Style := clsNoLine; - ch.YAxis.CaptionRotation := 0; - ch.XAxis.CaptionFont.Size := 18; - ch.YAxis.CaptionFont.Size := 18; + ch.YAxis.CaptionRotation := 90; + ch.XAxis.CaptionFont.Size := 14; + ch.YAxis.CaptionFont.Size := 14; ch.XAxis.LabelFont.Style := [fssItalic]; ch.YAxis.LabelFont.Style := [fssItalic]; ch.YAxis.MajorTicks := [catInside, catOutside]; diff --git a/components/fpspreadsheet/source/common/fpschart.pas b/components/fpspreadsheet/source/common/fpschart.pas index 5106fda35..41ff57b38 100644 --- a/components/fpspreadsheet/source/common/fpschart.pas +++ b/components/fpspreadsheet/source/common/fpschart.pas @@ -42,10 +42,57 @@ type Transparency: Double; // in percent end; + TsChartGradientStyle = (cgsLinear, cgsAxial, cgsRadial, cgsElliptic, cgsSquare, cgsRectangular); + + TsChartGradient = class + Name: String; + Style: TsChartGradientStyle; + StartColor: TsColor; + EndColor: TsColor; + StartIntensity: Double; // 0.0 ... 1.0 + EndIntensity: Double; // 0.0 ... 1.0 + Border: Double; // 0.0 ... 1.0 + CenterX, CenterY: Double; // 0.0 ... 1.0 + Angle: Integer; // degrees + constructor Create; + end; + + TsChartGradientList = class(TFPObjectList) + private + function GetItem(AIndex: Integer): TsChartGradient; + 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; + public + function AddAxialGradient(AName: String; AStartColor, AEndColor: TsColor; + AStartIntensity, AEndIntensity, ABorder: Double; AAngle: Integer): Integer; + function AddEllipticGradient(AName: String; AStartColor, AEndColor: TsColor; + AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY: Double; + AAngle: Integer): Integer; + function AddLinearGradient(AName: String; AStartColor, AEndColor: TsColor; + AStartIntensity, AEndIntensity, ABorder: Double; AAngle: Integer): 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; + function AddSquareGradient(AName: String; AStartColor, AEndColor: TsColor; + AStartIntensity, AEndIntensity: Double; ABorder, ACenterX, ACenterY: Double; + AAngle: Integer): 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); + TsChartFill = class - Style: TsFillStyle; + Style: TsChartFillStyle; FgColor: TsColor; BgColor: TsColor; + Gradient: Integer; Transparency: Double; // 0.0 ... 1.0 end; @@ -399,6 +446,7 @@ type FSeriesList: TsChartSeriesList; FLineStyles: TsChartLineStyleList; + FGradients: TsChartGradientList; function GetCategoryLabelRange: TsCellRange; public @@ -465,6 +513,10 @@ type { Attributes of the series } property Series: TsChartSeriesList read FSeriesList write FSeriesList; + + { Style lists } + property LineStyles: TsChartLineStyleList read FLineStyles; + property Gradients: TsChartGradientList read FGradients; end; TsChartList = class(TObjectList) @@ -478,6 +530,123 @@ type implementation +{ TsChartGradient } + +constructor TsChartGradient.Create; +begin + inherited Create; + StartIntensity := 1.0; + EndIntensity := 1.0; +end; + + +{ TsChartGradientList } + +function TsChartGradientList.AddAxialGradient(AName: String; + AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity, ABorder: Double; + AAngle: Integer): 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; +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; +var + item: TsChartGradient; +begin + if AName = '' then + AName := 'G' + IntToStr(Count+1); + Result := IndexOfName(AName); + if Result = -1 then + begin + item := TsChartGradient.Create; + Result := inherited Add(item); + end else + item := Items[Result]; + item.Name := AName; + item.Style := AStyle; + item.StartColor := AStartColor; + item.EndColor := AEndColor; + item.StartIntensity := AStartIntensity; + item.EndIntensity := AEndIntensity; + item.Border := ABorder; + item.Angle := AAngle; + item.CenterX := ACenterX; + item.CenterY := ACenterY; +end; + +function TsChartGradientList.AddLinearGradient(AName: String; + AStartColor, AEndColor: TsColor; AStartIntensity, AEndIntensity, ABorder: Double; + AAngle: Integer): 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; +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; +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; +begin + Result := AddGradient(AName, cgsSquare, AStartColor, AEndColor, + AStartIntensity, AEndIntensity, ABorder, ACenterX, ACenterY, AAngle); +end; + +function TsChartGradientList.FindByName(AName: String): TsChartGradient; +var + idx: Integer; +begin + idx := IndexOfName(AName); + if idx > -1 then + Result := Items[idx] + else + Result := nil; +end; + +function TsChartGradientList.GetItem(AIndex: Integer): TsChartGradient; +begin + Result := TsChartGradient(inherited Items[AIndex]); +end; + +function TsChartGradientList.IndexOfName(AName: String): Integer; +begin + for Result := 0 to Count-1 do + if SameText(Items[Result].Name, AName) then + exit; + Result := -1; +end; + +procedure TsChartGradientList.SetItem(AIndex: Integer; AValue: TsChartGradient); +begin + inherited Items[AIndex] := AValue; +end; + + { TsChartLineStyle } function TsChartLineStyle.GetID: String; @@ -538,9 +707,10 @@ constructor TsChartFillElement.Create(AChart: TsChart); begin inherited Create(AChart); FBackground := TsChartFill.Create; - FBackground.Style := fsSolidFill; + FBackground.Style := cfsSolid; FBackground.BgColor := scWhite; FBackground.FgColor := scWhite; + FBackground.Gradient := -1; FBorder := TsChartLine.Create; FBorder.Style := clsSolid; FBorder.Width := PtsToMM(DEFAULT_CHART_LINEWIDTH); @@ -661,9 +831,10 @@ begin idx := AChart.AddSeries(self); FFill := TsChartFill.Create; - FFill.Style := fsSolidFill; + 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.Gradient := -1; FLine := TsChartLine.Create; FLine.Style := clsSolid; @@ -885,7 +1056,7 @@ end; { TsRadarSeries } function TsRadarSeries.GetChartType: TsChartType; begin - if Fill.Style <> fsNoFill then + if Fill.Style <> cfsNoFill then Result := ctFilledRadar else Result := ctRadar; @@ -932,7 +1103,7 @@ end; function TsRegressionEquation.DefaultFill: Boolean; begin - Result := Fill.Style = fsNoFill; + Result := Fill.Style = cfsNoFill; end; function TsRegressionEquation.DefaultFont: Boolean; @@ -1012,6 +1183,8 @@ begin clsLongDashDot := FLineStyles.Add('long dash-dot', 500, 1, 100, 1, 200, true); clsLongDashDotDot := FLineStyles.Add('long dash-dot-dot', 500, 1, 100, 2, 200, true); + FGradients := TsChartGradientList.Create; + FSheetIndex := 0; FRow := 0; FCol := 0; @@ -1024,7 +1197,7 @@ begin FPlotArea := TsChartFillElement.Create(self); FFloor := TsChartFillElement.Create(self); - FFloor.Background.Style := fsNoFill; + FFloor.Background.Style := cfsNoFill; FTitle := TsChartText.Create(self); FTitle.Font.Size := 14; @@ -1074,9 +1247,10 @@ begin FLegend.Free; FTitle.Free; FSubtitle.Free; - FLineStyles.Free; FFloor.Free; FPlotArea.Free; + FGradients.Free; + FLineStyles.Free; inherited; end; diff --git a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas index c2ec5d29c..b9839cbca 100644 --- a/components/fpspreadsheet/source/common/fpsopendocumentchart.pas +++ b/components/fpspreadsheet/source/common/fpsopendocumentchart.pas @@ -46,6 +46,12 @@ type procedure PrepareChartTable(AChart: TsChart; AWorksheet: TsBasicWorksheet); protected + // Object X/styles.xml + procedure WriteObjectStyles(AStream: TStream; AChart: TsChart); + procedure WriteObjectGradientStyles(AStream: TStream; AChart: TsChart; AIndent: Integer); + procedure WriteObjectLineStyles(AStream: TStream; AChart: TsChart; AIndent: Integer); + + // Object X/content.xml procedure WriteChart(AStream: TStream; AChart: TsChart); procedure WriteChartAxis(AChartStream, AStyleStream: TStream; AChartIndent, AStyleIndent: Integer; Axis: TsChartAxis; var AStyleID: Integer); @@ -55,7 +61,6 @@ type AChartIndent, AStyleIndent: Integer; AChart: TsChart; var AStyleID: Integer); procedure WriteChartNumberStyles(AStream: TStream; AIndent: Integer; AChart: TsChart); - procedure WriteObjectStyles(AStream: TStream; AChart: TsChart); procedure WriteChartPlotArea(AChartStream, AStyleStream: TStream; AChartIndent, AStyleIndent: Integer; AChart: TsChart; var AStyleID: Integer); procedure WriteChartSeries(AChartStream, AStyleStream: TStream; @@ -99,6 +104,10 @@ const 'arrow-right', 'circle', 'star', 'x', 'plus', 'asterisk' ); // unsupported: bow-tie, hourglass, horizontal-bar, vertical-bar + GRADIENT_STYLES: array[TsChartGradientStyle] of string = ( + 'linear', 'axial', 'radial', 'ellipsoid', 'square', 'rectangular' + ); + LABEL_POSITION: array[TsChartLabelPosition] of string = ( '', 'outside', 'inside', 'center'); @@ -426,20 +435,31 @@ var fillStr: String; fillColorStr: String; fillOpacity: String = ''; + gradient: TsChartGradient; + gradientStr: String; begin - if AFill.Style = fsNoFill then - begin - Result := 'draw:fill="none" '; - exit; + 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; + cfsGradient: + begin + gradient := AChart.Gradients[AFill.Gradient]; + Result := Format( + 'draw:fill="gradient" ' + + 'draw:fill-gradient-name="%s" ' + + 'draw:gradient-step-count="0" ', + [ ASCIIName(gradient.Name) ] + ); + end; end; - - // To do: extend with hatched and gradient fills - 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; { @@ -1274,6 +1294,101 @@ begin inc(AStyleID); end; +{ Writes, for each gradient used by the chart, a node to the Object/styles xml file } +procedure TsSpreadOpenDocChartWriter.WriteObjectGradientStyles(AStream: TStream; + AChart: TsChart; AIndent: Integer); +var + i: Integer; + gradient: TsChartGradient; + style: String; + indent: String; +begin + indent := DupeString(' ', AIndent); + for i := 0 to AChart.Gradients.Count-1 do + begin + gradient := AChart.Gradients[i]; + style := indent + Format( + '' + LE; + + AppendToStream(AStream, style); + end; +end; + +procedure TsSpreadOpenDocChartWriter.WriteObjectLineStyles(AStream: TStream; + AChart: TsChart; AIndent: Integer); +const + LENGTH_UNIT: array[boolean] of string = ('mm', '%'); // relative to line width + DECS: array[boolean] of Integer = (1, 0); // relative to line width +var + i: Integer; + lineStyle: TsChartLineStyle; + seg1, seg2: String; + indent: String; +begin + indent := DupeString(' ', AIndent); + for i := 0 to AChart.NumLineStyles-1 do + begin + lineStyle := AChart.GetLineStyle(i); + if linestyle.Segment1.Count > 0 then + seg1 := Format('draw:dots1="%d" draw:dots1-length="%.*f%s" ', [ + lineStyle.Segment1.Count, + DECS[linestyle.RelativeToLineWidth], linestyle.Segment1.Length, LENGTH_UNIT[linestyle.RelativeToLineWidth] + ], FPointSeparatorSettings + ) + else + seg1 := ''; + + if linestyle.Segment2.Count > 0 then + seg2 := Format('draw:dots2="%d" draw:dots2-length="%.*f%s" ', [ + lineStyle.Segment2.Count, + DECS[linestyle.RelativeToLineWidth], linestyle.Segment2.Length, LENGTH_UNIT[linestyle.RelativeToLineWidth] + ], FPointSeparatorSettings + ) + else + seg2 := ''; + + if (seg1 <> '') or (seg2 <> '') then + AppendToStream(AStream, indent + Format( + '' + LE, [ + ASCIIName(linestyle.Name), linestyle.Name, + DECS[linestyle.RelativeToLineWidth], linestyle.Distance, LENGTH_UNIT[linestyle.RelativeToLineWidth], + seg1, seg2 + ], FPointSeparatorSettings + )); + end; +end; + { Writes the chart's legend to the xml stream } procedure TsSpreadOpenDocChartWriter.WriteChartLegend(AChartStream, AStyleStream: TStream; AChartIndent, AStyleIndent: Integer; AChart: TsChart; var AStyleID: Integer); @@ -1346,16 +1461,9 @@ begin end; { Writes the file "Object N/styles.xml" (N = 1, 2, ...) which is needed by the - charts since it defines the line dash patterns. } + charts since it defines the line dash patterns, or gradients. } procedure TsSpreadOpenDocChartWriter.WriteObjectStyles(AStream: TStream; AChart: TsChart); -const - LENGTH_UNIT: array[boolean] of string = ('mm', '%'); // relative to line width - DECS: array[boolean] of Integer = (1, 0); // relative to line width -var - i: Integer; - linestyle: TsChartLineStyle; - seg1, seg2: String; begin AppendToStream(AStream, XML_HEADER + LE); @@ -1396,35 +1504,8 @@ begin ' ' + LE ); - for i := 0 to AChart.NumLineStyles-1 do - begin - lineStyle := AChart.GetLineStyle(i); - if linestyle.Segment1.Count > 0 then - seg1 := Format('draw:dots1="%d" draw:dots1-length="%.*f%s" ', [ - lineStyle.Segment1.Count, - DECS[linestyle.RelativeToLineWidth], linestyle.Segment1.Length, LENGTH_UNIT[linestyle.RelativeToLineWidth] - ], FPointSeparatorSettings - ) - else - seg1 := ''; - - if linestyle.Segment2.Count > 0 then - seg2 := Format('draw:dots2="%d" draw:dots2-length="%.*f%s" ', [ - lineStyle.Segment2.Count, - DECS[linestyle.RelativeToLineWidth], linestyle.Segment2.Length, LENGTH_UNIT[linestyle.RelativeToLineWidth] - ], FPointSeparatorSettings - ) - else - seg2 := ''; - - if (seg1 <> '') or (seg2 <> '') then - AppendToStream(AStream, Format( - ' ' + LE, [ - ASCIIName(linestyle.Name), linestyle.Name, - DECS[linestyle.RelativeToLineWidth], linestyle.Distance, LENGTH_UNIT[linestyle.RelativeToLineWidth], - seg1, seg2 - ])); - end; + WriteObjectLineStyles(AStream, AChart, 4); + WriteObjectGradientStyles(AStream, AChart, 4); AppendToStream(AStream, ' ' + LE +