fpspreadsheet: Introduce recursive calculation of cells depending on non-yet calculated cells. Add demo "test_recursive" in folder "other".

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

components/fpspreadsheet/examples/other/test_recursive_calc.lpi

@@ -0,0 +1,103 @@
+<?xml version="1.0" encoding="UTF-8"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="test_recursive_calc"/>
+      <UseAppBundle Value="False"/>
+      <ResourceType Value="res"/>
+    </General>
+    <i18n>
+      <EnableI18N LFM="False"/>
+    </i18n>
+    <VersionInfo>
+      <StringTable ProductVersion=""/>
+    </VersionInfo>
+    <BuildModes Count="2">
+      <Item1 Name="Debug" Default="True"/>
+      <Item2 Name="Release">
+        <CompilerOptions>
+          <Version Value="11"/>
+          <PathDelim Value="\"/>
+          <SearchPaths>
+            <IncludeFiles Value="$(ProjOutDir)"/>
+          </SearchPaths>
+          <CodeGeneration>
+            <SmartLinkUnit Value="True"/>
+          </CodeGeneration>
+          <Linking>
+            <Debugging>
+              <StripSymbols Value="True"/>
+            </Debugging>
+            <LinkSmart Value="True"/>
+            <Options>
+              <Win32>
+                <GraphicApplication Value="True"/>
+              </Win32>
+            </Options>
+          </Linking>
+        </CompilerOptions>
+      </Item2>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+      </local>
+    </RunParams>
+    <RequiredPackages Count="1">
+      <Item1>
+        <PackageName Value="laz_fpspreadsheet"/>
+      </Item1>
+    </RequiredPackages>
+    <Units Count="1">
+      <Unit0>
+        <Filename Value="test_recursive_calc.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="test_recursive_calc"/>
+      </Unit0>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <SearchPaths>
+      <IncludeFiles Value="$(ProjOutDir)"/>
+    </SearchPaths>
+    <CodeGeneration>
+      <SmartLinkUnit Value="True"/>
+    </CodeGeneration>
+    <Linking>
+      <Debugging>
+        <DebugInfoType Value="dsDwarf2Set"/>
+      </Debugging>
+      <Options>
+        <Win32>
+          <GraphicApplication Value="True"/>
+        </Win32>
+      </Options>
+    </Linking>
+  </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/other/test_recursive_calc.pas

@@ -0,0 +1,56 @@
+{ This demo is a test for recursive calculation of cells. The cell formulas
+  are constructed such that the first cell depends on the second, and the second
+  cell depends on the third one. Only the third cell contains a number.
+  Therefore calculation has to be done recursively until the independent third
+  cell is found. }
+
+program test_recursive_calc;
+
+{$mode objfpc}{$H+}
+
+uses
+  {$IFDEF UNIX}{$IFDEF UseCThreads}
+  cthreads,
+  {$ENDIF}{$ENDIF}
+  Classes, laz_fpspreadsheet
+  { you can add units after this },
+  math, fpspreadsheet, fpsfunc;
+
+var
+  workbook: TsWorkbook;
+  worksheet: TsWorksheet;
+
+begin
+  workbook := TsWorkbook.Create;
+  try
+    worksheet := workbook.AddWorksheet('Calc_test');
+    worksheet.Options := worksheet.Options + [soCalcBeforeSaving];
+    worksheet.WriteColWidth(0, 20);
+
+    // A1
+    worksheet.WriteUTF8Text(0, 0, '=B2+1');
+    // B1
+    worksheet.WriteRPNFormula(0, 1, CreateRPNFormula(
+      RPNCellValue('B2',
+      RPNNumber(1,
+      RPNFunc(fekAdd, nil)))));
+
+    // A2
+    worksheet.WriteUTF8Text(1, 0, '=B3+1');
+    // B2
+    worksheet.WriteRPNFormula(1, 1, CreateRPNFormula(
+      RPNCellValue('B3',
+      RPNNumber(1,
+      RPNFunc(fekAdd, nil)))));
+
+    // A3
+    worksheet.WriteUTF8Text(2, 0, '(not dependent)');
+    // B3
+    worksheet.WriteNumber(2, 1, 1);
+
+    workbook.WriteToFile('test_calc.xls', sfExcel8, true);
+  finally
+    workbook.Free;
+  end;
+end.
+

components/fpspreadsheet/fpspreadsheet.pas

@@ -361,6 +361,9 @@ const
   );
 
 type
+  {@@ State flags while calculating formulas }
+  TsCalcState = (csNotCalculated, csCalculating, csCalculated);
+
   {@@ Cell structure for TsWorksheet
       The cell record contains information on the location of the cell (row and
       column index), on the value contained (number, date, text, ...), and on
@@ -396,6 +399,8 @@ type
     NumberFormat: TsNumberFormat;
     NumberFormatStr: String;
     RGBBackgroundColor: TFPColor; // only valid if BackgroundColor=scRGBCOLOR
+    { Status flags }
+    CalcState: TsCalcState;
   end;
 
   {@@ Pointer to a TCell record }
@@ -471,8 +476,13 @@ type
     FOptions: TsSheetOptions;
     FOnChangeCell: TsCellEvent;
     FOnChangeFont: TsCellEvent;
-    procedure CalcFormulaCallback(data, arg: Pointer);
+
+    { Setter/Getter }
     function GetFormatSettings: TFormatSettings;
+
+    { Callback procedures called when iterating through all cells }
+    procedure CalcFormulaCallback(data, arg: Pointer);
+    procedure CalcStateCallback(data, arg: Pointer);
     procedure RemoveCallback(data, arg: pointer);
 
   protected
@@ -1019,6 +1029,7 @@ resourcestring
   lpIllegalNumberFormat = 'Illegal number format.';
   lpSpecifyNumberOfParams = 'Specify number of parameters for function %s';
   lpIncorrectParamCount = 'Funtion %s requires at least %d and at most %d parameters.';
+  lpCircularReference = 'Circular reference found when calculating worksheet formulas';
   lpTRUE = 'TRUE';
   lpFALSE = 'FALSE';
   lpErrEmptyIntersection = '#NULL!';
@@ -1431,20 +1442,50 @@ begin
 end;
 
 {@@
+  Helper method marking all cells with formulas as "not calculated". This flag
+  is needed for recursive calculation of the entire worksheet.
+}
+procedure TsWorksheet.CalcStateCallback(data, arg: Pointer);
+var
+  cell: PCell;
+begin
+  Unused(arg);
+  cell := PCell(data);
+
+  if Length(cell^.RPNFormulaValue) > 0 then
+    cell^.CalcState := csNotCalculated;
+end;
+
+{@@
+  Calculates all rpn formulas of the worksheet.
 }
 procedure TsWorksheet.CalcFormulas;
 var
   node: TAVLTreeNode;
 begin
-  Node := FCells.FindLowest;
+  // Step 1 - mark all formula cells as "not calculated"
+  node := FCells.FindLowest;
+  while Assigned(node) do begin
+    CalcStateCallback(node.Data, nil);
+    node := FCells.FindSuccessor(node);
+  end;
+
+  // Step 2 - calculate cells. If a not-calculated cell is found it is
+  // calculated and then marked as such.
+  node := FCells.FindLowest;
   while Assigned(Node) do begin
     CalcFormulaCallback(Node.Data, nil);
     node := FCells.FindSuccessor(node);
   end;
 end;
 
-
 {@@
+  Calculates the rpn formula assigned to a cell.
+  Should not be called by itself because the result may depend on other cells
+  which may have not yet been calculated. It is better to call CalcFormulas
+  instead.
+
+  @param  ACell  Cell containing the rpn formula.
 }
 procedure TsWorksheet.CalcRPNFormula(ACell: PCell);
 var
@@ -1461,14 +1502,20 @@ begin
   then
     exit;
 
+  ACell^.CalcState := csCalculating;
+
   args := TsArgumentStack.Create;
   try
     for i := 0 to Length(ACell^.RPNFormulaValue) - 1 do begin
-      fe := ACell^.RPNFormulaValue[i];   // "formula element"
+      fe := ACell^.RPNFormulaValue[i];   // fe = "formula element"
       case fe.ElementKind of
         fekCell, fekCellRef:
           begin
             cell := FindCell(fe.Row, fe.Col);
+            case cell^.CalcState of
+              csNotCalculated: CalcRPNFormula(cell);
+              csCalculating  : raise Exception.Create(lpCircularReference);
+            end;
             args.PushCell(cell);
           end;
         fekCellRange: ;
@@ -1499,21 +1546,13 @@ begin
           end;
           // Result of function
           val := func(args, fe.ParamsNum);
+          // Push result on stack for usage by next function or as final result
           args.Push(val);
-          {
-          // Push valid result on stack, exit in case of error
-          case val.ArgumentType of
-            atNumber, atString, atBool, atEmpty:
-              args.Push(val);
-            atError:
-              begin
-                WriteErrorValue(ACell, val.ErrorValue);
-                exit;
-              end;
-          end;
-          }
       end;  // case
     end;  // for
+
+    { When all formula elements have been processed the stack contains the
+      final result. }
     if args.Count = 1 then begin
       val := args.Pop;
       case val.ArgumentType of
@@ -1525,13 +1564,8 @@ begin
       end;
     end else
       WriteErrorValue(ACell, errArgError);
-    {
-      // This case is a program error --> raise an exception
-      raise Exception.CreateFmt('Incorrect argument count of the formula in cell %s', [
-        GetCellString(ACell^.Row, ACell^.Col, [])
-      ]);
-      }
   finally
+    ACell^.CalcState := csCalculated;
     args.Free;
   end;
 end;