Implements a charting component for FPSpreadsheet

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

components/fpspreadsheet/examples/excel8demo/excel8read.lpi

@@ -14,7 +14,7 @@
       <UseXPManifest Value="True"/>
     </General>
     <VersionInfo>
-      <ProjectVersion Value=""/>
+      <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="0.0.0.0" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
     </VersionInfo>
     <PublishOptions>
       <Version Value="2"/>
@@ -25,7 +25,7 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+        <LaunchingApplication PathPlusParams="\usr\X11R6\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
     <RequiredPackages Count="1">

components/fpspreadsheet/examples/fpschart/fpschart.lpi

@@ -0,0 +1,98 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="7"/>
+    <General>
+      <Flags>
+        <UseDefaultCompilerOptions Value="True"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <TargetFileExt Value=""/>
+      <ResourceType Value="res"/>
+      <UseXPManifest Value="True"/>
+      <Icon Value="0"/>
+    </General>
+    <VersionInfo>
+      <Language Value=""/>
+      <CharSet Value=""/>
+      <StringTable Comments="" CompanyName="" FileDescription="" FileVersion="" InternalName="" LegalCopyright="" LegalTrademarks="" OriginalFilename="" ProductName="" ProductVersion=""/>
+    </VersionInfo>
+    <PublishOptions>
+      <Version Value="2"/>
+      <IgnoreBinaries Value="False"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="3">
+      <Item1>
+        <PackageName Value="TAChartLazarusPkg"/>
+        <MinVersion Major="1" Valid="True"/>
+      </Item1>
+      <Item2>
+        <PackageName Value="laz_fpspreadsheet_visual"/>
+      </Item2>
+      <Item3>
+        <PackageName Value="LCL"/>
+      </Item3>
+    </RequiredPackages>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="fpschart.lpr"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="fpschart"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="mainform.pas"/>
+        <IsPartOfProject Value="True"/>
+        <ComponentName Value="FPSChartForm"/>
+        <ResourceBaseClass Value="Form"/>
+        <UnitName Value="mainform"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="8"/>
+    <Target>
+      <Filename Value="fpschart"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)/"/>
+      <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <UseAnsiStrings Value="True"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Linking>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+    <Other>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+  <Debugging>
+    <Exceptions Count="3">
+      <Item1>
+        <Name Value="EAbort"/>
+      </Item1>
+      <Item2>
+        <Name Value="ECodetoolError"/>
+      </Item2>
+      <Item3>
+        <Name Value="EFOpenError"/>
+      </Item3>
+    </Exceptions>
+  </Debugging>
+</CONFIG>

components/fpspreadsheet/examples/fpschart/fpschart.lpr

@@ -0,0 +1,21 @@
+program fpschart;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Interfaces, // this includes the LCL widgetset
+  Forms, tachartlazaruspkg, mainform, laz_fpspreadsheet_visual
+  { you can add units after this };
+
+{$R *.res}
+
+begin
+  Application.Title:='project1';
+  Application.Initialize;
+  Application.CreateForm(TFPSChartForm, FPSChartForm);
+  Application.Run;
+end.
+

components/fpspreadsheet/examples/fpschart/mainform.lfm

@@ -0,0 +1,62 @@
+object FPSChartForm: TFPSChartForm
+  Left = 179
+  Height = 331
+  Top = 157
+  Width = 742
+  Caption = 'FPSpreadsheet Chart Example'
+  ClientHeight = 331
+  ClientWidth = 742
+  LCLVersion = '0.9.29'
+  object MyChart: TChart
+    Left = 400
+    Height = 240
+    Top = 24
+    Width = 336
+    AxisList = <    
+      item
+        Alignment = calLeft
+        Title.Font.Orientation = 900
+      end    
+      item
+        Alignment = calBottom
+      end>
+    Foot.Brush.Color = clBtnFace
+    Foot.Font.Color = clBlue
+    Title.Brush.Color = clBtnFace
+    Title.Font.Color = clBlue
+    Title.Text.Strings = (
+      'TAChart'
+    )
+    ParentColor = False
+    object MyChartLineSeries: TLineSeries
+      LinePen.Color = clRed
+      SeriesColor = clRed
+      Source = FPSChartSource
+    end
+  end
+  object WorksheetGrid: TsWorksheetGrid
+    Left = 16
+    Height = 240
+    Top = 24
+    Width = 360
+    Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goSmoothScroll]
+    TabOrder = 1
+  end
+  object btnCreateGraphic: TButton
+    Left = 104
+    Height = 25
+    Top = 280
+    Width = 128
+    Caption = 'Create Graphic'
+    OnClick = btnCreateGraphicClick
+    TabOrder = 2
+  end
+  object FPSChartSource: TsWorksheetChartSource
+    PointsNumber = 5
+    YFirstCellCol = 1
+    XSelectionDirection = fpsVerticalSelection
+    YSelectionDirection = fpsVerticalSelection
+    left = 376
+    top = 264
+  end
+end

components/fpspreadsheet/examples/fpschart/mainform.pas

@@ -0,0 +1,43 @@
+unit mainform;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
+  StdCtrls, Grids, fpspreadsheetchart, fpspreadsheetgrid, TAGraph, TASeries;
+
+type
+  
+  { TFPSChartForm }
+
+  TFPSChartForm = class(TForm)
+    btnCreateGraphic: TButton;
+    MyChart: TChart;
+    FPSChartSource: TsWorksheetChartSource;
+    MyChartLineSeries: TLineSeries;
+    WorksheetGrid: TsWorksheetGrid;
+    procedure btnCreateGraphicClick(Sender: TObject);
+  private
+    { private declarations }
+  public
+    { public declarations }
+  end; 
+
+var
+  FPSChartForm: TFPSChartForm; 
+
+implementation
+
+{$R *.lfm}
+
+{ TFPSChartForm }
+
+procedure TFPSChartForm.btnCreateGraphicClick(Sender: TObject);
+begin
+  FPSChartSource.LoadFromWorksheetGrid(WorksheetGrid);
+end;
+
+end.
+

components/fpspreadsheet/fpspreadsheet.pas

@@ -115,6 +115,7 @@ type
     function  GetLastColNumber: Cardinal;
     function  GetLastRowNumber: Cardinal;
     function  ReadAsUTF8Text(ARow, ACol: Cardinal): ansistring;
+    function  ReadAsNumber(ARow, ACol: Cardinal): Double;
     procedure RemoveAllCells;
     procedure WriteUTF8Text(ARow, ACol: Cardinal; AText: ansistring);
     procedure WriteNumber(ARow, ACol: Cardinal; ANumber: double);
@@ -479,6 +480,40 @@ begin
   end;
 end;
 
+function TsWorksheet.ReadAsNumber(ARow, ACol: Cardinal): Double;
+var
+  ACell: PCell;
+  Str: string;
+begin
+  ACell := FindCell(ARow, ACol);
+
+  if ACell = nil then
+  begin
+    Result := 0.0;
+    Exit;
+  end;
+
+  case ACell^.ContentType of
+
+  //cctFormula
+  cctNumber:     Result := ACell^.NumberValue;
+  cctUTF8String:
+  begin
+    // The try is necessary to catch errors while converting the string
+    // to a number, an operation which may fail
+    try
+      Str := ACell^.UTF8StringValue;
+      Result := StrToFloat(Str);
+    except
+      Result := 0.0;
+    end;
+  end;
+
+  else
+    Result := 0.0;
+  end;
+end;
+
 {@@
   Clears the list of Cells and releases their memory.
 }

components/fpspreadsheet/fpspreadsheetchart.pas

@@ -0,0 +1,208 @@
+{
+fpspreadsheetgrid.pas
+
+Chart data source designed to work together with TChart from Lazarus to display the data
+and with TsWorksheetGrid from FPSpreadsheet to load data from a grid.
+
+AUTHORS: Felipe Monteiro de Carvalho
+}
+unit fpspreadsheetchart;
+
+{$mode objfpc}{$H+}
+
+interface
+
+uses
+  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, Grids,
+  // TChart
+  tasources,
+  // FPSpreadsheet Visual
+  fpspreadsheetgrid,
+  // FPSpreadsheet
+  fpspreadsheet;
+
+type
+
+  TsSelectionDirection = (fpsVerticalSelection, fpsHorizontalSelection);
+
+  {@@ Chart data source designed to work together with TChart from Lazarus
+    to display the data.
+
+    The data can be loaded from a TsWorksheetGrid Grid component or
+    directly from a TsWorksheet FPSpreadsheet Worksheet }
+
+  { TsWorksheetChartSource }
+
+  TsWorksheetChartSource = class(TCustomChartSource)
+  private
+    FInternalWorksheet: TsWorksheet;
+    FPointsNumber: Integer;
+    FXSelectionDirection: TsSelectionDirection;
+    FYSelectionDirection: TsSelectionDirection;
+//    FWorksheetGrid: TsWorksheetGrid;
+    FXFirstCellCol: Integer;
+    FXFirstCellRow: Integer;
+    FYFirstCellCol: Integer;
+    FYFirstCellRow: Integer;
+    procedure SetPointsNumber(const AValue: Integer);
+    procedure SetXSelectionDirection(const AValue: TsSelectionDirection);
+    procedure SetYSelectionDirection(const AValue: TsSelectionDirection);
+    procedure SetXFirstCellCol(const AValue: Integer);
+    procedure SetXFirstCellRow(const AValue: Integer);
+    procedure SetYFirstCellCol(const AValue: Integer);
+    procedure SetYFirstCellRow(const AValue: Integer);
+  protected
+    FDataWorksheet: TsWorksheet;
+    FCurItem: TChartDataItem;
+    function GetCount: Integer; override;
+    function GetItem(AIndex: Integer): PChartDataItem; override;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
+    procedure LoadFromWorksheetGrid(const AValue: TsWorksheetGrid);
+  public
+  published
+//    property WorksheetGrid: TsWorksheetGrid read FWorksheetGrid write SetWorksheetGrid;
+    property PointsNumber: Integer read FPointsNumber write SetPointsNumber default 0;
+    property XFirstCellCol: Integer read FXFirstCellCol write SetXFirstCellCol default 0;
+    property XFirstCellRow: Integer read FXFirstCellRow write SetXFirstCellRow default 0;
+    property YFirstCellCol: Integer read FYFirstCellCol write SetYFirstCellCol default 0;
+    property YFirstCellRow: Integer read FYFirstCellRow write SetYFirstCellRow default 0;
+    property XSelectionDirection: TsSelectionDirection read FXSelectionDirection write SetXSelectionDirection;
+    property YSelectionDirection: TsSelectionDirection read FYSelectionDirection write SetYSelectionDirection;
+  end;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+  RegisterComponents('Chart',[TsWorksheetChartSource]);
+end;
+
+{ TsWorksheetChartSource }
+
+procedure TsWorksheetChartSource.SetPointsNumber(const AValue: Integer);
+begin
+  if FPointsNumber = AValue then exit;
+  FPointsNumber := AValue;
+  InvalidateCaches;
+  Notify;
+end;
+
+procedure TsWorksheetChartSource.SetXSelectionDirection(
+  const AValue: TsSelectionDirection);
+begin
+  if FXSelectionDirection=AValue then exit;
+  FXSelectionDirection:=AValue;
+  InvalidateCaches;
+  Notify;
+end;
+
+procedure TsWorksheetChartSource.SetYSelectionDirection(
+  const AValue: TsSelectionDirection);
+begin
+  if FYSelectionDirection=AValue then exit;
+  FYSelectionDirection:=AValue;
+  InvalidateCaches;
+  Notify;
+end;
+
+procedure TsWorksheetChartSource.SetXFirstCellCol(const AValue: Integer);
+begin
+  if FXFirstCellCol=AValue then exit;
+  FXFirstCellCol:=AValue;
+  InvalidateCaches;
+  Notify;
+end;
+
+procedure TsWorksheetChartSource.SetXFirstCellRow(const AValue: Integer);
+begin
+  if FXFirstCellRow=AValue then exit;
+  FXFirstCellRow:=AValue;
+  InvalidateCaches;
+  Notify;
+end;
+
+procedure TsWorksheetChartSource.SetYFirstCellCol(const AValue: Integer);
+begin
+  if FYFirstCellCol=AValue then exit;
+  FYFirstCellCol:=AValue;
+  InvalidateCaches;
+  Notify;
+end;
+
+procedure TsWorksheetChartSource.SetYFirstCellRow(const AValue: Integer);
+begin
+  if FYFirstCellRow=AValue then exit;
+  FYFirstCellRow:=AValue;
+  InvalidateCaches;
+  Notify;
+end;
+
+function TsWorksheetChartSource.GetCount: Integer;
+begin
+  Result := FPointsNumber;
+end;
+
+function TsWorksheetChartSource.GetItem(AIndex: Integer): PChartDataItem;
+var
+  XRow, XCol, YRow, YCol: Integer;
+begin
+  // First calculate the cell position
+  if XSelectionDirection = fpsVerticalSelection then
+  begin
+    XRow := FXFirstCellRow + AIndex;
+    XCol := FXFirstCellCol;
+  end
+  else
+  begin
+    XRow := FXFirstCellRow;
+    XCol := FXFirstCellCol + AIndex;
+  end;
+
+  if YSelectionDirection = fpsVerticalSelection then
+  begin
+    YRow := FYFirstCellRow + AIndex;
+    YCol := FYFirstCellCol;
+  end
+  else
+  begin
+    YRow := FYFirstCellRow;
+    YCol := FYFirstCellCol + AIndex;
+  end;
+
+  // Check the corresponding cell, if it is empty, use zero
+  // If not, then get a number value
+
+  FCurItem.X := FDataWorksheet.ReadAsNumber(XRow, XCol);
+  FCurItem.Y := FDataWorksheet.ReadAsNumber(YRow, YCol);
+
+  Result := @FCurItem;
+end;
+
+constructor TsWorksheetChartSource.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FInternalWorksheet := TsWorksheet.Create;
+  FDataWorksheet := FInternalWorksheet;
+end;
+
+destructor TsWorksheetChartSource.Destroy;
+begin
+  if FInternalWorksheet <> nil then FInternalWorksheet.Free;
+  inherited Destroy;
+end;
+
+procedure TsWorksheetChartSource.LoadFromWorksheetGrid(const AValue: TsWorksheetGrid);
+begin
+  if AValue = nil then Exit;
+
+  AValue.SaveToWorksheet(FDataWorksheet);
+
+  InvalidateCaches;
+  Notify;
+end;
+
+end.

components/fpspreadsheet/fpspreadsheetgrid.pas

@@ -1,3 +1,10 @@
+{
+fpspreadsheetgrid.pas
+
+Grid component which can load and write data from / to FPSpreadsheet documents
+
+AUTHORS: Felipe Monteiro de Carvalho
+}
 unit fpspreadsheetgrid;
 
 {$mode objfpc}{$H+}
@@ -10,14 +17,12 @@ uses
 
 type
 
-  { TsWorksheetGrid }
-
   { TsCustomWorksheetGrid }
 
   TsCustomWorksheetGrid = class(TCustomStringGrid)
   private
-    FDisplayFixedColRow: Boolean;
     FWorksheet: TsWorksheet;
+    FDisplayFixedColRow: Boolean;
     procedure SetDisplayFixedColRow(const AValue: Boolean);
     { Private declarations }
   protected
@@ -26,9 +31,12 @@ type
     { methods }
     constructor Create(AOwner: TComponent); override;
     procedure LoadFromWorksheet(AWorksheet: TsWorksheet);
+    procedure SaveToWorksheet(AWorksheet: TsWorksheet);
     property DisplayFixedColRow: Boolean read FDisplayFixedColRow write SetDisplayFixedColRow;
   end;
 
+  { TsWorksheetGrid }
+
   TsWorksheetGrid = class(TsCustomWorksheetGrid)
   published
     property Align;
@@ -135,6 +143,10 @@ begin
   RegisterComponents('Additional',[TsWorksheetGrid]);
 end;
 
+const
+  INT_FPSCOLROW_TO_GRIDCOLROW_WITH_FIXEDCOLROW = 2;
+  INT_FPSCOLROW_TO_GRIDCOLROW = 1;
+
 { TsCustomWorksheetGrid }
 
 procedure TsCustomWorksheetGrid.SetDisplayFixedColRow(const AValue: Boolean);
@@ -181,13 +193,13 @@ begin
   begin
     if DisplayFixedColRow then
     begin
-      ColCount := FWorksheet.GetLastColNumber() + 2;
+      ColCount := FWorksheet.GetLastColNumber() + INT_FPSCOLROW_TO_GRIDCOLROW_WITH_FIXEDCOLROW;
-      RowCount := FWorksheet.GetLastRowNumber() + 2;
+      RowCount := FWorksheet.GetLastRowNumber() + INT_FPSCOLROW_TO_GRIDCOLROW_WITH_FIXEDCOLROW;
     end
     else
     begin
-      ColCount := FWorksheet.GetLastColNumber() + 1;
+      ColCount := FWorksheet.GetLastColNumber() + INT_FPSCOLROW_TO_GRIDCOLROW;
-      RowCount := FWorksheet.GetLastRowNumber() + 1;
+      RowCount := FWorksheet.GetLastRowNumber() + INT_FPSCOLROW_TO_GRIDCOLROW;
     end;
   end;
 
@@ -209,4 +221,21 @@ begin
   end;
 end;
 
+procedure TsCustomWorksheetGrid.SaveToWorksheet(AWorksheet: TsWorksheet);
+var
+  x, y: Integer;
+  Str: string;
+begin
+  if AWorksheet = nil then Exit;
+
+  { Copy the contents }
+
+  for x := 0 to ColCount - 1 do
+    for y := 0 to RowCount - 1 do
+    begin
+      Str := GetCells(x, y);
+      if Str <> '' then AWorksheet.WriteUTF8Text(y, x, Str);
+    end;
+end;
+
 end.

components/fpspreadsheet/laz_fpspreadsheet_visual.lpk

@@ -7,31 +7,39 @@
       <Version Value="8"/>
       <PathDelim Value="\"/>
       <SearchPaths>
-        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)\"/>
+        <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
       </SearchPaths>
       <Other>
         <CompilerPath Value="$(CompPath)"/>
       </Other>
     </CompilerOptions>
-    <Files Count="1">
+    <Files Count="2">
       <Item1>
         <Filename Value="fpspreadsheetgrid.pas"/>
         <HasRegisterProc Value="True"/>
         <UnitName Value="FPSpreadsheetGrid"/>
       </Item1>
+      <Item2>
+        <Filename Value="fpspreadsheetchart.pas"/>
+        <HasRegisterProc Value="True"/>
+        <UnitName Value="fpspreadsheetchart"/>
+      </Item2>
     </Files>
     <Type Value="RunAndDesignTime"/>
-    <RequiredPkgs Count="3">
+    <RequiredPkgs Count="4">
       <Item1>
-        <PackageName Value="laz_fpspreadsheet"/>
+        <PackageName Value="tachartlazaruspkg"/>
       </Item1>
       <Item2>
-        <PackageName Value="LCL"/>
+        <PackageName Value="laz_fpspreadsheet"/>
       </Item2>
       <Item3>
+        <PackageName Value="LCL"/>
+      </Item3>
+      <Item4>
         <PackageName Value="FCL"/>
         <MinVersion Major="1" Valid="True"/>
-      </Item3>
+      </Item4>
     </RequiredPkgs>
     <UsageOptions>
       <UnitPath Value="$(PkgOutDir)"/>

components/fpspreadsheet/laz_fpspreadsheet_visual.pas

@@ -1,4 +1,4 @@
-{ This file was automatically created by Lazarus. do not edit!
+{ This file was automatically created by Lazarus. Do not edit!
   This source is only used to compile and install the package.
  }
 
@@ -7,13 +7,14 @@ unit laz_fpspreadsheet_visual;
 interface
 
 uses
-  fpspreadsheetgrid, LazarusPackageIntf;
+  fpspreadsheetgrid, fpspreadsheetchart, LazarusPackageIntf;
 
 implementation
 
 procedure Register; 
 begin
   RegisterUnit('fpspreadsheetgrid', @fpspreadsheetgrid.Register); 
+  RegisterUnit('fpspreadsheetchart', @fpspreadsheetchart.Register); 
 end; 
 
 initialization