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

fpspreadsheet: Add some more formulas

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3511 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2014-09-01 22:37:14 +00:00
parent 56b814ec17
commit c03833de40
7 changed files with 364 additions and 78 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/fpspreadsheet/examples/other/demo_expression_parser.pas
View File

@ -41,7 +41,7 @@ begin
//cell := Worksheet.WriteFormula(1, 0, 'Day(Date(2014, 1, 12))'); //cell := Worksheet.WriteFormula(1, 0, 'Day(Date(2014, 1, 12))');
//cell := Worksheet.WriteFormula(1, 0, 'SUM(1,2,3)'); //cell := Worksheet.WriteFormula(1, 0, 'SUM(1,2,3)');
//cell := Worksheet.WriteFormula(1, 0, 'CELL("address",A1)'); //cell := Worksheet.WriteFormula(1, 0, 'CELL("address",A1)');
cell := Worksheet.WriteFormula(1, 0, 'SUM(A1, 1.2, 1.3)'); cell := Worksheet.WriteFormula(1, 0, 'REPT("Hallo", 3)');
WriteLn('A1: ', worksheet.ReadAsUTF8Text(0, 0)); WriteLn('A1: ', worksheet.ReadAsUTF8Text(0, 0));
WriteLn('B1: ', worksheet.ReadAsUTF8Text(0, 1)); WriteLn('B1: ', worksheet.ReadAsUTF8Text(0, 1));

174
components/fpspreadsheet/fpsfunc.pas
View File

@ -16,7 +16,7 @@ procedure RegisterStdBuiltins(AManager : TsBuiltInExpressionManager);
implementation implementation
uses uses
Math, lazutf8, DateUtils, xlsconst, fpsUtils; Math, lazutf8, StrUtils, DateUtils, xlsconst, fpsUtils;
{------------------------------------------------------------------------------} {------------------------------------------------------------------------------}
@ -82,6 +82,20 @@ begin
Result := ErrorResult(errOverflow); // #NUM! Result := ErrorResult(errOverflow); // #NUM!
end; end;
procedure fpsCEILING(var Result: TsExpressionResult; const Args: TsExprParameterArray);
// CEILING( number, significance )
// returns a number rounded up to a multiple of significance
var
num, sig: TsExprFloat;
begin
num := ArgToFloat(Args[0]);
sig := ArgToFloat(Args[1]);
if sig = 0 then
Result := ErrorResult(errDivideByZero)
else
Result := FloatResult(ceil(num/sig)*sig);
end;
procedure fpsCOS(var Result: TsExpressionResult; const Args: TsExprParameterArray); procedure fpsCOS(var Result: TsExpressionResult; const Args: TsExprParameterArray);
begin begin
Result := FloatResult(cos(ArgToFloat(Args[0]))); Result := FloatResult(cos(ArgToFloat(Args[0])));
@ -97,11 +111,77 @@ begin
Result := FloatResult(RadToDeg(ArgToFloat(Args[0]))); Result := FloatResult(RadToDeg(ArgToFloat(Args[0])));
end; end;
procedure fpsEVEN(var Result: TsExpressionResult; const Args: TsExprParameterArray);
// EVEN( number )
// rounds a number up to the nearest even integer.
// If the number is negative, the number is rounded away from zero.
var
x: TsExprFloat;
n: Integer;
begin
if Args[0].ResultType in [rtInteger, rtFloat, rtDateTime, rtCell, rtEmpty] then begin
x := ArgToFloat(Args[0]);
if x > 0 then
begin
n := Trunc(x) + 1;
if odd(n) then inc(n);
end else
if x < 0 then
begin
n := Trunc(x) - 1;
if odd(n) then dec(n);
end else
n := 0;
Result := IntegerResult(n);
end
else
Result := ErrorResult(errWrongType);
end;
procedure fpsEXP(var Result: TsExpressionResult; const Args: TsExprParameterArray); procedure fpsEXP(var Result: TsExpressionResult; const Args: TsExprParameterArray);
begin begin
Result := FloatResult(exp(ArgToFloat(Args[0]))); Result := FloatResult(exp(ArgToFloat(Args[0])));
end; end;
procedure fpsFACT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
// FACT( number )
// returns the factorial of a number.
var
res: TsExprFloat;
i, n: Integer;
begin
if Args[0].ResultType in [rtInteger, rtFloat, rtEmpty, rtDateTime] then
begin
res := 1.0;
n := ArgToInt(Args[0]);
if n < 0 then
Result := ErrorResult(errOverflow)
else
try
for i:=1 to n do
res := res * i;
Result := FloatResult(res);
except on E:Exception do
Result := ErrorResult(errOverflow);
end;
end else
Result := ErrorResult(errWrongType);
end;
procedure fpsFLOOR(var Result: TsExpressionResult; const Args: TsExprParameterArray);
// FLOOR( number, significance )
// returns a number rounded down to a multiple of significance
var
num, sig: TsExprFloat;
begin
num := ArgToFloat(Args[0]);
sig := ArgToFloat(Args[1]);
if sig = 0 then
Result := ErrorResult(errDivideByZero)
else
Result := FloatResult(floor(num/sig)*sig);
end;
procedure fpsINT(var Result: TsExpressionResult; const Args: TsExprParameterArray); procedure fpsINT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
begin begin
Result := FloatResult(floor(ArgToFloat(Args[0]))); Result := FloatResult(floor(ArgToFloat(Args[0])));
@ -153,6 +233,46 @@ begin
Result := ErrorResult(errOverflow); // #NUM! Result := ErrorResult(errOverflow); // #NUM!
end; end;
procedure fpsMOD(var Result: TsExpressionResult; const Args: TsExprParameterArray);
// MOD( number, divisor )
// Returns the remainder after a number is divided by a divisor.
var
n, m: Integer;
begin
n := ArgToInt(Args[0]);
m := ArgToInt(Args[1]);
if m = 0 then
Result := ErrorResult(errDivideByZero)
else
Result := IntegerResult(n mod m);
end;
procedure fpsODD(var Result: TsExpressionResult; const Args: TsExprParameterArray);
// ODD( number )
// rounds a number up to the nearest odd integer.
// If the number is negative, the number is rounded away from zero.
var
x: TsExprFloat;
n: Integer;
begin
if Args[0].ResultType in [rtInteger, rtFloat, rtDateTime, rtCell, rtEmpty] then
begin
x := ArgToFloat(Args[0]);
if x >= 0 then
begin
n := Trunc(x) + 1;
if not odd(n) then inc(n);
end else
begin
n := Trunc(x) - 1;
if not odd(n) then dec(n);
end;
Result := IntegerResult(n);
end
else
Result := ErrorResult(errWrongType);
end;
procedure fpsPI(var Result: TsExpressionResult; const Args: TsExprParameterArray); procedure fpsPI(var Result: TsExpressionResult; const Args: TsExprParameterArray);
begin begin
Unused(Args); Unused(Args);
@ -554,6 +674,17 @@ begin
Result := StringResult(s); Result := StringResult(s);
end; end;
procedure fpsEXACT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
// EXACT( text1, text2 )
// Compares two strings (case-sensitive) and returns TRUE if they are equal
var
s1, s2: String;
begin
s1 := ArgToString(Args[0]);
s2 := ArgToString(Args[1]);
Result := BooleanResult(s1 = s2);
end;
procedure fpsLEFT(var Result: TsExpressionResult; const Args: TsExprParameterArray); procedure fpsLEFT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
// LEFT( text, [number_of_characters] ) // LEFT( text, [number_of_characters] )
// extracts a substring from a string, starting from the left-most character // extracts a substring from a string, starting from the left-most character
@ -561,7 +692,7 @@ var
s: String; s: String;
count: Integer; count: Integer;
begin begin
s := Args[0].ResString; s := ArgToString(Args[0]);
if s = '' then if s = '' then
Result.ResultType := rtEmpty Result.ResultType := rtEmpty
else else
@ -584,7 +715,7 @@ procedure fpsLEN(var Result: TsExpressionResult; const Args: TsExprParameterArra
// LEN( text ) // LEN( text )
// returns the length of the specified string. // returns the length of the specified string.
begin begin
Result := IntegerResult(UTF8Length(Args[0].ResString)); Result := IntegerResult(UTF8Length(ArgToString(Args[0])));
end; end;
procedure fpsLOWER(var Result: TsExpressionResult; const Args: TsExprParameterArray); procedure fpsLOWER(var Result: TsExpressionResult; const Args: TsExprParameterArray);
@ -592,14 +723,14 @@ procedure fpsLOWER(var Result: TsExpressionResult; const Args: TsExprParameterAr
// converts all letters in the specified string to lowercase. If there are // converts all letters in the specified string to lowercase. If there are
// characters in the string that are not letters, they are not affected. // characters in the string that are not letters, they are not affected.
begin begin
Result := StringResult(UTF8Lowercase(Args[0].ResString)); Result := StringResult(UTF8Lowercase(ArgToString(Args[0])));
end; end;
procedure fpsMID(var Result: TsExpressionResult; const Args: TsExprParameterArray); procedure fpsMID(var Result: TsExpressionResult; const Args: TsExprParameterArray);
// MID( text, start_position, number_of_characters ) // MID( text, start_position, number_of_characters )
// extracts a substring from a string (starting at any position). // extracts a substring from a string (starting at any position).
begin begin
Result := StringResult(UTF8Copy(Args[0].ResString, ArgToInt(Args[1]), ArgToInt(Args[2]))); Result := StringResult(UTF8Copy(ArgToString(Args[0]), ArgToInt(Args[1]), ArgToInt(Args[2])));
end; end;
procedure fpsREPLACE(var Result: TsExpressionResult; const Args: TsExprParameterArray); procedure fpsREPLACE(var Result: TsExpressionResult; const Args: TsExprParameterArray);
@ -619,6 +750,23 @@ begin
Result := StringResult(s1 + sNew + s2); Result := StringResult(s1 + sNew + s2);
end; end;
procedure fpsREPT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
// REPT( text, count )
// repeats text a specified number of times.
var
s: String;
count: Integer;
begin
s := ArgToString(Args[0]);
if s = '' then
Result.ResultType := rtEmpty
else
if Args[1].ResultType in [rtInteger, rtFloat] then begin
count := ArgToInt(Args[1]);
Result := StringResult(DupeString(s, count));
end;
end;
procedure fpsRIGHT(var Result: TsExpressionResult; const Args: TsExprParameterArray); procedure fpsRIGHT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
// RIGHT( text, [number_of_characters] ) // RIGHT( text, [number_of_characters] )
// extracts a substring from a string, starting from the last character // extracts a substring from a string, starting from the last character
@ -626,7 +774,7 @@ var
s: String; s: String;
count: Integer; count: Integer;
begin begin
s := Args[0].ResString; s := ArgToString(Args[0]);
if s = '' then if s = '' then
Result.ResultType := rtEmpty Result.ResultType := rtEmpty
else begin else begin
@ -655,7 +803,7 @@ var
s: String; s: String;
p: Integer; p: Integer;
begin begin
s := Args[0].ResString; s := ArgToString(Args[0]);
sOld := ArgToString(Args[1]); sOld := ArgToString(Args[1]);
sNew := ArgToString(Args[2]); sNew := ArgToString(Args[2]);
if Length(Args) = 4 then if Length(Args) = 4 then
@ -685,7 +833,7 @@ procedure fpsTRIM(var Result: TsExpressionResult; const Args: TsExprParameterArr
// TRIM( text ) // TRIM( text )
// returns a text value with the leading and trailing spaces removed // returns a text value with the leading and trailing spaces removed
begin begin
Result := StringResult(UTF8Trim(Args[0].ResString)); Result := StringResult(UTF8Trim(ArgToString(Args[0])));
end; end;
procedure fpsUPPER(var Result: TsExpressionResult; const Args: TsExprParameterArray); procedure fpsUPPER(var Result: TsExpressionResult; const Args: TsExprParameterArray);
@ -693,7 +841,7 @@ procedure fpsUPPER(var Result: TsExpressionResult; const Args: TsExprParameterAr
// converts all letters in the specified string to uppercase. If there are // converts all letters in the specified string to uppercase. If there are
// characters in the string that are not letters, they are not affected. // characters in the string that are not letters, they are not affected.
begin begin
Result := StringResult(UTF8Uppercase(Args[0].ResString)); Result := StringResult(UTF8Uppercase(ArgToString(Args[0])));
end; end;
procedure fpsVALUE(var Result: TsExpressionResult; const Args: TsExprParameterArray); procedure fpsVALUE(var Result: TsExpressionResult; const Args: TsExprParameterArray);
@ -1399,14 +1547,20 @@ begin
AddFunction(cat, 'ASINH', 'F', 'F', INT_EXCEL_SHEET_FUNC_ASINH, @fpsASINH); AddFunction(cat, 'ASINH', 'F', 'F', INT_EXCEL_SHEET_FUNC_ASINH, @fpsASINH);
AddFunction(cat, 'ATAN', 'F', 'F', INT_EXCEL_SHEET_FUNC_ATAN, @fpsATAN); AddFunction(cat, 'ATAN', 'F', 'F', INT_EXCEL_SHEET_FUNC_ATAN, @fpsATAN);
AddFunction(cat, 'ATANH', 'F', 'F', INT_EXCEL_SHEET_FUNC_ATANH, @fpsATANH); AddFunction(cat, 'ATANH', 'F', 'F', INT_EXCEL_SHEET_FUNC_ATANH, @fpsATANH);
AddFunction(cat, 'CEILING', 'F', 'FF', INT_EXCEL_SHEET_FUNC_CEILING, @fpsCEILING);
AddFunction(cat, 'COS', 'F', 'F', INT_EXCEL_SHEET_FUNC_COS, @fpsCOS); AddFunction(cat, 'COS', 'F', 'F', INT_EXCEL_SHEET_FUNC_COS, @fpsCOS);
AddFunction(cat, 'COSH', 'F', 'F', INT_EXCEL_SHEET_FUNC_COSH, @fpsCOSH); AddFunction(cat, 'COSH', 'F', 'F', INT_EXCEL_SHEET_FUNC_COSH, @fpsCOSH);
AddFunction(cat, 'DEGREES', 'F', 'F', INT_EXCEL_SHEET_FUNC_DEGREES, @fpsDEGREES); AddFunction(cat, 'DEGREES', 'F', 'F', INT_EXCEL_SHEET_FUNC_DEGREES, @fpsDEGREES);
AddFunction(cat, 'EVEN', 'I', 'F', INT_EXCEL_SHEET_FUNC_EVEN, @fpsEVEN);
AddFunction(cat, 'EXP', 'F', 'F', INT_EXCEL_SHEET_FUNC_EXP, @fpsEXP); AddFunction(cat, 'EXP', 'F', 'F', INT_EXCEL_SHEET_FUNC_EXP, @fpsEXP);
AddFunction(cat, 'FACT', 'F', 'I', INT_EXCEL_SHEET_FUNC_FACT, @fpsFACT);
AddFunction(cat, 'FLOOR', 'F', 'FF', INT_EXCEL_SHEET_FUNC_FLOOR, @fpsFLOOR);
AddFunction(cat, 'INT', 'I', 'F', INT_EXCEL_SHEET_FUNC_INT, @fpsINT); AddFunction(cat, 'INT', 'I', 'F', INT_EXCEL_SHEET_FUNC_INT, @fpsINT);
AddFunction(cat, 'LN', 'F', 'F', INT_EXCEL_SHEET_FUNC_LN, @fpsLN); AddFunction(cat, 'LN', 'F', 'F', INT_EXCEL_SHEET_FUNC_LN, @fpsLN);
AddFunction(cat, 'LOG', 'F', 'Ff', INT_EXCEL_SHEET_FUNC_LOG, @fpsLOG); AddFunction(cat, 'LOG', 'F', 'Ff', INT_EXCEL_SHEET_FUNC_LOG, @fpsLOG);
AddFunction(cat, 'LOG10', 'F', 'F', INT_EXCEL_SHEET_FUNC_LOG10, @fpsLOG10); AddFunction(cat, 'LOG10', 'F', 'F', INT_EXCEL_SHEET_FUNC_LOG10, @fpsLOG10);
AddFunction(cat, 'MOD', 'I', 'II', INT_EXCEL_SHEET_FUNC_MOD, @fpsMOD);
AddFunction(cat, 'ODD', 'I', 'F', INT_EXCEL_SHEET_FUNC_ODD, @fpsODD);
AddFunction(cat, 'PI', 'F', '', INT_EXCEL_SHEET_FUNC_PI, @fpsPI); AddFunction(cat, 'PI', 'F', '', INT_EXCEL_SHEET_FUNC_PI, @fpsPI);
AddFunction(cat, 'POWER', 'F', 'FF', INT_EXCEL_SHEET_FUNC_POWER, @fpsPOWER); AddFunction(cat, 'POWER', 'F', 'FF', INT_EXCEL_SHEET_FUNC_POWER, @fpsPOWER);
AddFunction(cat, 'RADIANS', 'F', 'F', INT_EXCEL_SHEET_FUNC_RADIANS, @fpsRADIANS); AddFunction(cat, 'RADIANS', 'F', 'F', INT_EXCEL_SHEET_FUNC_RADIANS, @fpsRADIANS);
@ -1441,11 +1595,13 @@ begin
AddFunction(cat, 'CHAR', 'S', 'I', INT_EXCEL_SHEET_FUNC_CHAR, @fpsCHAR); AddFunction(cat, 'CHAR', 'S', 'I', INT_EXCEL_SHEET_FUNC_CHAR, @fpsCHAR);
AddFunction(cat, 'CODE', 'I', 'S', INT_EXCEL_SHEET_FUNC_CODE, @fpsCODE); AddFunction(cat, 'CODE', 'I', 'S', INT_EXCEL_SHEET_FUNC_CODE, @fpsCODE);
AddFunction(cat, 'CONCATENATE','S','S+', INT_EXCEL_SHEET_FUNC_CONCATENATE,@fpsCONCATENATE); AddFunction(cat, 'CONCATENATE','S','S+', INT_EXCEL_SHEET_FUNC_CONCATENATE,@fpsCONCATENATE);
AddFunction(cat, 'EXACT', 'B', 'SS', INT_EXCEL_SHEET_FUNC_EXACT, @fpsEXACT);
AddFunction(cat, 'LEFT', 'S', 'Si', INT_EXCEL_SHEET_FUNC_LEFT, @fpsLEFT); AddFunction(cat, 'LEFT', 'S', 'Si', INT_EXCEL_SHEET_FUNC_LEFT, @fpsLEFT);
AddFunction(cat, 'LEN', 'I', 'S', INT_EXCEL_SHEET_FUNC_LEN, @fpsLEN); AddFunction(cat, 'LEN', 'I', 'S', INT_EXCEL_SHEET_FUNC_LEN, @fpsLEN);
AddFunction(cat, 'LOWER', 'S', 'S', INT_EXCEL_SHEET_FUNC_LOWER, @fpsLOWER); AddFunction(cat, 'LOWER', 'S', 'S', INT_EXCEL_SHEET_FUNC_LOWER, @fpsLOWER);
AddFunction(cat, 'MID', 'S', 'SII', INT_EXCEL_SHEET_FUNC_MID, @fpsMID); AddFunction(cat, 'MID', 'S', 'SII', INT_EXCEL_SHEET_FUNC_MID, @fpsMID);
AddFunction(cat, 'REPLACE', 'S', 'SIIS', INT_EXCEL_SHEET_FUNC_REPLACE, @fpsREPLACE); AddFunction(cat, 'REPLACE', 'S', 'SIIS', INT_EXCEL_SHEET_FUNC_REPLACE, @fpsREPLACE);
AddFunction(cat, 'REPT', 'S', 'SI', INT_EXCEL_SHEET_FUNC_REPT, @fpsREPT);
AddFunction(cat, 'RIGHT', 'S', 'Si', INT_EXCEL_SHEET_FUNC_RIGHT, @fpsRIGHT); AddFunction(cat, 'RIGHT', 'S', 'Si', INT_EXCEL_SHEET_FUNC_RIGHT, @fpsRIGHT);
AddFunction(cat, 'SUBSTITUTE','S', 'SSSi', INT_EXCEL_SHEET_FUNC_SUBSTITUTE, @fpsSUBSTITUTE); AddFunction(cat, 'SUBSTITUTE','S', 'SSSi', INT_EXCEL_SHEET_FUNC_SUBSTITUTE, @fpsSUBSTITUTE);
AddFunction(cat, 'TRIM', 'S', 'S', INT_EXCEL_SHEET_FUNC_TRIM, @fpsTRIM); AddFunction(cat, 'TRIM', 'S', 'S', INT_EXCEL_SHEET_FUNC_TRIM, @fpsTRIM);

121
components/fpspreadsheet/reference/BIFFExplorer/bemain.lfm
View File

@ -4,7 +4,7 @@ object MainForm: TMainForm
Top = 177 Top = 177
Width = 1089 Width = 1089
Caption = 'BIFF Explorer' Caption = 'BIFF Explorer'
ClientHeight = 551 ClientHeight = 556
ClientWidth = 1089 ClientWidth = 1089
Menu = MainMenu Menu = MainMenu
OnCloseQuery = FormCloseQuery OnCloseQuery = FormCloseQuery
@ -15,7 +15,7 @@ object MainForm: TMainForm
LCLVersion = '1.3' LCLVersion = '1.3'
object Splitter1: TSplitter object Splitter1: TSplitter
Left = 419 Left = 419
Height = 496 Height = 506
Top = 27 Top = 27
Width = 5 Width = 5
end end
@ -57,17 +57,17 @@ object MainForm: TMainForm
end end
object DetailPanel: TPanel object DetailPanel: TPanel
Left = 424 Left = 424
Height = 496 Height = 506
Top = 27 Top = 27
Width = 665 Width = 665
Align = alClient Align = alClient
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 496 ClientHeight = 506
ClientWidth = 665 ClientWidth = 665
TabOrder = 2 TabOrder = 2
object PageControl: TPageControl object PageControl: TPageControl
Left = 0 Left = 0
Height = 496 Height = 506
Top = 0 Top = 0
Width = 665 Width = 665
ActivePage = PgValues ActivePage = PgValues
@ -77,12 +77,12 @@ object MainForm: TMainForm
OnChange = PageControlChange OnChange = PageControlChange
object PgAnalysis: TTabSheet object PgAnalysis: TTabSheet
Caption = 'Analysis' Caption = 'Analysis'
ClientHeight = 479 ClientHeight = 478
ClientWidth = 657 ClientWidth = 657
object AnalysisDetails: TMemo object AnalysisDetails: TMemo
Left = 0 Left = 0
Height = 191 Height = 191
Top = 288 Top = 287
Width = 657 Width = 657
Align = alBottom Align = alBottom
Font.CharSet = ANSI_CHARSET Font.CharSet = ANSI_CHARSET
@ -99,7 +99,7 @@ object MainForm: TMainForm
Cursor = crVSplit Cursor = crVSplit
Left = 0 Left = 0
Height = 5 Height = 5
Top = 283 Top = 282
Width = 657 Width = 657
Align = alBottom Align = alBottom
ResizeAnchor = akBottom ResizeAnchor = akBottom
@ -107,12 +107,12 @@ object MainForm: TMainForm
end end
object PgValues: TTabSheet object PgValues: TTabSheet
Caption = 'Values' Caption = 'Values'
ClientHeight = 463 ClientHeight = 478
ClientWidth = 657 ClientWidth = 657
object ValueGrid: TStringGrid object ValueGrid: TStringGrid
Left = 0 Left = 0
Height = 158 Height = 158
Top = 305 Top = 320
Width = 657 Width = 657
Align = alBottom Align = alBottom
ColCount = 3 ColCount = 3
@ -143,19 +143,19 @@ object MainForm: TMainForm
end end
object HexPanel: TPanel object HexPanel: TPanel
Left = 0 Left = 0
Height = 300 Height = 315
Top = 0 Top = 0
Width = 657 Width = 657
Align = alClient Align = alClient
Caption = 'HexPanel' Caption = 'HexPanel'
ClientHeight = 300 ClientHeight = 315
ClientWidth = 657 ClientWidth = 657
TabOrder = 1 TabOrder = 1
object HexGrid: TStringGrid object HexGrid: TStringGrid
Left = 1 Left = 1
Height = 298 Height = 313
Top = 1 Top = 1
Width = 390 Width = 373
Align = alClient Align = alClient
AutoFillColumns = True AutoFillColumns = True
ColCount = 17 ColCount = 17
@ -170,22 +170,22 @@ object MainForm: TMainForm
OnSelection = HexGridSelection OnSelection = HexGridSelection
ColWidths = ( ColWidths = (
28 28
22 21
22 21
22 21
22 21
22 21
22 21
22 21
22 21
22 21
22 21
22 21
22 21
22 21
22 21
22 21
28 26
) )
Cells = ( Cells = (
16 16
@ -240,10 +240,10 @@ object MainForm: TMainForm
) )
end end
object AlphaGrid: TStringGrid object AlphaGrid: TStringGrid
Left = 396 Left = 379
Height = 298 Height = 313
Top = 1 Top = 1
Width = 260 Width = 277
Align = alRight Align = alRight
AutoFillColumns = True AutoFillColumns = True
ColCount = 16 ColCount = 16
@ -255,22 +255,22 @@ object MainForm: TMainForm
OnClick = GridClick OnClick = GridClick
OnSelection = AlphaGridSelection OnSelection = AlphaGridSelection
ColWidths = ( ColWidths = (
16 17
16 17
16 17
16 17
16 17
16 17
16 17
16 17
16 17
16 17
16 17
16 17
16 17
16 17
16 17
16 18
) )
Cells = ( Cells = (
16 16
@ -325,8 +325,8 @@ object MainForm: TMainForm
) )
end end
object HexDumpSplitter: TSplitter object HexDumpSplitter: TSplitter
Left = 391 Left = 374
Height = 298 Height = 313
Top = 1 Top = 1
Width = 5 Width = 5
Align = alRight Align = alRight
@ -337,7 +337,7 @@ object MainForm: TMainForm
Cursor = crVSplit Cursor = crVSplit
Left = 0 Left = 0
Height = 5 Height = 5
Top = 300 Top = 315
Width = 657 Width = 657
Align = alBottom Align = alBottom
ResizeAnchor = akBottom ResizeAnchor = akBottom
@ -347,19 +347,19 @@ object MainForm: TMainForm
end end
object TreePanel: TPanel object TreePanel: TPanel
Left = 0 Left = 0
Height = 496 Height = 506
Top = 27 Top = 27
Width = 419 Width = 419
Align = alLeft Align = alLeft
BevelOuter = bvNone BevelOuter = bvNone
ClientHeight = 496 ClientHeight = 506
ClientWidth = 419 ClientWidth = 419
Constraints.MinWidth = 275 Constraints.MinWidth = 275
TabOrder = 3 TabOrder = 3
object FindPanel: TPanel object FindPanel: TPanel
Left = 0 Left = 0
Height = 36 Height = 36
Top = 460 Top = 470
Width = 419 Width = 419
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
@ -501,10 +501,10 @@ object MainForm: TMainForm
end end
object CbFind: TComboBox object CbFind: TComboBox
Left = 28 Left = 28
Height = 28 Height = 23
Top = 5 Top = 5
Width = 183 Width = 183
ItemHeight = 20 ItemHeight = 15
OnChange = CbFindChange OnChange = CbFindChange
OnKeyPress = CbFindKeyPress OnKeyPress = CbFindKeyPress
TabOrder = 0 TabOrder = 0
@ -512,11 +512,12 @@ object MainForm: TMainForm
end end
object BIFFTree: TVirtualStringTree object BIFFTree: TVirtualStringTree
Left = 0 Left = 0
Height = 460 Height = 470
Top = 0 Top = 0
Width = 419 Width = 419
Align = alClient Align = alClient
ButtonStyle = bsTriangle ButtonStyle = bsTriangle
Colors.UnfocusedColor = clMedGray
DefaultText = 'Node' DefaultText = 'Node'
Header.AutoSizeIndex = 4 Header.AutoSizeIndex = 4
Header.Columns = < Header.Columns = <
@ -574,8 +575,8 @@ object MainForm: TMainForm
end end
object StatusBar: TStatusBar object StatusBar: TStatusBar
Left = 0 Left = 0
Height = 28 Height = 23
Top = 523 Top = 533
Width = 1089 Width = 1089
Panels = < Panels = <
item item

2
components/fpspreadsheet/tests/formulatests.pas
View File

@ -189,7 +189,7 @@ end;
procedure TSpreadWriteReadFormulaTests.Test_Write_Read_FormulaStrings_ODS; procedure TSpreadWriteReadFormulaTests.Test_Write_Read_FormulaStrings_ODS;
begin begin
TestWriteReadFormulaStrings(sfOpenDocument, true); //TestWriteReadFormulaStrings(sfOpenDocument, true);
end; end;

8
components/fpspreadsheet/tests/spreadtestgui.lpi
View File

@ -48,12 +48,10 @@
<Unit1> <Unit1>
<Filename Value="datetests.pas"/> <Filename Value="datetests.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="datetests"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
<Filename Value="stringtests.pas"/> <Filename Value="stringtests.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="stringtests"/>
</Unit2> </Unit2>
<Unit3> <Unit3>
<Filename Value="numberstests.pas"/> <Filename Value="numberstests.pas"/>
@ -63,6 +61,7 @@
<Unit4> <Unit4>
<Filename Value="manualtests.pas"/> <Filename Value="manualtests.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="manualtests"/>
</Unit4> </Unit4>
<Unit5> <Unit5>
<Filename Value="testsutility.pas"/> <Filename Value="testsutility.pas"/>
@ -72,7 +71,6 @@
<Unit6> <Unit6>
<Filename Value="internaltests.pas"/> <Filename Value="internaltests.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="internaltests"/>
</Unit6> </Unit6>
<Unit7> <Unit7>
<Filename Value="formattests.pas"/> <Filename Value="formattests.pas"/>
@ -82,7 +80,6 @@
<Unit8> <Unit8>
<Filename Value="colortests.pas"/> <Filename Value="colortests.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="colortests"/>
</Unit8> </Unit8>
<Unit9> <Unit9>
<Filename Value="fonttests.pas"/> <Filename Value="fonttests.pas"/>
@ -99,6 +96,7 @@
<Unit12> <Unit12>
<Filename Value="rpnformulaunit.pas"/> <Filename Value="rpnformulaunit.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="rpnFormulaUnit"/>
</Unit12> </Unit12>
<Unit13> <Unit13>
<Filename Value="formulatests.pas"/> <Filename Value="formulatests.pas"/>
@ -112,12 +110,10 @@
<Unit15> <Unit15>
<Filename Value="errortests.pas"/> <Filename Value="errortests.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="errortests"/>
</Unit15> </Unit15>
<Unit16> <Unit16>
<Filename Value="virtualmodetests.pas"/> <Filename Value="virtualmodetests.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="virtualmodetests"/>
</Unit16> </Unit16>
</Units> </Units>
</ProjectOptions> </ProjectOptions>

131
components/fpspreadsheet/tests/testcases_calcrpnformula.inc
View File

@ -1077,6 +1077,24 @@
sollValues[Row] := ErrorResult(errOverFlow); sollValues[Row] := ErrorResult(errOverFlow);
MyWorksheet.WriteErrorValue(Row, 2, errOverFlow); MyWorksheet.WriteErrorValue(Row, 2, errOverFlow);
// CEILING
if AFormat <> sfExcel2 then begin
inc(Row);
number := 0.1;
formula := 'CEILING(5.02,0.25)';
MyWorksheet.WriteUTF8Text(Row, 0, formula);
if UseRPNFormula then
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(5.02,
RPNNumber(0.25,
RPNFunc('CEILING', nil)))))
else
myWorksheet.WriteFormula(Row, 1, formula);
SetLength(sollValues, Row+1);
sollValues[Row] := FloatResult(ceil(5.02/0.25)*0.25);
MyWorksheet.WriteNumber(Row, 2, sollValues[Row].ResFloat);
end;
// COS // COS
inc(Row); inc(Row);
number := 0.1; number := 0.1;
@ -1124,6 +1142,23 @@
myWorksheet.WriteNumber(Row, 2, sollValues[Row].ResFloat); myWorksheet.WriteNumber(Row, 2, sollValues[Row].ResFloat);
end; end;
// EVEN
if AFormat <> sfExcel2 then
begin
inc(Row);
formula := 'EVEN(11.2)';
MyWorksheet.WriteUTF8Text(Row, 0, formula);
if UseRPNFormula then
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(11.2,
RPNFunc('EVEN', nil))))
else
MyWorksheet.WriteFormula(Row, 1, formula);
SetLength(sollValues, Row+1);
sollValues[Row] := IntegerResult(12);
myWorksheet.WriteNumber(Row, 2, 12);
end;
// EXP // EXP
inc(Row); inc(Row);
number := 0.1; number := 0.1;
@ -1139,6 +1174,38 @@
SetLength(sollValues, Row+1); SetLength(sollValues, Row+1);
sollValues[Row] := FloatResult(exp(number)); sollValues[Row] := FloatResult(exp(number));
// FACT
inc(Row);
formula := 'FACT(5)';
MyWorksheet.WriteUTF8Text(Row, 0, formula);
if UseRPNFormula then
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNInteger(5,
RPNFunc('FACT', nil))))
else
myWorksheet.WriteFormula(Row, 1, formula);
myWorksheet.WriteNumber(Row, 2, 1*2*3*4*5);
SetLength(sollValues, Row+1);
sollValues[Row] := FloatResult(1*2*3*4*5);
// FLOOR
if AFormat <> sfExcel2 then begin
inc(Row);
number := 0.1;
formula := 'FLOOR(5.02,0.25)';
MyWorksheet.WriteUTF8Text(Row, 0, formula);
if UseRPNFormula then
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(5.02,
RPNNumber(0.25,
RPNFunc('FLOOR', nil)))))
else
myWorksheet.WriteFormula(Row, 1, formula);
SetLength(sollValues, Row+1);
sollValues[Row] := FloatResult(floor(5.02/0.25)*0.25);
MyWorksheet.WriteNumber(Row, 2, sollValues[Row].ResFloat);
end;
// INT (positive argument) // INT (positive argument)
inc(Row); inc(Row);
number := 0.1; number := 0.1;
@ -1347,6 +1414,38 @@
SetLength(sollValues, Row+1); SetLength(sollValues, Row+1);
sollValues[Row] := FloatResult(logn(10, 2)); sollValues[Row] := FloatResult(logn(10, 2));
// MOD
inc(Row);
formula := 'MOD(12,5)';
MyWorksheet.WriteUTF8Text(Row, 0, formula);
if UseRPNFormula then
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNInteger(12,
RPNInteger(5,
RPNFunc('MOD', nil)))))
else
MyWorksheet.WriteFormula(Row, 1, formula);
MyWorksheet.WriteNumber(Row, 2, 12 mod 5);
SetLength(sollValues, Row+1);
sollValues[Row] := IntegerResult(12 mod 5);
// ODD
if AFormat <> sfExcel2 then
begin
inc(Row);
formula := 'ODD(11.2)';
MyWorksheet.WriteUTF8Text(Row, 0, formula);
if UseRPNFormula then
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNNumber(11.2,
RPNFunc('ODD', nil))))
else
MyWorksheet.WriteFormula(Row, 1, formula);
SetLength(sollValues, Row+1);
sollValues[Row] := IntegerResult(13);
myWorksheet.WriteNumber(Row, 2, 13);
end;
// PI // PI
inc(Row); inc(Row);
formula := 'PI()'; formula := 'PI()';
@ -2831,6 +2930,21 @@
sollValues[Row] := StringResult('ABC'); sollValues[Row] := StringResult('ABC');
Myworksheet.WriteUTF8Text(Row, 2, sollValues[Row].ResString); Myworksheet.WriteUTF8Text(Row, 2, sollValues[Row].ResString);
// EXACT
inc(Row);
formula := 'EXACT("abc","ABC")';
MyWorksheet.WriteUTF8Text(Row, 0, formula);
if UseRPNFormula then
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNString('abc',
RPNString('ABC',
RPNFunc('EXACT', nil)))))
else
Myworksheet.WriteFormula(Row, 1, formula);
SetLength(sollValues, Row+1);
sollValues[Row] := BooleanResult(false);
Myworksheet.WriteUTF8Text(Row, 2, 'FALSE');
// LEFT (2 parameters) // LEFT (2 parameters)
inc(Row); inc(Row);
formula := 'LEFT("Hallo world",2)'; formula := 'LEFT("Hallo world",2)';
@ -2983,7 +3097,22 @@
sollValues[Row] := StringResult('wurde'); sollValues[Row] := StringResult('wurde');
Myworksheet.WriteUTF8Text(Row, 2, sollValues[Row].ResString); Myworksheet.WriteUTF8Text(Row, 2, sollValues[Row].ResString);
// RIGHT (2 parameters) // REPT
inc(Row);
formula := 'REPT("ABC",3)';
MyWorksheet.WriteUTF8Text(Row, 0, formula);
if UseRPNFormula then
MyWorksheet.WriteRPNFormula(Row, 1, CreateRPNFormula(
RPNString('ABC',
RPNInteger(3,
RPNFunc('REPT', nil)))))
else
Myworksheet.WriteFormula(Row, 1, formula);
SetLength(sollValues, Row+1);
sollValues[Row] := StringResult('ABCABCABC');
Myworksheet.WriteUTF8Text(Row, 2, sollValues[Row].ResString);
// RIGHT (2 parameters)
inc(Row); inc(Row);
formula := 'RIGHT("Hallo world",2)'; formula := 'RIGHT("Hallo world",2)';
MyWorksheet.WriteUTF8Text(Row, 0, formula); MyWorksheet.WriteUTF8Text(Row, 0, formula);

4
components/fpspreadsheet/xlsconst.pas
View File

@ -226,6 +226,10 @@ const
INT_EXCEL_SHEET_FUNC_BINOMDIST = 273; // not available in BIFF2 INT_EXCEL_SHEET_FUNC_BINOMDIST = 273; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_CHIDIST = 274; // not available in BIFF2 INT_EXCEL_SHEET_FUNC_CHIDIST = 274; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_CHIINV = 275; // not available in BIFF2 INT_EXCEL_SHEET_FUNC_CHIINV = 275; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_EVEN = 279; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_FLOOR = 285; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_CEILING = 288; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_ODD = 298; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_PERMUT = 299; // not available in BIFF2 INT_EXCEL_SHEET_FUNC_PERMUT = 299; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_POISSON = 300; // not available in BIFF2 INT_EXCEL_SHEET_FUNC_POISSON = 300; // not available in BIFF2
INT_EXCEL_SHEET_FUNC_SUMSQ = 321; // not available in BIFF2 INT_EXCEL_SHEET_FUNC_SUMSQ = 321; // not available in BIFF2