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

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9037 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/fpspreadsheet/examples/visual/fpschart/fpschartlink/chart_demo.lpi

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

components/fpspreadsheet/source/common/fpsopendocumentchart.pas

@@ -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;

components/fpspreadsheet/source/visual/fpspreadsheetchart.pas

@@ -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;
+
+  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,20 +455,18 @@ 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)
+  if (Workbook = nil) or (FRangeStr[AIndex] = '') then
-  then begin
+  begin
     FWorksheets[AIndex] := nil;
     SetLength(FRanges[AIndex], 0);
+    if AIndex = rngY then
       FPointsNumber := 0;
     Reset;
     exit;
@@ -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);
+  for i := 0 to ch.Series.Count-1 do
-begin
+    AddSeries(ch.Series[i]);
-  if FChart = AValue then
-    exit;
-  FChart := AValue;
-  PopulateChart;
-end;
 
-procedure TSWorkbookChartLink.SetWorkbookChartIndex(AValue: Integer);
+  FChart.Prepare;
-begin
+  UpdateChartAxisLabels(ch);
-  if AValue = FWorkbookChartIndex then
+  UpdateBarSeries(ch);
-    exit;
+  FixAreaSeries(ch);
-  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;
 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;