diff --git a/components/fpspreadsheet/examples/other/test_formula_func.lpi b/components/fpspreadsheet/examples/other/test_formula_func.lpi
new file mode 100644
index 000000000..fc36ab53f
--- /dev/null
+++ b/components/fpspreadsheet/examples/other/test_formula_func.lpi
@@ -0,0 +1,103 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/fpspreadsheet/examples/other/test_formula_func.lps b/components/fpspreadsheet/examples/other/test_formula_func.lps
new file mode 100644
index 000000000..0ec4f0d76
--- /dev/null
+++ b/components/fpspreadsheet/examples/other/test_formula_func.lps
@@ -0,0 +1,169 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/components/fpspreadsheet/examples/other/test_formula_func.pas b/components/fpspreadsheet/examples/other/test_formula_func.pas
new file mode 100644
index 000000000..357973240
--- /dev/null
+++ b/components/fpspreadsheet/examples/other/test_formula_func.pas
@@ -0,0 +1,126 @@
+{ This demo show how a user-provided function can be used for calculation of
+ rpn formulas that are built-in to fpspreadsheet, but don't have an own
+ calculation procedure. }
+
+program test_formula_func;
+
+{$mode objfpc}{$H+}
+
+uses
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
+ cthreads,
+ {$ENDIF}{$ENDIF}
+ Classes, laz_fpspreadsheet
+ { you can add units after this },
+ math, fpspreadsheet, fpsfunc;
+
+const
+ paymentAtEnd = 0;
+ paymentAtBegin = 1;
+
+{ Calculates the future value of an investment based on an interest rate and
+ a constant payment schedule:
+ - "interest_rate" is the interest rate for the investment (as decimal, not percent)
+ - "number_periods" is the number of payment periods, i.e. number of payments
+ for the annuity.
+ - "payment" is the amount of the payment made each period
+ - "PV" is the present value of the payments.
+ - "payment_type" indicates when the payments are due (see paymentAtXXX constants)
+ see: http://en.wikipedia.org/wiki/Future_value
+}
+function FV(interest_rate, number_periods, payment, pv: Double;
+ payment_type: integer): Double;
+var
+ q: Double;
+begin
+ q := 1.0 + interest_rate;
+
+ Result := pv * power(q, number_periods) +
+ (power(q, number_periods) - 1) / (q - 1) * payment;
+
+ if payment_type = paymentAtBegin then
+ Result := Result * q;
+end;
+
+function fpsFV(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
+var
+ arg_interestRate, arg_numberPayments, arg_Payment, arg_PV, arg_paymentType: TsArgument;
+begin
+ // Pop the argument off the stack.
+ // Note: they come off in the reverse order they were pushed!
+ arg_paymentType := Args.Pop;
+ arg_PV := Args.Pop;
+ arg_Payment := Args.Pop;
+ arg_numberPayments := Args.Pop;
+ arg_interestRate := Args.Pop;
+
+ // Call our FV function with the NumberValues of the arguments.
+ Result := CreateNumber(FV(
+ arg_interestRate.NumberValue,
+ arg_numberPayments.NumberValue,
+ arg_Payment.NumberValue,
+ arg_PV.NumberValue,
+ round(arg_paymentType.NumberValue)
+ ));
+end;
+
+const
+ INTEREST_RATE = 0.03;
+ NUMBER_PAYMENTS = 10;
+ PAYMENT = 1000;
+ PRESENT_VALUE = 10000;
+ PAYMENT_WHEN = paymentAtEnd;
+
+var
+ workbook: TsWorkbook;
+ worksheet: TsWorksheet;
+
+begin
+ RegisterFormulaFunc(fekFV, @fpsFV);
+
+ workbook := TsWorkbook.Create;
+ try
+ worksheet := workbook.AddWorksheet('Financial');
+ worksheet.Options := worksheet.Options + [soCalcBeforeSaving];
+ worksheet.WriteColWidth(0, 20);
+
+ worksheet.WriteUTF8Text(0, 0, 'Interest rate');
+ worksheet.WriteNumber(0, 1, INTEREST_RATE, nfPercentage, 1);
+
+ worksheet.WriteUTF8Text(1, 0, 'Number of payments');
+ worksheet.WriteNumber(1, 1, NUMBER_PAYMENTS);
+
+ worksheet.WriteUTF8Text(2, 0, 'Payment');
+ worksheet.WriteCurrency(2, 1, PAYMENT, nfCurrency, 2, '$');
+
+ worksheet.WriteUTF8Text(3, 0, 'Present value');
+ worksheet.WriteCurrency(3, 1, PRESENT_VALUE, nfCurrency, 2, '$');
+
+ worksheet.WriteUTF8Text(4, 0, 'Payment at end');
+ worksheet.WriteBoolValue(4, 1, PAYMENT_WHEN = paymentAtEnd);
+
+ worksheet.WriteUTF8Text(6, 0, 'Future value');
+ worksheet.WriteFontStyle(6, 0, [fssBold]);
+ worksheet.WriteUTF8Text(7, 0, 'Our calculation');
+ worksheet.WriteCurrency(7, 1,
+ FV(INTEREST_RATE, NUMBER_PAYMENTS, PAYMENT, PRESENT_VALUE, PAYMENT_WHEN),
+ nfCurrency, 2, '$'
+ );
+
+ worksheet.WriteUTF8Text(8, 0, 'Excel''s calculation');
+ worksheet.WriteNumberFormat(8, 1, nfCurrency, 2, '$');
+ worksheet.WriteRPNFormula(8, 1, CreateRPNFormula(
+ RPNNumber(INTEREST_RATE,
+ RPNNumber(NUMBER_PAYMENTS,
+ RPNNumber(-PAYMENT,
+ RPNNumber(-PRESENT_VALUE,
+ RPNNumber(PAYMENT_WHEN,
+ RPNFunc(fekFV, 5,
+ nil))))))));
+
+ workbook.WriteToFile('test_fv.xls', sfExcel8, true);
+ finally
+ workbook.Free;
+ end;
+end.
+
diff --git a/components/fpspreadsheet/fpsfunc.pas b/components/fpspreadsheet/fpsfunc.pas
index 7219c5e54..7661d9c99 100644
--- a/components/fpspreadsheet/fpsfunc.pas
+++ b/components/fpspreadsheet/fpsfunc.pas
@@ -145,6 +145,7 @@ function fpsISNUMBER (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsISTEXT (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
function fpsVALUE (Args: TsArgumentStack; NumArgs: Integer): TsArgument;
+
implementation
uses
diff --git a/components/fpspreadsheet/fpspreadsheet.pas b/components/fpspreadsheet/fpspreadsheet.pas
index 3ab0ef7c6..ee60abf4c 100755
--- a/components/fpspreadsheet/fpspreadsheet.pas
+++ b/components/fpspreadsheet/fpspreadsheet.pas
@@ -589,6 +589,12 @@ type
const AFormatString: String = ''); overload;
procedure WriteNumberFormat(ACell: PCell; ANumberFormat: TsNumberFormat;
const AFormatString: String = ''); overload;
+ procedure WriteNumberFormat(ARow, ACol: Cardinal; ANumberFormat: TsNumberFormat;
+ ADecimals: Integer; ACurrencySymbol: String = ''; APosCurrFormat: Integer = -1;
+ ANegCurrFormat: Integer = -1); overload;
+ procedure WriteNumberFormat(ACell: PCell; ANumberFormat: TsNumberFormat;
+ ADecimals: Integer; ACurrencySymbol: String = '';
+ APosCurrFormat: Integer = -1; ANegCurrFormat: Integer = -1); overload;
procedure WriteTextRotation(ARow, ACol: Cardinal; ARotation: TsTextRotation);
@@ -983,10 +989,10 @@ type
var
GsSpreadFormats: array of TsSpreadFormatData;
-procedure RegisterSpreadFormat(
- AReaderClass: TsSpreadReaderClass;
- AWriterClass: TsSpreadWriterClass;
- AFormat: TsSpreadsheetFormat);
+procedure RegisterFormulaFunc(AFormulaKind: TFEKind; AFunc: pointer);
+
+procedure RegisterSpreadFormat( AReaderClass: TsSpreadReaderClass;
+ AWriterClass: TsSpreadWriterClass; AFormat: TsSpreadsheetFormat);
procedure CopyCellFormat(AFromCell, AToCell: PCell);
function GetFileFormatName(AFormat: TsSpreadsheetFormat): String;
@@ -1096,7 +1102,7 @@ type
Func: TsFormulaFunc;
end;
-const
+var
FEProps: array[TFEKind] of TFEProp = ( // functions marked by (*)
{ Operands } // are only partially supported
(Symbol:''; MinParams:Byte(-1); MaxParams:Byte(-1); Func:nil), // fekCell
@@ -1238,6 +1244,22 @@ const
(Symbol:'SUM'; MinParams:1; MaxParams:1; Func:nil) // fekOpSUM (Unary sum operation). Note: CANNOT be used for summing sell contents; use fekSUM}
);
+{@@
+ Registers a function used when calculating a formula.
+ This feature allows to extend the built-in functions directly available in
+ fpspreadsheet.
+
+ @param AFormulaKind Identifier of the formula element
+ @param AFunc Function to be executed when the identifier is met
+ in an rpn formula. The function declaration MUST
+ follow the structure given by TsFormulaFunc.
+}
+procedure RegisterFormulaFunc(AFormulaKind: TFEKind; AFunc: Pointer);
+begin
+ FEProps[AFormulaKind].Func := TsFormulaFunc(AFunc);
+end;
+
+
{@@
Registers a new reader/writer pair for a given spreadsheet file format
}
@@ -2914,6 +2936,67 @@ begin
ChangedCell(ARow, ACol);
end;
+{@@
+ Adds a number format to the formatting of a cell
+
+ @param ARow The row of the cell
+ @param ACol The column of the cell
+ @param ANumberFormat Identifier of the format to be applied
+ @param ADecimals Number of decimal places
+ @param ACurrencySymbol optional currency symbol in case of nfCurrency
+ @param APosCurrFormat optional identifier for positive currencies
+ @param ANegCurrFormat optional identifier for negative currencies
+
+ @see TsNumberFormat
+}
+procedure TsWorksheet.WriteNumberFormat(ARow, ACol: Cardinal;
+ ANumberFormat: TsNumberFormat; ADecimals: Integer; ACurrencySymbol: String = '';
+ APosCurrFormat: Integer = -1; ANegCurrFormat: Integer = -1);
+var
+ ACell: PCell;
+begin
+ ACell := GetCell(ARow, ACol);
+ WriteNumberFormat(ACell, ANumberFormat, ADecimals, ACurrencySymbol,
+ APosCurrFormat, ANegCurrFormat);
+end;
+
+{@@
+ Adds a number format to the formatting of a cell
+
+ @param ARow The row of the cell
+ @param ACol The column of the cell
+ @param ANumberFormat Identifier of the format to be applied
+ @param ADecimals Number of decimal places
+ @param ACurrencySymbol optional currency symbol in case of nfCurrency
+ @param APosCurrFormat optional identifier for positive currencies
+ @param ANegCurrFormat optional identifier for negative currencies
+
+ @see TsNumberFormat
+}
+procedure TsWorksheet.WriteNumberFormat(ACell: PCell;
+ ANumberFormat: TsNumberFormat; ADecimals: Integer; ACurrencySymbol: String = '';
+ APosCurrFormat: Integer = -1; ANegCurrFormat: Integer = -1);
+begin
+ if ACell = nil then
+ exit;
+
+ ACell^.NumberFormat := ANumberFormat;
+ if ANumberFormat <> nfGeneral then begin
+ Include(ACell^.UsedFormattingFields, uffNumberFormat);
+ if ANumberFormat in [nfCurrency, nfCurrencyRed] then
+ ACell^.NumberFormatStr := BuildCurrencyFormatString(nfdDefault, ANumberFormat,
+ Workbook.FormatSettings, ADecimals,
+ APosCurrFormat, ANegCurrFormat, ACurrencySymbol)
+ else
+ ACell^.NumberFormatStr := BuildNumberFormatString(ANumberFormat,
+ Workbook.FormatSettings, ADecimals);
+ end else begin
+ Exclude(ACell^.UsedFormattingFields, uffNumberFormat);
+ ACell^.NumberFormatStr := '';
+ end;
+ ChangedCell(ACell^.Row, ACell^.Col);
+end;
+
{@@
Adds number format to the formatting of a cell