diff --git a/components/fpspreadsheet/examples/other/test_recursive_calc.lpi b/components/fpspreadsheet/examples/other/test_recursive_calc.lpi new file mode 100644 index 000000000..267889f24 --- /dev/null +++ b/components/fpspreadsheet/examples/other/test_recursive_calc.lpi @@ -0,0 +1,103 @@ + + + + + + + + + + + + + + <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> diff --git a/components/fpspreadsheet/examples/other/test_recursive_calc.pas b/components/fpspreadsheet/examples/other/test_recursive_calc.pas new file mode 100644 index 000000000..eb239ec23 --- /dev/null +++ b/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. + diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index ee60abf4c..218346d39 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/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;