pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3476 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-08-13 14:05:29 +00:00
parent 0b79376fa6
commit 03913876d3
4 changed files with 141 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

45
components/fpspreadsheet/examples/spready/mainform.lfm
View File

@ -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

7
components/fpspreadsheet/examples/spready/mainform.pas
View File

@ -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;

83
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -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 }
@ -794,6 +800,7 @@ type
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;

39
components/fpspreadsheet/fpspreadsheetgrid.pas
View File

@ -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