diff --git a/components/fpspreadsheet/examples/other/test_formula_func.lpi b/components/fpspreadsheet/examples/other/test_formula_func.lpi
index fc36ab53f..7fe05078f 100644
--- a/components/fpspreadsheet/examples/other/test_formula_func.lpi
+++ b/components/fpspreadsheet/examples/other/test_formula_func.lpi
@@ -52,6 +52,7 @@
+
@@ -80,11 +81,6 @@
-
-
-
-
-
diff --git a/components/fpspreadsheet/examples/other/test_formula_func.lps b/components/fpspreadsheet/examples/other/test_formula_func.lps
index 39210b4a6..c59622bcc 100644
--- a/components/fpspreadsheet/examples/other/test_formula_func.lps
+++ b/components/fpspreadsheet/examples/other/test_formula_func.lps
@@ -4,165 +4,194 @@
-
+
-
-
-
+
+
+
+
+
+
-
-
-
-
+
+
+
+
-
-
-
-
+
+
+
+
-
+
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
+
-
-
+
-
-
+
+
-
-
+
+
-
+
diff --git a/components/fpspreadsheet/examples/other/test_formula_func.pas b/components/fpspreadsheet/examples/other/test_formula_func.pas
index 984ffd1fa..5995860c8 100644
--- a/components/fpspreadsheet/examples/other/test_formula_func.pas
+++ b/components/fpspreadsheet/examples/other/test_formula_func.pas
@@ -1,18 +1,34 @@
-{ This demo show how a user-provided function can be used for calculation of
+{ This demo show how user-provided functions can be used for calculation of
rpn formulas that are built-in to fpspreadsheet, but don't have an own
- calculation procedure. }
+ calculation procedure.
+
+ The example will show implementation of the some financial formulas:
+ - FV(...) (future value)
+ - PV(...) (present value)
+ - PMT(...) (payment)
+
+ The demo writes an xls file which uses these formulas and then displays
+ the result in a console window. (Open the generated file in Excel or
+ Open/LibreOffice and compare).
+}
program test_formula_func;
-{$mode objfpc}{$H+}
+//{$mode objfpc}{$H+}
+{$mode delphi}{$H+}
uses
- {$IFDEF UNIX}{$IFDEF UseCThreads}
+ {$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
- Classes, laz_fpspreadsheet
+ Classes, SysUtils, laz_fpspreadsheet
{ you can add units after this },
- math, fpspreadsheet, fpsfunc;
+ math, fpspreadsheet, xlsbiff8, fpsfunc;
+
+
+{------------------------------------------------------------------------------}
+{ Basic implmentation of the three financial funtions }
+{------------------------------------------------------------------------------}
const
paymentAtEnd = 0;
@@ -24,24 +40,72 @@ const
- "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.
+ - "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
+ see: http://en.wikipedia.org/wiki/Time_value_of_money
+
+ In Excel's implementation the payments and the FV add up to 0:
+ FV + PV q^n + PMT (q^n - 1) / (q - 1) = 0
}
-function FV(interest_rate, number_periods, payment, pv: Double;
+function FV(interest_rate: Double; number_periods: Integer; payment, pv: Double;
payment_type: integer): Double;
var
- q: Double;
+ q, qn, factor: Double;
begin
q := 1.0 + interest_rate;
-
- Result := pv * power(q, number_periods) +
- (power(q, number_periods) - 1) / (q - 1) * payment;
-
+ qn := power(q, number_periods);
+ factor := (qn - 1) / (q - 1);
if payment_type = paymentAtBegin then
- Result := Result * q;
+ factor := factor * q;
+
+ Result := -(pv * qn + payment*factor);
end;
+{ Calculates the regular payments for a loan based on an interest rate and a
+ constant payment schedule
+ Arguments as shown for FV(), in addition:
+ - "fv" is the future value of the payments.
+ see: http://en.wikipedia.org/wiki/Time_value_of_money
+ }
+function PMT(interest_rate: Double; number_periods: Integer; pv, fv: Double;
+ payment_type: Integer): Double;
+var
+ q, qn, factor: Double;
+begin
+ q := 1.0 + interest_rate;
+ qn := power(q, number_periods);
+ factor := (qn - 1) / (q - 1);
+ if payment_type = paymentAtBegin then
+ factor := factor * q;
+
+ Result := -(fv + pv * qn) / factor;
+end;
+
+{ Calculates the present value of an investment based on an interest rate and
+ a constant payment schedule.
+ Arguments as shown for FV(), in addition:
+ - "fv" is the future value of the payments.
+ see: http://en.wikipedia.org/wiki/Time_value_of_money
+}
+function PV(interest_rate: Double; number_periods: Integer; payment, fv: Double;
+ payment_type: Integer): Double;
+var
+ q, qn, factor: Double;
+begin
+ q := 1.0 + interest_rate;
+ qn := power(q, number_periods);
+ factor := (qn - 1) / (q - 1);
+ if payment_type = paymentAtBegin then
+ factor := factor * q;
+
+ Result := -(fv + payment*factor) / qn;
+end;
+
+
+{------------------------------------------------------------------------------}
+{ Adaption for usage by fpspreadsheet }
+{------------------------------------------------------------------------------}
+
function fpsFV(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
var
data: TsArgNumberArray;
@@ -52,14 +116,47 @@ begin
if Args.PopNumberValues(NumArgs, false, data, Result) then
// Call our FV function with the NumberValues of the arguments.
Result := CreateNumberArg(FV(
- data[0], // interest rate
- data[1], // number of payments
- data[2], // payment
- data[3], // present value
- round(data[4]) // payment type
+ data[0], // interest rate
+ round(data[1]), // number of payments
+ data[2], // payment
+ data[3], // present value
+ round(data[4]) // payment type
));
end;
+function fpsPMT(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
+var
+ data: TsArgNumberArray;
+begin
+ if Args.PopNumberValues(NumArgs, false, data, Result) then
+ Result := CreateNumberArg(PMT(
+ data[0], // interest rate
+ round(data[1]), // number of payments
+ data[2], // present value
+ data[3], // future value
+ round(data[4]) // payment type
+ ));
+end;
+
+function fpsPV(Args: TsArgumentStack; NumArgs: Integer): TsArgument;
+var
+ data: TsArgNumberArray;
+begin
+ if Args.PopNumberValues(NumArgs, false, data, Result) then
+ Result := CreateNumberArg(PV(
+ data[0], // interest rate
+ round(data[1]), // number of payments
+ data[2], // payment
+ data[3], // future value
+ round(data[4]) // payment type
+ ));
+end;
+
+
+{------------------------------------------------------------------------------}
+{ Write xls file comparing our own calculations with Excel result }
+{------------------------------------------------------------------------------}
+procedure WriteFile(AFileName: String);
const
INTEREST_RATE = 0.03;
NUMBER_PAYMENTS = 10;
@@ -70,54 +167,171 @@ const
var
workbook: TsWorkbook;
worksheet: TsWorksheet;
+ fval, pval, pmtval: Double;
begin
+ { We have to register our financial function in fpspreadsheet. Otherwise an
+ error code would be displayed in the reading part of this demo in these
+ formula cells. }
RegisterFormulaFunc(fekFV, @fpsFV);
+ RegisterFormulaFunc(fekPMT, @fpsPMT);
+ RegisterFormulaFunc(fekPV, @fpsPV);
workbook := TsWorkbook.Create;
try
worksheet := workbook.AddWorksheet('Financial');
worksheet.Options := worksheet.Options + [soCalcBeforeSaving];
- worksheet.WriteColWidth(0, 20);
+ worksheet.WriteColWidth(0, 40);
worksheet.WriteUTF8Text(0, 0, 'Interest rate');
- worksheet.WriteNumber(0, 1, INTEREST_RATE, nfPercentage, 1);
+ worksheet.WriteNumber(0, 1, INTEREST_RATE, nfPercentage, 1); // B1
worksheet.WriteUTF8Text(1, 0, 'Number of payments');
- worksheet.WriteNumber(1, 1, NUMBER_PAYMENTS);
+ worksheet.WriteNumber(1, 1, NUMBER_PAYMENTS); // B2
worksheet.WriteUTF8Text(2, 0, 'Payment');
- worksheet.WriteCurrency(2, 1, PAYMENT, nfCurrency, 2, '$');
+ worksheet.WriteCurrency(2, 1, PAYMENT, nfCurrency, 2, '$'); // B3
worksheet.WriteUTF8Text(3, 0, 'Present value');
- worksheet.WriteCurrency(3, 1, PRESENT_VALUE, nfCurrency, 2, '$');
+ worksheet.WriteCurrency(3, 1, PRESENT_VALUE, nfCurrency, 2, '$'); // B4
- worksheet.WriteUTF8Text(4, 0, 'Payment at end');
- worksheet.WriteBoolValue(4, 1, PAYMENT_WHEN = paymentAtEnd);
+ worksheet.WriteUTF8Text(4, 0, 'Payment at end (0) or at begin (1)');
+ worksheet.WriteNumber(4, 1, PAYMENT_WHEN); // B5
+ // future value calculation
+ fval := FV(INTEREST_RATE, NUMBER_PAYMENTS, PAYMENT, PRESENT_VALUE, PAYMENT_WHEN);
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.WriteCurrency(7, 1, fval, nfCurrency, 2, '$');
- worksheet.WriteUTF8Text(8, 0, 'Excel''s calculation');
+ worksheet.WriteUTF8Text(8, 0, 'Excel''s calculation using constants');
worksheet.WriteNumberFormat(8, 1, nfCurrency, 2, '$');
- worksheet.WriteRPNFormula(8, 1, CreateRPNFormula(
+ worksheet.WriteRPNFormula(8, 1, CreateRPNFormula( // B9
RPNNumber(INTEREST_RATE,
RPNNumber(NUMBER_PAYMENTS,
- RPNNumber(-PAYMENT,
- RPNNumber(-PRESENT_VALUE,
+ RPNNumber(PAYMENT,
+ RPNNumber(PRESENT_VALUE,
RPNNumber(PAYMENT_WHEN,
RPNFunc(fekFV, 5,
nil))))))));
+ worksheet.WriteUTF8Text(9, 0, 'Excel''s calculation using cell values');
+ worksheet.WriteNumberFormat(9, 1, nfCurrency, 2, '$');
+ worksheet.WriteRPNFormula(9, 1, CreateRPNFormula( // B9
+ RPNCellValue('B1', // interest rate
+ RPNCellValue('B2', // number of periods
+ RPNCellValue('B3', // payment
+ RPNCellValue('B4', // present value
+ RPNCellValue('B5', // payment at end or at start
+ RPNFunc(fekFV, 5, // Call Excel's FV formula
+ nil))))))));
- workbook.WriteToFile('test_fv.xls', sfExcel8, true);
+ // present value calculation
+ pval := PV(INTEREST_RATE, NUMBER_PAYMENTS, PAYMENT, fval, PAYMENT_WHEN);
+ worksheet.WriteUTF8Text(11, 0, 'Present value');
+ worksheet.WriteFontStyle(11, 0, [fssBold]);
+ worksheet.WriteUTF8Text(12, 0, 'Our calculation');
+ worksheet.WriteCurrency(12, 1, pval, nfCurrency, 2, '$');
+
+ worksheet.WriteUTF8Text(13, 0, 'Excel''s calculation using constants');
+ worksheet.WriteNumberFormat(13, 1, nfCurrency, 2, '$');
+ worksheet.WriteRPNFormula(13, 1, CreateRPNFormula(
+ RPNNumber(INTEREST_RATE,
+ RPNNumber(NUMBER_PAYMENTS,
+ RPNNumber(PAYMENT,
+ RPNNumber(fval,
+ RPNNumber(PAYMENT_WHEN,
+ RPNFunc(fekPV, 5,
+ nil))))))));
+ Worksheet.WriteUTF8Text(14, 0, 'Excel''s calculation using cell values');
+ worksheet.WriteNumberFormat(14, 1, nfCurrency, 2, '$');
+ worksheet.WriteRPNFormula(14, 1, CreateRPNFormula(
+ RPNCellValue('B1', // interest rate
+ RPNCellValue('B2', // number of periods
+ RPNCellValue('B3', // payment
+ RPNCellValue('B10', // future value
+ RPNCellValue('B5', // payment at end or at start
+ RPNFunc(fekPV, 5, // Call Excel's PV formula
+ nil))))))));
+
+ // payments calculation
+ pmtval := PMT(INTEREST_RATE, NUMBER_PAYMENTS, PRESENT_VALUE, fval, PAYMENT_WHEN);
+ worksheet.WriteUTF8Text(16, 0, 'Payment');
+ worksheet.WriteFontStyle(16, 0, [fssBold]);
+ worksheet.WriteUTF8Text(17, 0, 'Our calculation');
+ worksheet.WriteCurrency(17, 1, pmtval, nfCurrency, 2, '$');
+
+ worksheet.WriteUTF8Text(18, 0, 'Excel''s calculation using constants');
+ worksheet.WriteNumberFormat(18, 1, nfCurrency, 2, '$');
+ worksheet.WriteRPNFormula(18, 1, CreateRPNFormula(
+ RPNNumber(INTEREST_RATE,
+ RPNNumber(NUMBER_PAYMENTS,
+ RPNNumber(PRESENT_VALUE,
+ RPNNumber(fval,
+ RPNNumber(PAYMENT_WHEN,
+ RPNFunc(fekPMT, 5,
+ nil))))))));
+ Worksheet.WriteUTF8Text(19, 0, 'Excel''s calculation using cell values');
+ worksheet.WriteNumberFormat(19, 1, nfCurrency, 2, '$');
+ worksheet.WriteRPNFormula(19, 1, CreateRPNFormula(
+ RPNCellValue('B1', // interest rate
+ RPNCellValue('B2', // number of periods
+ RPNCellValue('B4', // present value
+ RPNCellValue('B10', // future value
+ RPNCellValue('B5', // payment at end or at start
+ RPNFunc(fekPMT, 5, // Call Excel's PMT formula
+ nil))))))));
+
+ workbook.WriteToFile(AFileName, sfExcel8, true);
finally
workbook.Free;
end;
+end;
+
+{------------------------------------------------------------------------------}
+{ Read xls file to display Excel's results }
+{------------------------------------------------------------------------------}
+procedure ReadFile(AFileName: String);
+var
+ workbook: TsWorkbook;
+ worksheet: TsWorksheet;
+ r: Cardinal;
+ s1, s2: String;
+begin
+ workbook := TsWorkbook.Create;
+ try
+ workbook.ReadFormulas := true;
+ workbook.ReadFromFile(AFilename, sfExcel8);
+
+ worksheet := workbook.GetFirstWorksheet;
+
+ // Write all cells with contents to the console
+ WriteLn('');
+ WriteLn('Contents of the first worksheet of the file:');
+ WriteLn('');
+
+ for r := 0 to worksheet.GetLastRowIndex do begin
+ s1 := UTF8ToAnsi(worksheet.ReadAsUTF8Text(r, 0));
+ s2 := UTF8ToAnsi(worksheet.ReadAsUTF8Text(r, 1));
+ if s1 = '' then
+ WriteLn
+ else
+ WriteLn(s1+': ':50, s2);
+ end;
+
+ WriteLn;
+ WriteLn('Press [ENTER] to close...');
+ ReadLn;
+ finally
+ workbook.Free;
+ end;
+end;
+
+
+begin
+ WriteFile('test_fv.xls');
+ ReadFile('test_fv.xls');
end.
+