fpspreadsheet: Implement automatic calculation of existing rpn formulas whenever a cell changes.

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

components/fpspreadsheet/examples/spready/mainform.lfm

@@ -13,12 +13,12 @@ object Form1: TForm1
   LCLVersion = '1.3'
   object Panel1: TPanel
     Left = 0
-    Height = 85
+    Height = 78
-    Top = 529
+    Top = 536
     Width = 884
     Align = alBottom
     BevelOuter = bvNone
-    ClientHeight = 85
+    ClientHeight = 78
     ClientWidth = 884
     TabOrder = 0
     object CbShowHeaders: TCheckBox
@@ -35,7 +35,7 @@ object Form1: TForm1
     object CbShowGridLines: TCheckBox
       Left = 8
       Height = 24
-      Top = 32
+      Top = 39
       Width = 125
       Caption = 'Show grid lines'
       Checked = True
@@ -44,23 +44,23 @@ object Form1: TForm1
       TabOrder = 1
     end
     object EdFrozenCols: TSpinEdit
-      Left = 389
+      Left = 645
       Height = 28
       Top = 8
       Width = 52
       OnChange = EdFrozenColsChange
-      TabOrder = 2
+      TabOrder = 5
     end
     object EdFrozenRows: TSpinEdit
-      Left = 389
+      Left = 645
       Height = 28
       Top = 39
       Width = 52
       OnChange = EdFrozenRowsChange
-      TabOrder = 3
+      TabOrder = 6
     end
     object Label1: TLabel
-      Left = 304
+      Left = 560
       Height = 20
       Top = 13
       Width = 77
@@ -69,7 +69,7 @@ object Form1: TForm1
       ParentColor = False
     end
     object Label2: TLabel
-      Left = 304
+      Left = 560
       Height = 20
       Top = 40
       Width = 82
@@ -78,16 +78,16 @@ object Form1: TForm1
       ParentColor = False
     end
     object CbReadFormulas: TCheckBox
-      Left = 8
+      Left = 160
       Height = 24
-      Top = 56
+      Top = 8
       Width = 120
       Caption = 'Read formulas'
       OnChange = CbReadFormulasChange
-      TabOrder = 4
+      TabOrder = 2
     end
     object CbHeaderStyle: TComboBox
-      Left = 152
+      Left = 408
       Height = 28
       Top = 8
       Width = 116
@@ -100,13 +100,22 @@ object Form1: TForm1
       )
       OnChange = CbHeaderStyleChange
       Style = csDropDownList
-      TabOrder = 5
+      TabOrder = 4
       Text = 'Native'
     end
+    object CbAutoCalcFormulas: TCheckBox
+      Left = 160
+      Height = 24
+      Top = 39
+      Width = 158
+      Caption = 'Calculate on change'
+      OnChange = CbAutoCalcFormulasChange
+      TabOrder = 3
+    end
   end
   object PageControl1: TPageControl
     Left = 0
-    Height = 450
+    Height = 457
     Top = 79
     Width = 884
     ActivePage = TabSheet1
@@ -116,11 +125,11 @@ object Form1: TForm1
     OnChange = PageControl1Change
     object TabSheet1: TTabSheet
       Caption = 'Sheet1'
-      ClientHeight = 417
+      ClientHeight = 424
       ClientWidth = 876
       object WorksheetGrid: TsWorksheetGrid
         Left = 0
-        Height = 417
+        Height = 424
         Top = 0
         Width = 876
         FrozenCols = 0

components/fpspreadsheet/examples/spready/mainform.pas

@@ -82,6 +82,7 @@ type
     CbBackgroundColor: TColorBox;
     CbReadFormulas: TCheckBox;
     CbHeaderStyle: TComboBox;
+    CbAutoCalcFormulas: TCheckBox;
     EdFormula: TEdit;
     EdCellAddress: TEdit;
     FontComboBox: TComboBox;
@@ -252,6 +253,7 @@ type
     procedure AcTextRotationExecute(Sender: TObject);
     procedure AcVertAlignmentExecute(Sender: TObject);
     procedure AcWordwrapExecute(Sender: TObject);
+    procedure CbAutoCalcFormulasChange(Sender: TObject);
     procedure CbBackgroundColorSelect(Sender: TObject);
     procedure CbHeaderStyleChange(Sender: TObject);
     procedure CbReadFormulasChange(Sender: TObject);
@@ -603,6 +605,11 @@ begin
   with WorksheetGrid do Wordwraps[Selection] := TAction(Sender).Checked;
 end;
 
+procedure TForm1.CbAutoCalcFormulasChange(Sender: TObject);
+begin
+  WorksheetGrid.AutoCalc := CbAutoCalcFormulas.Checked;;
+end;
+
 procedure TForm1.CbBackgroundColorSelect(Sender: TObject);
 begin
   with WorksheetGrid do BackgroundColors[Selection] := CbBackgroundColor.ItemIndex;

components/fpspreadsheet/fpspreadsheet.pas

@@ -676,8 +676,11 @@ type
     function WriteWordwrap(ARow, ACol: Cardinal; AValue: boolean): PCell; overload;
     procedure WriteWordwrap(ACell: PCell; AValue: boolean); overload;
 
-    { Data manipulation methods - For Cells }
+    { Formulas }
     procedure CalcFormulas;
+    function CellUsedInFormula(ARow, ACol: Cardinal): Boolean;
+
+    { Data manipulation methods - For Cells }
     procedure CopyCell(AFromRow, AFromCol, AToRow, AToCol: Cardinal; AFromWorksheet: TsWorksheet);
     procedure CopyFormat(AFormat: PCell; AToRow, AToCol: Cardinal); overload;
     procedure CopyFormat(AFromCell, AToCell: PCell); overload;
@@ -755,8 +758,11 @@ type
     @param  boBufStream     When this option is set a buffered stream is used
                             for writing (a memory stream swapping to disk) or
                             reading (a file stream pre-reading chunks of data
-                            to memory)  }
+                            to memory)
-  TsWorkbookOption = (boVirtualMode, boBufStream);
+    @param  boAutoCalc      Automatically recalculate rpn formulas whenever
+                            a cell value changes.
+  }
+  TsWorkbookOption = (boVirtualMode, boBufStream, boAutoCalc);
 
   {@@
     Set of options flags for the workbook }
@@ -789,11 +795,12 @@ type
     FBuiltinFontCount: Integer;
     FPalette: array of TsColorValue;
     FReadFormulas: Boolean;
-    FDefaultColWidth: Single; // in "characters". Excel uses the width of char "0" in 1st font
+    FDefaultColWidth: Single;   // in "characters". Excel uses the width of char "0" in 1st font
     FDefaultRowHeight: Single;  // in "character heights", i.e. line count
     FVirtualColCount: Cardinal;
     FVirtualRowCount: Cardinal;
     FWriting: Boolean;
+    FCalculating: Boolean;
     FOptions: TsWorkbookOptions;
     FOnWriteCellData: TsWorkbookWriteCellDataEvent;
     FOnReadCellData: TsWorkbookReadCellDataEvent;
@@ -1207,14 +1214,18 @@ resourcestring
 
 const
   { These are reserved system colors by Microsoft
+    0x0040 - Default foreground color - window text color in the sheet display.
+    0x0041 - Default background color - window background color in the sheet
+             display and is the default background color for a cell.
+    0x004D - Default chart foreground color - window text color in the
+             chart display.
+    0x004E - Default chart background color - window background color in the
+             chart display.
+    0x004F - Chart neutral color which is black, an RGB value of (0,0,0).
+    0x0051 - ToolTip text color - automatic font color for comments.
+    0x7FFF - Font automatic color - window text color. }
 
-  0x0040 Default foreground color - window text color in the sheet display.
+  // Color indexes of reserved system colors
-  0x0041 Default background color - window background color in the sheet display and is the default background color for a cell.
-  0x004D Default chart foreground color - window text color in the chart display.
-  0x004E Default chart background color - window background color in the chart display.
-  0x004F Chart neutral color which is black, an RGB value of (0,0,0).
-  0x0051 ToolTip text color - automatic font color for comments.
-  0x7FFF Font automatic color - window text color. }
   DEF_FOREGROUND_COLOR = $0040;
   DEF_BACKGROUND_COLOR = $0041;
   DEF_CHART_FOREGROUND_COLOR = $004D;
@@ -1223,6 +1234,7 @@ const
   DEF_TOOLTIP_TEXT_COLOR = $0051;
   DEF_FONT_AUTOMATIC_COLOR = $7FFF;
 
+  // Color rgb values of reserved system colors
   DEF_FOREGROUND_COLORVALUE = $000000;
   DEF_BACKGROUND_COLORVALUE = $FFFFFF;
   DEF_CHART_FOREGROUND_COLORVALUE = $000000;
@@ -1845,6 +1857,47 @@ begin
   Result := GetCellString(ARow, ACol, [rfRelCol, rfRelRow]);
 end;
 
+{@@
+  Checks entire workbook, whether this cell is used in any formula.
+
+  @param   ARow  Row index of the cell considered
+  @param   ACol  Column index of the cell considered
+  @return  TRUE if the cell is used in a formula, FALSE if not
+}
+function TsWorksheet.CellUsedInFormula(ARow, ACol: Cardinal): Boolean;
+var
+  cell: PCell;
+  cellNode: TAVLTreeNode;
+  fe: TsFormulaElement;
+  i: Integer;
+begin
+  cellNode := FCells.FindLowest;
+  while Assigned(cellNode) do begin
+    cell := PCell(cellNode.Data);
+    if Length(cell^.RPNFormulaValue) > 0 then
+      for i := 0 to Length(cell^.RPNFormulaValue)-1 do
+      begin
+        fe := cell^.RPNFormulaValue[i];
+        case fe.ElementKind of
+          fekCell, fekCellRef:
+            if (fe.Row = ARow) and (fe.Col = ACol) then
+            begin
+              Result := true;
+              exit;
+            end;
+          fekCellRange:
+            if (fe.Row <= ARow) and (ARow <= fe.Row2) and
+               (fe.Col <= ACol) and (ACol <= fe.Col2) then
+            begin
+              Result := true;
+              exit;
+            end;
+        end;
+      end;
+    cellNode := FCells.FindSuccessor(cellNode);
+  end;
+end;
+
 {@@
   Is called whenever a cell value or formatting has changed. Fires an event
   "OnChangeCell". This is handled by TsWorksheetGrid to update the grid cell.
@@ -1854,6 +1907,16 @@ end;
 }
 procedure TsWorksheet.ChangedCell(ARow, ACol: Cardinal);
 begin
+  if not FWorkbook.FCalculating and (boAutoCalc in FWorkbook.Options) then begin
+    if CellUsedInFormula(ARow, ACol) then begin
+      FWorkbook.FCalculating := true;
+      try
+        CalcFormulas;
+      finally
+        FWorkbook.FCalculating := false;
+      end;
+    end;
+  end;
   if Assigned(FOnChangeCell) then FOnChangeCell(Self, ARow, ACol);
 end;
 

components/fpspreadsheet/fpspreadsheetgrid.pas

@@ -46,6 +46,7 @@ type
     FLockCount: Integer;
     FEditing: Boolean;
     FCellFont: TFont;
+    FAutoCalc: Boolean;
     FReadFormulas: Boolean;
     function CalcAutoRowHeight(ARow: Integer): Integer;
     function CalcColWidth(AWidth: Single): Integer;
@@ -83,6 +84,7 @@ type
     function GetVertAlignments(ARect: TGridRect): TsVertAlignment;
     function GetWordwrap(ACol, ARow: Integer): Boolean;
     function GetWordwraps(ARect: TGridRect): Boolean;
+    procedure SetAutoCalc(AValue: Boolean);
     procedure SetBackgroundColor(ACol, ARow: Integer; AValue: TsColor);
     procedure SetBackgroundColors(ARect: TGridRect; AValue: TsColor);
     procedure SetCellBorder(ACol, ARow: Integer; AValue: TsCellBorders);
@@ -114,6 +116,7 @@ type
 
   protected
     { Protected declarations }
+    procedure CreateNewWorkbook;
     procedure DoPrepareCanvas(ACol, ARow: Integer; AState: TGridDrawState); override;
     procedure DrawAllRows; override;
     procedure DrawCellBorders; overload;
@@ -140,6 +143,8 @@ type
     procedure Setup;
     procedure UpdateColWidths(AStartIndex: Integer = 0);
     procedure UpdateRowHeights(AStartIndex: Integer = 0);
+    {@@ Automatically recalculate formulas whenever a cell value changes, }
+    property AutoCalc: Boolean read FAutoCalc write SetAutoCalc default false;
     {@@ Displays column and row headers in the fixed col/row style of the grid.
         Deprecated. Use ShowHeaders instead. }
     property DisplayFixedColRow: Boolean read GetShowHeaders write SetShowHeaders default true;
@@ -298,6 +303,8 @@ type
   TsWorksheetGrid = class(TsCustomWorksheetGrid)
   published
     // inherited from TsCustomWorksheetGrid
+    {@@ Automatically recalculates the worksheet of a cell value changes. }
+    property AutoCalc;
     {@@ Displays column and row headers in the fixed col/row style of the grid.
         Deprecated. Use ShowHeaders instead. }
     property DisplayFixedColRow; deprecated 'Use ShowHeaders';
@@ -908,6 +915,18 @@ begin
   end;
 end;
 
+{@@
+  Creates a new empty workbook into which a file will be loaded. Destroys the
+  previously used workbook.
+}
+procedure TsCustomWorksheetGrid.CreateNewWorkbook;
+begin
+  FreeAndNil(FWorkbook);
+  FWorkbook := TsWorkbook.Create;
+  FWorkbook.ReadFormulas := FReadFormulas;
+  SetAutoCalc(FAutoCalc);
+end;
+
 {@@
   Adjusts the grid's canvas before painting a given cell. Considers
   background color, horizontal alignment, vertical alignment, etc.
@@ -2606,6 +2625,18 @@ begin
   inherited;
 end;
 
+procedure TsCustomWorksheetGrid.SetAutoCalc(AValue: Boolean);
+begin
+  FAutoCalc := AValue;
+  if Assigned(FWorkbook) then
+  begin
+    if FAutoCalc then
+      FWorkbook.Options := FWorkbook.Options + [boAutoCalc]
+    else
+      FWorkbook.Options := FWorkbook.Options - [boAutoCalc];
+  end;
+end;
+
 procedure TsCustomWorksheetGrid.SetBackgroundColor(ACol, ARow: Integer;
   AValue: TsColor);
 var
@@ -3088,9 +3119,7 @@ procedure TsCustomWorksheetGrid.LoadFromSpreadsheetFile(AFileName: string;
 begin
   BeginUpdate;
   try
-    FreeAndNil(FWorkbook);
+    CreateNewWorkbook;
-    FWorkbook := TsWorkbook.Create;
-    FWorkbook.ReadFormulas := FReadFormulas;
     FWorkbook.ReadFromFile(AFileName, AFormat);
     LoadFromWorksheet(FWorkbook.GetWorksheetByIndex(AWorksheetIndex));
   finally
@@ -3110,9 +3139,7 @@ procedure TsCustomWorksheetGrid.LoadFromSpreadsheetFile(AFileName: string;
 begin
   BeginUpdate;
   try
-    FreeAndNil(FWorkbook);
+    CreateNewWorkbook;
-    FWorkbook := TsWorkbook.Create;
-    FWorkbook.ReadFormulas := FReadFormulas;
     FWorkbook.ReadFromFile(AFilename);
     LoadFromWorksheet(FWorkbook.GetWorksheetByIndex(AWorksheetIndex));
   finally