diff --git a/components/fpspreadsheet/examples/spready/mainform.lfm b/components/fpspreadsheet/examples/spready/mainform.lfm index 67c8c1cad..375ae40ab 100644 --- a/components/fpspreadsheet/examples/spready/mainform.lfm +++ b/components/fpspreadsheet/examples/spready/mainform.lfm @@ -13,12 +13,12 @@ object Form1: TForm1 LCLVersion = '1.3' object Panel1: TPanel Left = 0 - Height = 85 - Top = 529 + Height = 78 + 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 diff --git a/components/fpspreadsheet/examples/spready/mainform.pas b/components/fpspreadsheet/examples/spready/mainform.pas index 4b977c668..299562a0d 100644 --- a/components/fpspreadsheet/examples/spready/mainform.pas +++ b/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; diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas index 16805b499..3ae516855 100755 --- a/components/fpspreadsheet/fpspreadsheet.pas +++ b/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) } - TsWorkbookOption = (boVirtualMode, boBufStream); + to memory) + @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. - 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. } + // Color indexes of reserved system colors 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; diff --git a/components/fpspreadsheet/fpspreadsheetgrid.pas b/components/fpspreadsheet/fpspreadsheetgrid.pas index 890a8510f..f483bb805 100644 --- a/components/fpspreadsheet/fpspreadsheetgrid.pas +++ b/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); - FWorkbook := TsWorkbook.Create; - FWorkbook.ReadFormulas := FReadFormulas; + CreateNewWorkbook; FWorkbook.ReadFromFile(AFileName, AFormat); LoadFromWorksheet(FWorkbook.GetWorksheetByIndex(AWorksheetIndex)); finally @@ -3110,9 +3139,7 @@ procedure TsCustomWorksheetGrid.LoadFromSpreadsheetFile(AFileName: string; begin BeginUpdate; try - FreeAndNil(FWorkbook); - FWorkbook := TsWorkbook.Create; - FWorkbook.ReadFormulas := FReadFormulas; + CreateNewWorkbook; FWorkbook.ReadFromFile(AFilename); LoadFromWorksheet(FWorkbook.GetWorksheetByIndex(AWorksheetIndex)); finally