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

fpspreadsheet: Beginning to calculate rpn formulas

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3248 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-06-27 14:24:23 +00:00
parent 47e01cf753
commit 9bcb71a1fc
5 changed files with 538 additions and 134 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
components/fpspreadsheet/examples/spready/spready.lpi
View File

@ -8,6 +8,7 @@
<MainUnit Value="0"/> <MainUnit Value="0"/>
<Title Value="spready"/> <Title Value="spready"/>
<UseXPManifest Value="True"/> <UseXPManifest Value="True"/>
<Icon Value="0"/>
</General> </General>
<VersionInfo> <VersionInfo>
<Language Value=""/> <Language Value=""/>

264
components/fpspreadsheet/fpsmath.pas Normal file
View File

@ -0,0 +1,264 @@
unit fpsmath;
{$mode objfpc}
interface
uses
Classes, SysUtils, fpspreadsheet;
type
TsArgumentType = (atNumber, atString, atBool, atError);
TsArgumentError = (aeOK, aeWrongType, aeDivideByZero, aeFuncNotDefined);
TsArgument = record
IsMissing: Boolean;
case ArgumentType: TsArgumentType of
atNumber : (NumberValue: Double);
atString : (StringValue: String);
atBool : (BoolValue: Boolean);
atError : (ErrorValue: TsArgumentError);
end;
PsArgument = ^TsArgument;
TsArgumentStack = class(TFPList)
public
destructor Destroy; override;
function Pop: TsArgument;
procedure Push(AValue: TsArgument);
procedure PushBool(AValue: Boolean);
procedure PushMissing;
procedure PushNumber(AValue: Double);
procedure PushString(AValue: String);
procedure Clear;
procedure Delete(AIndex: Integer);
end;
procedure CheckMissingBool (var Arg: TsArgument; ABool: Boolean);
procedure CheckMissingNumber(var Arg: TsArgument; ANumber: Double);
procedure CheckMissingString(var Arg: TsArgument; AString: String);
type
TsFormulaFunc = function(Args: TsArgumentStack): TsArgument;
function fpsAdd(Args: TsArgumentStack): TsArgument;
function fpsSub(Args: TsArgumentStack): TsArgument;
function fpsMul(Args: TsArgumentStack): TsArgument;
function fpsDiv(Args: TsArgumentStack): TsArgument;
implementation
{ TsArgumentStack }
destructor TsArgumentStack.Destroy;
begin
Clear;
inherited Destroy;
end;
procedure TsArgumentStack.Clear;
var
i: Integer;
begin
for i := Count-1 downto 0 do
Delete(i);
inherited Clear;
end;
procedure TsArgumentStack.Delete(AIndex: Integer);
var
P: PsArgument;
begin
P := PsArgument(Items[AIndex]);
P^.StringValue := '';
FreeMem(P, SizeOf(P));
inherited Delete(AIndex);
end;
function TsArgumentStack.Pop: TsArgument;
var
P: PsArgument;
begin
P := PsArgument(Items[Count-1]);
Result := P^;
Result.StringValue := P^.StringValue; // necessary?
Delete(Count-1);
end;
procedure TsArgumentStack.Push(AValue: TsArgument);
var
P: PsArgument;
begin
GetMem(P, SizeOf(TsArgument));
P^ := AValue;
P^.StringValue := AValue.StringValue;
Add(P);
end;
procedure TsArgumentStack.PushBool(AValue: Boolean);
var
arg: TsArgument;
begin
arg.ArgumentType := atBool;
arg.BoolValue := AValue;
arg.IsMissing := false;
Push(arg);
end;
procedure TsArgumentStack.PushMissing;
var
arg: TsArgument;
begin
arg.IsMissing := true;
Push(arg);
end;
procedure TsArgumentStack.PushNumber(AValue: Double);
var
arg: TsArgument;
begin
arg.ArgumentType := atNumber;
arg.NumberValue := AValue;
arg.IsMissing := false;
Push(arg);
end;
procedure TsArgumentStack.PushString(AValue: String);
var
arg: TsArgument;
begin
arg.ArgumentType := atString;
arg.StringValue := AValue;
arg.IsMissing := false;
Push(arg);
end;
{ Missing arguments }
{@@
Replaces a missing boolean argument by the passed boolean value
@param Arg Argument to be considered
@param ABool Replacement for the missing value
}
procedure CheckMissingBool(var Arg: TsArgument; ABool: Boolean);
begin
if Arg.IsMissing then Arg.BoolValue := ABool;
end;
{@@
Replaces a missing number argument by the passed number value
@param Arg Argument to be considered
@param ANumber Replacement for the missing value
}
procedure CheckMissingNumber(var Arg: TsArgument; ANumber: Double);
begin
if Arg.IsMissing then Arg.NumberValue := ANumber;
end;
{@@
Replaces a missing string argument by the passed string value
@param Arg Argument to be considered
@param AString Replacement for the missing value
}
procedure CheckMissingString(var Arg: TsArgument; AString: String);
begin
if Arg.IsMissing then Arg.StringValue := AString;
end;
{ Preparing arguments }
function GetNumberFromArgument(Arg: TsArgument; var ANumber: Double): TsArgumentError;
begin
Result := aeOK;
case Arg.ArgumentType of
atNumber : ANumber := Arg.NumberValue;
atString : if not TryStrToFloat(arg.StringValue, ANumber) then Result := aeWrongType;
atBool : if Arg.BoolValue then ANumber := 1.0 else ANumber := 0.0;
end;
end;
function CreateNumber(AValue: Double): TsArgument;
begin
Result.ArgumentType := atNumber;
Result.NumberValue := AValue;
end;
function CreateError(AError: TsArgumentError): TsArgument;
begin
Result.ArgumentType := atError;
Result.ErrorValue := AError;
end;
{ Operations }
function fpsAdd(Args: TsArgumentStack): TsArgument;
var
a, b: Double;
erra, errb: TsArgumentError;
begin
errb := GetNumberFromArgument(Args.Pop, b);
erra := GetNumberFromArgument(Args.Pop, a);
if erra <> aeOK then
Result := CreateError(erra)
else if errb <> aeOK then
Result := CreateError(errb)
else
Result := CreateNumber(a + b);
end;
function fpsSub(Args: TsArgumentStack): TsArgument;
var
a, b: Double;
erra, errb: TsArgumentError;
begin
// Pop the data in reverse order they were pushed!
errb := GetNumberFromArgument(Args.Pop, b);
erra := GetNumberFromArgument(Args.Pop, a);
if erra <> aeOK then
Result := CreateError(erra)
else if errb <> aeOK then
Result := CreateError(errb)
else
Result := CreateNumber(a - b);
end;
function fpsMul(Args: TsArgumentStack): TsArgument;
var
a, b: Double;
erra, errb: TsArgumentError;
begin
errb := GetNumberFromArgument(Args.Pop, b);
erra := GetNumberFromArgument(Args.Pop, a);
if erra <> aeOK then
Result := CreateError(erra)
else if errb <> aeOK then
Result := CreateError(errb)
else
Result := CreateNumber(a * b);
end;
function fpsDiv(Args: TsArgumentStack): TsArgument;
var
a, b: Double;
erra, errb: TsArgumentError;
begin
// Pop the data in reverse order they were pushed!
errb := GetNumberFromArgument(Args.Pop, b);
erra := GetNumberFromArgument(Args.Pop, a);
if erra <> aeOK then
Result := CreateError(erra)
else if errb <> aeOK then
Result := CreateError(errb)
else if b = 0 then
Result := CreateError(aeDivideByZero)
else
Result := CreateNumber(a / b);
end;
end.

399
components/fpspreadsheet/fpspreadsheet.pas
View File

@ -438,7 +438,8 @@ type
@param soHasFrozenPanes If set a number of rows and columns of the spreadsheet @param soHasFrozenPanes If set a number of rows and columns of the spreadsheet
is fixed and does not scroll. The number is defined by is fixed and does not scroll. The number is defined by
LeftPaneWidth and TopPaneHeight. } LeftPaneWidth and TopPaneHeight. }
TsSheetOption = (soShowGridLines, soShowHeaders, soHasFrozenPanes); TsSheetOption = (soShowGridLines, soShowHeaders, soHasFrozenPanes,
soCalcBeforeSaving);
{@@ Set of user interface options {@@ Set of user interface options
@ see TsSheetOption } @ see TsSheetOption }
@ -470,10 +471,13 @@ type
FOptions: TsSheetOptions; FOptions: TsSheetOptions;
FOnChangeCell: TsCellEvent; FOnChangeCell: TsCellEvent;
FOnChangeFont: TsCellEvent; FOnChangeFont: TsCellEvent;
procedure CalcFormulaCallback(data, arg: Pointer);
function GetFormatSettings: TFormatSettings; function GetFormatSettings: TFormatSettings;
procedure RemoveCallback(data, arg: pointer); procedure RemoveCallback(data, arg: pointer);
protected protected
procedure CalcRPNFormula(ACell: PCell);
procedure ChangedCell(ARow, ACol: Cardinal); procedure ChangedCell(ARow, ACol: Cardinal);
procedure ChangedFont(ARow, ACol: Cardinal); procedure ChangedFont(ARow, ACol: Cardinal);
@ -592,6 +596,7 @@ type
procedure WriteWordwrap(ARow, ACol: Cardinal; AValue: boolean); procedure WriteWordwrap(ARow, ACol: Cardinal; AValue: boolean);
{ Data manipulation methods - For Cells } { Data manipulation methods - For Cells }
procedure CalcFormulas;
procedure CopyCell(AFromRow, AFromCol, AToRow, AToCol: Cardinal; AFromWorksheet: TsWorksheet); procedure CopyCell(AFromRow, AFromCol, AToRow, AToCol: Cardinal; AFromWorksheet: TsWorksheet);
procedure CopyFormat(AFormat: PCell; AToRow, AToCol: Cardinal); overload; procedure CopyFormat(AFormat: PCell; AToRow, AToCol: Cardinal); overload;
procedure CopyFormat(AFromCell, AToCell: PCell); overload; procedure CopyFormat(AFromCell, AToCell: PCell); overload;
@ -671,6 +676,7 @@ type
FDefaultRowHeight: Single; // in "character heights", i.e. line count FDefaultRowHeight: Single; // in "character heights", i.e. line count
{ Internal methods } { Internal methods }
procedure PrepareBeforeSaving;
procedure RemoveWorksheetsCallback(data, arg: pointer); procedure RemoveWorksheetsCallback(data, arg: pointer);
public public
@ -983,7 +989,7 @@ procedure MakeLEPalette(APalette: PsPalette; APaletteSize: Integer);
implementation implementation
uses uses
Math, StrUtils, TypInfo, fpsUtils, fpsNumFormatParser; Math, StrUtils, TypInfo, fpsUtils, fpsNumFormatParser, fpsMath;
{ Translatable strings } { Translatable strings }
resourcestring resourcestring
@ -1076,149 +1082,154 @@ type
{@@ Properties of formula elements: {@@ Properties of formula elements:
@param Symbol Symbol used in the formula @param Symbol Symbol used in the formula
@param MinParams Minimum count of parameters used in this function @param MinParams Minimum count of parameters used in this function
@param MaxParams Maximum count of parameters used in this function } @param MaxParams Maximum count of parameters used in this function
TFEProp = record Symbol: String; MinParams, MaxParams: Byte; end; @param Func Function to be calculated }
TFEProp = record
Symbol: String;
MinParams, MaxParams: Byte;
Func: TsFormulaFunc;
end;
const const
FEProps: array[TFEKind] of TFEProp = ( FEProps: array[TFEKind] of TFEProp = (
{ Operands } { Operands }
(Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1)), // fekCell (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCell
(Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1)), // fekCellRef (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellRef
(Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1)), // fekCellRange (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellRange
(Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1)), // fekCellNum (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellNum
(Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1)), // fekCellInteger (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellInteger
(Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1)), // fekCellString (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellString
(Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1)), // fekCellBool (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellBool
(Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1)), // fekCellErr (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellErr
(Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1)), // fekCellMissingArg (Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCellMissingArg
{ Basic operations } { Basic operations }
(Symbol:'+'; MinParams:2; MaxParams:2), // fekAdd (Symbol:'+'; MinParams:2; MaxParams:2; Func:fpsAdd), // fekAdd
(Symbol:'-'; MinParams:2; MaxParams:2), // fekSub (Symbol:'-'; MinParams:2; MaxParams:2; Func:fpsSub), // fekSub
(Symbol:'*'; MinParams:2; MaxParams:2), // fekMul (Symbol:'*'; MinParams:2; MaxParams:2; Func:fpsMul), // fekMul
(Symbol:'/'; MinParams:2; MaxParams:2), // fekDiv (Symbol:'/'; MinParams:2; MaxParams:2; Func:fpsDiv), // fekDiv
(Symbol:'%'; MinParams:1; MaxParams:1), // fekPercent (Symbol:'%'; MinParams:1; MaxParams:1; Func:nil), // fekPercent
(Symbol:'^'; MinParams:2; MaxParams:2), // fekPower (Symbol:'^'; MinParams:2; MaxParams:2; Func:nil), // fekPower
(Symbol:'-'; MinParams:1; MaxParams:1), // fekUMinus (Symbol:'-'; MinParams:1; MaxParams:1; Func:nil), // fekUMinus
(Symbol:'+'; MinParams:1; MaxParams:1), // fekUPlus (Symbol:'+'; MinParams:1; MaxParams:1; Func:nil), // fekUPlus
(Symbol:'&'; MinParams:2; MaxParams:2), // fekConcat (string concatenation) (Symbol:'&'; MinParams:2; MaxParams:2; Func:nil), // fekConcat (string concatenation)
(Symbol:'='; MinParams:2; MaxParams:2), // fekEqual (Symbol:'='; MinParams:2; MaxParams:2; Func:nil), // fekEqual
(Symbol:'>'; MinParams:2; MaxParams:2), // fekGreater (Symbol:'>'; MinParams:2; MaxParams:2; Func:nil), // fekGreater
(Symbol:'>='; MinParams:2; MaxParams:2), // fekGreaterEqual (Symbol:'>='; MinParams:2; MaxParams:2; Func:nil), // fekGreaterEqual
(Symbol:'<'; MinParams:2; MaxParams:2), // fekLess (Symbol:'<'; MinParams:2; MaxParams:2; Func:nil), // fekLess
(Symbol:'<='; MinParams:2; MaxParams:2), // fekLessEqual (Symbol:'<='; MinParams:2; MaxParams:2; Func:nil), // fekLessEqual
(Symbol:'<>'; MinParams:2; MaxParams:2), // fekNotEqual (Symbol:'<>'; MinParams:2; MaxParams:2; Func:nil), // fekNotEqual
(Symbol:''; MinParams:1; MaxParams:1), // fekParen (Symbol:''; MinParams:1; MaxParams:1; Func:nil), // fekParen
{ math } { math }
(Symbol:'ABS'; MinParams:1; MaxParams:1), // fekABS (Symbol:'ABS'; MinParams:1; MaxParams:1; Func:nil), // fekABS
(Symbol:'ACOS'; MinParams:1; MaxParams:1), // fekACOS (Symbol:'ACOS'; MinParams:1; MaxParams:1; Func:nil), // fekACOS
(Symbol:'ACOSH'; MinParams:1; MaxParams:1), // fekACOSH (Symbol:'ACOSH'; MinParams:1; MaxParams:1; Func:nil), // fekACOSH
(Symbol:'ASIN'; MinParams:1; MaxParams:1), // fekASIN (Symbol:'ASIN'; MinParams:1; MaxParams:1; Func:nil), // fekASIN
(Symbol:'ASINH'; MinParams:1; MaxParams:1), // fekASINH (Symbol:'ASINH'; MinParams:1; MaxParams:1; Func:nil), // fekASINH
(Symbol:'ATAN'; MinParams:1; MaxParams:1), // fekATAN (Symbol:'ATAN'; MinParams:1; MaxParams:1; Func:nil), // fekATAN
(Symbol:'ATANH'; MinParams:1; MaxParams:1), // fekATANH, (Symbol:'ATANH'; MinParams:1; MaxParams:1; Func:nil), // fekATANH,
(Symbol:'COS'; MinParams:1; MaxParams:1), // fekCOS (Symbol:'COS'; MinParams:1; MaxParams:1; Func:nil), // fekCOS
(Symbol:'COSH'; MinParams:1; MaxParams:1), // fekCOSH (Symbol:'COSH'; MinParams:1; MaxParams:1; Func:nil), // fekCOSH
(Symbol:'DEGREES'; MinParams:1; MaxParams:1), // fekDEGREES (Symbol:'DEGREES'; MinParams:1; MaxParams:1; Func:nil), // fekDEGREES
(Symbol:'EXP'; MinParams:1; MaxParams:1), // fekEXP (Symbol:'EXP'; MinParams:1; MaxParams:1; Func:nil), // fekEXP
(Symbol:'INT'; MinParams:1; MaxParams:1), // fekINT (Symbol:'INT'; MinParams:1; MaxParams:1; Func:nil), // fekINT
(Symbol:'LN'; MinParams:1; MaxParams:1), // fekLN (Symbol:'LN'; MinParams:1; MaxParams:1; Func:nil), // fekLN
(Symbol:'LOG'; MinParams:1; MaxParams:2), // fekLOG, (Symbol:'LOG'; MinParams:1; MaxParams:2; Func:nil), // fekLOG,
(Symbol:'LOG10'; MinParams:1; MaxParams:1), // fekLOG10 (Symbol:'LOG10'; MinParams:1; MaxParams:1; Func:nil), // fekLOG10
(Symbol:'PI'; MinParams:0; MaxParams:0), // fekPI (Symbol:'PI'; MinParams:0; MaxParams:0; Func:nil), // fekPI
(Symbol:'RADIANS'; MinParams:1; MaxParams:1), // fekRADIANS (Symbol:'RADIANS'; MinParams:1; MaxParams:1; Func:nil), // fekRADIANS
(Symbol:'RAND'; MinParams:0; MaxParams:0), // fekRAND (Symbol:'RAND'; MinParams:0; MaxParams:0; Func:nil), // fekRAND
(Symbol:'ROUND'; MinParams:2; MaxParams:2), // fekROUND, (Symbol:'ROUND'; MinParams:2; MaxParams:2; Func:nil), // fekROUND,
(Symbol:'SIGN'; MinParams:1; MaxParams:1), // fekSIGN (Symbol:'SIGN'; MinParams:1; MaxParams:1; Func:nil), // fekSIGN
(Symbol:'SIN'; MinParams:1; MaxParams:1), // fekSIN (Symbol:'SIN'; MinParams:1; MaxParams:1; Func:nil), // fekSIN
(Symbol:'SINH'; MinParams:1; MaxParams:1), // fekSINH (Symbol:'SINH'; MinParams:1; MaxParams:1; Func:nil), // fekSINH
(Symbol:'SQRT'; MinParams:1; MaxParams:1), // fekSQRT, (Symbol:'SQRT'; MinParams:1; MaxParams:1; Func:nil), // fekSQRT,
(Symbol:'TAN'; MinParams:1; MaxParams:1), // fekTAN (Symbol:'TAN'; MinParams:1; MaxParams:1; Func:nil), // fekTAN
(Symbol:'TANH'; MinParams:1; MaxParams:1), // fekTANH, (Symbol:'TANH'; MinParams:1; MaxParams:1; Func:nil), // fekTANH,
{ date/time } { date/time }
(Symbol:'DATE'; MinParams:3; MaxParams:3), // fekDATE (Symbol:'DATE'; MinParams:3; MaxParams:3; Func:nil), // fekDATE
(Symbol:'DATEDIF'; MinParams:3; MaxParams:3), // fekDATEDIF (Symbol:'DATEDIF'; MinParams:3; MaxParams:3; Func:nil), // fekDATEDIF
(Symbol:'DATEVALUE'; MinParams:1; MaxParams:1), // fekDATEVALUE (Symbol:'DATEVALUE'; MinParams:1; MaxParams:1; Func:nil), // fekDATEVALUE
(Symbol:'DAY'; MinParams:1; MaxParams:1), // fekDAY (Symbol:'DAY'; MinParams:1; MaxParams:1; Func:nil), // fekDAY
(Symbol:'HOUR'; MinParams:1; MaxParams:1), // fekHOUR (Symbol:'HOUR'; MinParams:1; MaxParams:1; Func:nil), // fekHOUR
(Symbol:'MINUTE'; MinParams:1; MaxParams:1), // fekMINUTE (Symbol:'MINUTE'; MinParams:1; MaxParams:1; Func:nil), // fekMINUTE
(Symbol:'MONTH'; MinParams:1; MaxParams:1), // fekMONTH (Symbol:'MONTH'; MinParams:1; MaxParams:1; Func:nil), // fekMONTH
(Symbol:'NOW'; MinParams:0; MaxParams:0), // fekNOW (Symbol:'NOW'; MinParams:0; MaxParams:0; Func:nil), // fekNOW
(Symbol:'SECOND'; MinParams:1; MaxParams:1), // fekSECOND (Symbol:'SECOND'; MinParams:1; MaxParams:1; Func:nil), // fekSECOND
(Symbol:'TIME'; MinParams:3; MaxParams:3), // fekTIME (Symbol:'TIME'; MinParams:3; MaxParams:3; Func:nil), // fekTIME
(Symbol:'TIMEVALUE'; MinParams:1; MaxParams:1), // fekTIMEVALUE (Symbol:'TIMEVALUE'; MinParams:1; MaxParams:1; Func:nil), // fekTIMEVALUE
(Symbol:'TODAY'; MinParams:0; MaxParams:0), // fekTODAY (Symbol:'TODAY'; MinParams:0; MaxParams:0; Func:nil), // fekTODAY
(Symbol:'WEEKDAY'; MinParams:1; MaxParams:2), // fekWEEKDAY (Symbol:'WEEKDAY'; MinParams:1; MaxParams:2; Func:nil), // fekWEEKDAY
(Symbol:'YEAR'; MinParams:1; MaxParams:1), // fekYEAR (Symbol:'YEAR'; MinParams:1; MaxParams:1; Func:nil), // fekYEAR
{ statistical } { statistical }
(Symbol:'AVEDEV'; MinParams:1; MaxParams:30), // fekAVEDEV (Symbol:'AVEDEV'; MinParams:1; MaxParams:30; Func:nil), // fekAVEDEV
(Symbol:'AVERAGE'; MinParams:1; MaxParams:30), // fekAVERAGE (Symbol:'AVERAGE'; MinParams:1; MaxParams:30; Func:nil), // fekAVERAGE
(Symbol:'BETADIST'; MinParams:3; MaxParams:5), // fekBETADIST (Symbol:'BETADIST'; MinParams:3; MaxParams:5; Func:nil), // fekBETADIST
(Symbol:'BETAINV'; MinParams:3; MaxParams:5), // fekBETAINV (Symbol:'BETAINV'; MinParams:3; MaxParams:5; Func:nil), // fekBETAINV
(Symbol:'BINOMDIST'; MinParams:4; MaxParams:4), // fekBINOMDIST (Symbol:'BINOMDIST'; MinParams:4; MaxParams:4; Func:nil), // fekBINOMDIST
(Symbol:'CHIDIST'; MinParams:2; MaxParams:2), // fekCHIDIST (Symbol:'CHIDIST'; MinParams:2; MaxParams:2; Func:nil), // fekCHIDIST
(Symbol:'CHIINV'; MinParams:2; MaxParams:2), // fekCHIINV (Symbol:'CHIINV'; MinParams:2; MaxParams:2; Func:nil), // fekCHIINV
(Symbol:'COUNT'; MinParams:0; MaxParams:30), // fekCOUNT (Symbol:'COUNT'; MinParams:0; MaxParams:30; Func:nil), // fekCOUNT
(Symbol:'COUNTA'; MinParams:0; MaxParams:30), // fekCOUNTA (Symbol:'COUNTA'; MinParams:0; MaxParams:30; Func:nil), // fekCOUNTA
(Symbol:'COUNTBLANK';MinParams:1; MaxParams:1), // fekCOUNTBLANK (Symbol:'COUNTBLANK';MinParams:1; MaxParams:1; Func:nil), // fekCOUNTBLANK
(Symbol:'COUNTIF'; MinParams:2; MaxParams:2), // fekCOUNTIF (Symbol:'COUNTIF'; MinParams:2; MaxParams:2; Func:nil), // fekCOUNTIF
(Symbol:'MAX'; MinParams:1; MaxParams:30), // fekMAX (Symbol:'MAX'; MinParams:1; MaxParams:30; Func:nil), // fekMAX
(Symbol:'MEDIAN'; MinParams:1; MaxParams:30), // fekMEDIAN (Symbol:'MEDIAN'; MinParams:1; MaxParams:30; Func:nil), // fekMEDIAN
(Symbol:'MIN'; MinParams:1; MaxParams:30), // fekMIN (Symbol:'MIN'; MinParams:1; MaxParams:30; Func:nil), // fekMIN
(Symbol:'PERMUT'; MinParams:2; MaxParams:2), // fekPERMUT (Symbol:'PERMUT'; MinParams:2; MaxParams:2; Func:nil), // fekPERMUT
(Symbol:'POISSON'; MinParams:3; MaxParams:3), // fekPOISSON (Symbol:'POISSON'; MinParams:3; MaxParams:3; Func:nil), // fekPOISSON
(Symbol:'PRODUCT'; MinParams:0; MaxParams:30), // fekPRODUCT (Symbol:'PRODUCT'; MinParams:0; MaxParams:30; Func:nil), // fekPRODUCT
(Symbol:'STDEV'; MinParams:1; MaxParams:30), // fekSTDEV (Symbol:'STDEV'; MinParams:1; MaxParams:30; Func:nil), // fekSTDEV
(Symbol:'STDEVP'; MinParams:1; MaxParams:30), // fekSTDEVP (Symbol:'STDEVP'; MinParams:1; MaxParams:30; Func:nil), // fekSTDEVP
(Symbol:'SUM'; MinParams:0; MaxParams:30), // fekSUM (Symbol:'SUM'; MinParams:0; MaxParams:30; Func:nil), // fekSUM
(Symbol:'SUMIF'; MinParams:2; MaxParams:3), // fekSUMIF (Symbol:'SUMIF'; MinParams:2; MaxParams:3; Func:nil), // fekSUMIF
(Symbol:'SUMSQ'; MinParams:0; MaxParams:30), // fekSUMSQ (Symbol:'SUMSQ'; MinParams:0; MaxParams:30; Func:nil), // fekSUMSQ
(Symbol:'VAR'; MinParams:1; MaxParams:30), // fekVAR (Symbol:'VAR'; MinParams:1; MaxParams:30; Func:nil), // fekVAR
(Symbol:'VARP'; MinParams:1; MaxParams:30), // fekVARP (Symbol:'VARP'; MinParams:1; MaxParams:30; Func:nil), // fekVARP
{ financial } { financial }
(Symbol:'FV'; MinParams:3; MaxParams:5), // fekFV (Symbol:'FV'; MinParams:3; MaxParams:5; Func:nil), // fekFV
(Symbol:'NPER'; MinParams:3; MaxParams:5), // fekNPER (Symbol:'NPER'; MinParams:3; MaxParams:5; Func:nil), // fekNPER
(Symbol:'PMT'; MinParams:3; MaxParams:5), // fekPMT (Symbol:'PMT'; MinParams:3; MaxParams:5; Func:nil), // fekPMT
(Symbol:'PV'; MinParams:3; MaxParams:5), // fekPV (Symbol:'PV'; MinParams:3; MaxParams:5; Func:nil), // fekPV
(Symbol:'RATE'; MinParams:3; MaxParams:6), // fekRATE (Symbol:'RATE'; MinParams:3; MaxParams:6; Func:nil), // fekRATE
{ logical } { logical }
(Symbol:'AND'; MinParams:0; MaxParams:30), // fekAND (Symbol:'AND'; MinParams:0; MaxParams:30; Func:nil), // fekAND
(Symbol:'FALSE'; MinParams:0; MaxParams:0), // fekFALSE (Symbol:'FALSE'; MinParams:0; MaxParams:0; Func:nil), // fekFALSE
(Symbol:'IF'; MinParams:2; MaxParams:3), // fekIF (Symbol:'IF'; MinParams:2; MaxParams:3; Func:nil), // fekIF
(Symbol:'NOT'; MinParams:1; MaxParams:1), // fekNOT (Symbol:'NOT'; MinParams:1; MaxParams:1; Func:nil), // fekNOT
(Symbol:'OR'; MinParams:1; MaxParams:30), // fekOR (Symbol:'OR'; MinParams:1; MaxParams:30; Func:nil), // fekOR
(Symbol:'TRUE'; MinParams:0; MaxParams:0), // fekTRUE (Symbol:'TRUE'; MinParams:0; MaxParams:0; Func:nil), // fekTRUE
{ string } { string }
(Symbol:'CHAR'; MinParams:1; MaxParams:1), // fekCHAR (Symbol:'CHAR'; MinParams:1; MaxParams:1; Func:nil), // fekCHAR
(Symbol:'CODE'; MinParams:1; MaxParams:1), // fekCODE (Symbol:'CODE'; MinParams:1; MaxParams:1; Func:nil), // fekCODE
(Symbol:'LEFT'; MinParams:1; MaxParams:2), // fekLEFT (Symbol:'LEFT'; MinParams:1; MaxParams:2; Func:nil), // fekLEFT
(Symbol:'LOWER'; MinParams:1; MaxParams:1), // fekLOWER (Symbol:'LOWER'; MinParams:1; MaxParams:1; Func:nil), // fekLOWER
(Symbol:'MID'; MinParams:3; MaxParams:3), // fekMID (Symbol:'MID'; MinParams:3; MaxParams:3; Func:nil), // fekMID
(Symbol:'PROPER'; MinParams:1; MaxParams:1), // fekPROPER (Symbol:'PROPER'; MinParams:1; MaxParams:1; Func:nil), // fekPROPER
(Symbol:'REPLACE'; MinParams:4; MaxParams:4), // fekREPLACE (Symbol:'REPLACE'; MinParams:4; MaxParams:4; Func:nil), // fekREPLACE
(Symbol:'RIGHT'; MinParams:1; MaxParams:2), // fekRIGHT (Symbol:'RIGHT'; MinParams:1; MaxParams:2; Func:nil), // fekRIGHT
(Symbol:'SUBSTITUTE';MinParams:3; MaxParams:4), // fekSUBSTITUTE (Symbol:'SUBSTITUTE';MinParams:3; MaxParams:4; Func:nil), // fekSUBSTITUTE
(Symbol:'TRIM'; MinParams:1; MaxParams:1), // fekTRIM (Symbol:'TRIM'; MinParams:1; MaxParams:1; Func:nil), // fekTRIM
(Symbol:'UPPER'; MinParams:1; MaxParams:1), // fekUPPER (Symbol:'UPPER'; MinParams:1; MaxParams:1; Func:nil), // fekUPPER
{ lookup/reference } { lookup/reference }
(Symbol:'COLUMN'; MinParams:0; MaxParams:1), // fekCOLUMN (Symbol:'COLUMN'; MinParams:0; MaxParams:1; Func:nil), // fekCOLUMN
(Symbol:'COLUMNS'; MinParams:1; MaxParams:1), // fekCOLUMNS (Symbol:'COLUMNS'; MinParams:1; MaxParams:1; Func:nil), // fekCOLUMNS
(Symbol:'ROW'; MinParams:0; MaxParams:1), // fekROW (Symbol:'ROW'; MinParams:0; MaxParams:1; Func:nil), // fekROW
(Symbol:'ROWS'; MinParams:1; MaxParams:1), // fekROWS (Symbol:'ROWS'; MinParams:1; MaxParams:1; Func:nil), // fekROWS
{ info } { info }
(Symbol:'CELL'; MinParams:1; MaxParams:2), // fekCELLINFO (Symbol:'CELL'; MinParams:1; MaxParams:2; Func:nil), // fekCELLINFO
(Symbol:'INFO'; MinParams:1; MaxParams:1), // fekINFO (Symbol:'INFO'; MinParams:1; MaxParams:1; Func:nil), // fekINFO
(Symbol:'ISBLANK'; MinParams:1; MaxParams:1), // fekIsBLANK (Symbol:'ISBLANK'; MinParams:1; MaxParams:1; Func:nil), // fekIsBLANK
(Symbol:'ISERR'; MinParams:1; MaxParams:1), // fekIsERR (Symbol:'ISERR'; MinParams:1; MaxParams:1; Func:nil), // fekIsERR
(Symbol:'ISERROR'; MinParams:1; MaxParams:1), // fekIsERROR (Symbol:'ISERROR'; MinParams:1; MaxParams:1; Func:nil), // fekIsERROR
(Symbol:'ISLOGICAL'; MinParams:1; MaxParams:1), // fekIsLOGICAL (Symbol:'ISLOGICAL'; MinParams:1; MaxParams:1; Func:nil), // fekIsLOGICAL
(Symbol:'ISNA'; MinParams:1; MaxParams:1), // fekIsNA (Symbol:'ISNA'; MinParams:1; MaxParams:1; Func:nil), // fekIsNA
(Symbol:'ISNONTEXT'; MinParams:1; MaxParams:1), // fekIsNONTEXT (Symbol:'ISNONTEXT'; MinParams:1; MaxParams:1; Func:nil), // fekIsNONTEXT
(Symbol:'ISNUMBER'; MinParams:1; MaxParams:1), // fekIsNUMBER (Symbol:'ISNUMBER'; MinParams:1; MaxParams:1; Func:nil), // fekIsNUMBER
(Symbol:'ISREF'; MinParams:1; MaxParams:1), // fekIsRef (Symbol:'ISREF'; MinParams:1; MaxParams:1; Func:nil), // fekIsRef
(Symbol:'ISTEXT'; MinParams:1; MaxParams:1), // fekIsTEXT (Symbol:'ISTEXT'; MinParams:1; MaxParams:1; Func:nil), // fekIsTEXT
(Symbol:'VALUE'; MinParams:1; MaxParams:1), // fekValue (Symbol:'VALUE'; MinParams:1; MaxParams:1; Func:nil), // fekValue
{ Other operations } { Other operations }
(Symbol:'SUM'; MinParams:1; MaxParams:1) // fekOpSUM (Unary sum operation). Note: CANNOT be used for summing sell contents; use fekSUM} (Symbol:'SUM'; MinParams:1; MaxParams:1; Func:nil) // fekOpSUM (Unary sum operation). Note: CANNOT be used for summing sell contents; use fekSUM}
); );
{@@ {@@
@ -1372,6 +1383,116 @@ begin
inherited Destroy; inherited Destroy;
end; end;
{@@
Helper method for clearing the records in a spreadsheet.
}
procedure TsWorksheet.CalcFormulaCallback(data, arg: pointer);
var
cell: PCell;
begin
Unused(arg);
cell := PCell(data);
// Empty cell or error cell --> nothing to do
if (cell = nil) or (cell^.ContentType = cctError) then
exit;
// Cell contains an RPN formula --> calculate the formula
if Length(cell^.RPNFormulaValue) > 0 then
CalcRPNFormula(cell);
end;
{@@
}
procedure TsWorksheet.CalcFormulas;
var
node: TAVLTreeNode;
begin
Node := FCells.FindLowest;
while Assigned(Node) do begin
CalcFormulaCallback(Node.Data, nil);
node := FCells.FindSuccessor(node);
end;
end;
{@@
}
procedure TsWorksheet.CalcRPNFormula(ACell: PCell);
var
i: Integer;
formula: TsRPNFormula;
args: TsArgumentStack;
func: TsFormulaFunc;
val: TsArgument;
fe: TsFormulaElement;
begin
if (Length(ACell^.RPNFormulaValue) = 0) or
(ACell^.ContentType = cctError)
then
exit;
args := TsArgumentStack.Create;
try
for i := 0 to Length(ACell^.RPNFormulaValue) - 1 do begin
fe := ACell^.RPNFormulaValue[i]; // "formula element"
case fe.ElementKind of
fekCell: ;
fekCellRef: ;
fekCellRange: ;
fekNum:
args.PushNumber(fe.DoubleValue);
fekInteger:
args.PushNumber(1.0*fe.IntValue);
fekString:
args.PushString(fe.StringValue);
fekBool:
args.PushBool(fe.DoubleValue <> 0.0);
fekMissingArg:
args.PushMissing;
fekParen: ; // visual effect only
fekErr:
exit;
else
func := FEProps[fe.ElementKind].Func;
if not Assigned(func) then begin
// calculation of function not implemented
exit;
end; {
if args.Count < FEProps[fe.ElementKind].MinParams then begin
// not enough parameters
exit;
end;
if args.Count > FEProps[fe.ElementKind].MaxParams then begin
// too many parameters
exit;
end; }
// Result of function
val := func(args);
// Push valid result on stack, exit in case of error
case val.ArgumentType of
atNumber, atString, atBool:
args.Push(val);
atError:
exit;
end;
end; // case
end; // for
if args.Count = 1 then begin
val := args.Pop;
case val.ArgumentType of
atNumber: WriteNumber(ACell, val.NumberValue);
atBool : WriteNumber(ACell, 1.0*ord(val.BoolValue));
atString: WriteUTF8Text(ACell, val.StringValue);
end;
end else
WriteErrorValue(ACell, errArgError);
finally
args.Free;
end;
end;
{@@ {@@
Converts a FPSpreadsheet cell position, which is Row, Col in numbers Converts a FPSpreadsheet cell position, which is Row, Col in numbers
and zero based, to a textual representation which is [Col][Row], and zero based, to a textual representation which is [Col][Row],
@ -3458,6 +3579,19 @@ end;
{ TsWorkbook } { TsWorkbook }
{@@
Helper method called before saving the workbook. Calculates the formulas
in all worksheets having the option soCalcBeforeSaving set.
}
procedure TsWorkbook.PrepareBeforeSaving;
var
sheet: TsWorksheet;
begin
for sheet in FWorksheets do
if (soCalcBeforeSaving in sheet.Options) then
sheet.CalcFormulas;
end;
{@@ {@@
Helper method for clearing the spreadsheet list. Helper method for clearing the spreadsheet list.
} }
@ -3699,6 +3833,7 @@ var
begin begin
AWriter := CreateSpreadWriter(AFormat); AWriter := CreateSpreadWriter(AFormat);
try try
PrepareBeforeSaving;
AWriter.WriteToFile(AFileName, AOverwriteExisting); AWriter.WriteToFile(AFileName, AOverwriteExisting);
finally finally
AWriter.Free; AWriter.Free;
@ -3737,8 +3872,8 @@ var
AWriter: TsCustomSpreadWriter; AWriter: TsCustomSpreadWriter;
begin begin
AWriter := CreateSpreadWriter(AFormat); AWriter := CreateSpreadWriter(AFormat);
try try
PrepareBeforeSaving;
AWriter.WriteToStream(AStream); AWriter.WriteToStream(AStream);
finally finally
AWriter.Free; AWriter.Free;

6
components/fpspreadsheet/laz_fpspreadsheet.lpk
View File

@ -26,7 +26,7 @@
This package is all you need if you don't want graphical components (like grids and charts)."/> This package is all you need if you don't want graphical components (like grids and charts)."/>
<License Value="LGPL with static linking exception. This is the same license as is used in the LCL (Lazarus Component Library)."/> <License Value="LGPL with static linking exception. This is the same license as is used in the LCL (Lazarus Component Library)."/>
<Version Major="1" Minor="2"/> <Version Major="1" Minor="2"/>
<Files Count="20"> <Files Count="21">
<Item1> <Item1>
<Filename Value="fpolestorage.pas"/> <Filename Value="fpolestorage.pas"/>
<UnitName Value="fpolestorage"/> <UnitName Value="fpolestorage"/>
@ -107,6 +107,10 @@ This package is all you need if you don't want graphical components (like grids
<Filename Value="fpsnumformatparser.pas"/> <Filename Value="fpsnumformatparser.pas"/>
<UnitName Value="fpsNumFormatParser"/> <UnitName Value="fpsNumFormatParser"/>
</Item20> </Item20>
<Item21>
<Filename Value="fpsmath.pas"/>
<UnitName Value="fpsmath"/>
</Item21>
</Files> </Files>
<RequiredPkgs Count="2"> <RequiredPkgs Count="2">
<Item1> <Item1>

2
components/fpspreadsheet/laz_fpspreadsheet.pas
View File

@ -11,7 +11,7 @@ uses
xlsbiff5, xlsbiff8, xlsxooxml, fpsutils, fpszipper, uvirtuallayer_types, xlsbiff5, xlsbiff8, xlsxooxml, fpsutils, fpszipper, uvirtuallayer_types,
uvirtuallayer, uvirtuallayer_ole, uvirtuallayer_ole_helpers, uvirtuallayer, uvirtuallayer_ole, uvirtuallayer_ole_helpers,
uvirtuallayer_ole_types, uvirtuallayer_stream, fpolebasic, xlscommon, uvirtuallayer_ole_types, uvirtuallayer_stream, fpolebasic, xlscommon,
wikitable, fpsNumFormatParser; wikitable, fpsNumFormatParser, fpsmath;
implementation implementation