2bf5464fc6
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3887 8e941d3f-bd1b-0410-a28a-d453659cc2b4
313 lines
12 KiB
ObjectPascal
313 lines
12 KiB
ObjectPascal
{ This demo shows how user-provided functions can be used for calculation of
|
|
RPN formulas that are built-in to fpspreadsheet, but don't have their own
|
|
calculation procedure.
|
|
|
|
The example will show implementation of some financial formulas:
|
|
- FV() (future value)
|
|
- PV() (present value)
|
|
- PMT() (payment)
|
|
- NPER() (number of payment periods)
|
|
|
|
The demo writes a spreadsheet 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 demo_formula_func;
|
|
|
|
{$mode delphi}{$H+}
|
|
|
|
uses
|
|
{$IFDEF UNIX}
|
|
{$IFDEF UseCThreads}
|
|
cthreads,
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
Classes, SysUtils, math,
|
|
fpstypes, fpspreadsheet, fpsallformats, fpsexprparser, financemath;
|
|
|
|
{ Base data used in this demonstration }
|
|
const
|
|
INTEREST_RATE = 0.03; // interest rate per period
|
|
NUMBER_PAYMENTS = 10; // number of payment periods
|
|
REG_PAYMENT = 1000; // regular payment per period
|
|
PRESENT_VALUE = 10000.0; // present value of investment
|
|
PAYMENT_WHEN: TPaymentTime = ptEndOfPeriod; // when is the payment made
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ Adaption of financial functions to usage by fpspreadsheet }
|
|
{ The functions are implemented in the unit "financemath.pas". }
|
|
{------------------------------------------------------------------------------}
|
|
|
|
procedure fpsFV(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result.ResFloat := FutureValue(
|
|
ArgToFloat(Args[0]), // interest rate
|
|
ArgToInt(Args[1]), // number of payments
|
|
ArgToFloat(Args[2]), // payment
|
|
ArgToFloat(Args[3]), // present value
|
|
TPaymentTime(ArgToInt(Args[4])) // payment type
|
|
);
|
|
end;
|
|
|
|
procedure fpsPMT(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result.ResFloat := Payment(
|
|
ArgToFloat(Args[0]), // interest rate
|
|
ArgToInt(Args[1]), // number of payments
|
|
ArgToFloat(Args[2]), // present value
|
|
ArgToFloat(Args[3]), // future value
|
|
TPaymentTime(ArgToInt(Args[4])) // payment type
|
|
);
|
|
end;
|
|
|
|
procedure fpsPV(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result.ResFloat := PresentValue(
|
|
ArgToFloat(Args[0]), // interest rate
|
|
ArgToInt(Args[1]), // number of payments
|
|
ArgToFloat(Args[2]), // payment
|
|
ArgToFloat(Args[3]), // future value
|
|
TPaymentTime(ArgToInt(Args[4])) // payment type
|
|
);
|
|
end;
|
|
|
|
procedure fpsNPER(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result.ResFloat := NumberOfPeriods(
|
|
ArgToFloat(Args[0]), // interest rate
|
|
ArgToFloat(Args[1]), // payment
|
|
ArgToFloat(Args[2]), // present value
|
|
ArgToFloat(Args[3]), // future value
|
|
TPaymentTime(ArgToInt(Args[4])) // payment type
|
|
);
|
|
end;
|
|
|
|
procedure fpsRATE(var Result: TsExpressionResult; const Args: TsExprParameterArray);
|
|
begin
|
|
Result.ResFloat := InterestRate(
|
|
ArgToInt(Args[0]), // number of payments
|
|
ArgToFloat(Args[1]), // payment
|
|
ArgToFloat(Args[2]), // present value
|
|
ArgToFloat(Args[3]), // future value
|
|
TPaymentTime(ArgToInt(Args[4])) // payment type
|
|
);
|
|
end;
|
|
|
|
|
|
{------------------------------------------------------------------------------}
|
|
{ Write xls file comparing our own calculations with Excel result }
|
|
{------------------------------------------------------------------------------}
|
|
procedure WriteFile(AFileName: String);
|
|
const
|
|
INT_EXCEL_SHEET_FUNC_PV = 56;
|
|
INT_EXCEL_SHEET_FUNC_FV = 57;
|
|
INT_EXCEL_SHEET_FUNC_NPER = 58;
|
|
INT_EXCEL_SHEET_FUNC_PMT = 59;
|
|
INT_EXCEL_SHEET_FUNC_RATE = 60;
|
|
|
|
var
|
|
workbook: TsWorkbook;
|
|
worksheet: TsWorksheet;
|
|
fval, pval, pmtval, nperval, rateval: Double;
|
|
formula: String;
|
|
fs: TFormatSettings;
|
|
|
|
begin
|
|
{ We have to register our financial functions in fpspreadsheet. Otherwise an
|
|
error code would be displayed in the reading part of this demo for these
|
|
formula cells.
|
|
The 1st parameter is the data type of the function result ('F'=float)
|
|
The 2nd parameter shows the data types of the arguments ('F=float, 'I'=integer)
|
|
The 3rd parameter is the Excel ID needed when writing to xls files. (see
|
|
"OpenOffice Documentation of Microsoft Excel File Format", section 3.11)
|
|
The 4th parameter is the address of the function to be used for calculation. }
|
|
|
|
RegisterFunction('FV', 'F', 'FIFFI', INT_EXCEL_SHEET_FUNC_FV, @fpsFV);
|
|
RegisterFunction('PMT', 'F', 'FIFFI', INT_EXCEL_SHEET_FUNC_PMT, @fpsPMT);
|
|
RegisterFunction('PV', 'F', 'FIFFI', INT_EXCEL_SHEET_FUNC_PV, @fpsPV);
|
|
RegisterFunction('NPER', 'F', 'FFFFI', INT_EXCEL_SHEET_FUNC_NPER, @fpsNPER);
|
|
RegisterFunction('RATE', 'F', 'IFFFI', INT_EXCEL_SHEET_FUNC_RATE, @fpsRATE);
|
|
|
|
// The formula parser requires a point as decimals separator.
|
|
fs := DefaultFormatSettings;
|
|
fs.DecimalSeparator := '.';
|
|
|
|
workbook := TsWorkbook.Create;
|
|
try
|
|
//workbook.Options := workbook.Options + [boCalcBeforeSaving];
|
|
|
|
worksheet := workbook.AddWorksheet('Financial');
|
|
worksheet.WriteColWidth(0, 40);
|
|
worksheet.WriteColWidth(1, 15);
|
|
|
|
worksheet.WriteUTF8Text(0, 0, 'INPUT DATA');
|
|
worksheet.WriteFontStyle(0, 0, [fssBold]);
|
|
|
|
worksheet.WriteUTF8Text(1, 0, 'Interest rate');
|
|
worksheet.WriteNumber(1, 1, INTEREST_RATE, nfPercentage, 1); // B2
|
|
|
|
worksheet.WriteUTF8Text(2, 0, 'Number of payments');
|
|
worksheet.WriteNumber(2, 1, NUMBER_PAYMENTS); // B3
|
|
|
|
worksheet.WriteUTF8Text(3, 0, 'Payment');
|
|
worksheet.WriteCurrency(3, 1, REG_PAYMENT, nfCurrency, 2, '$'); // B4
|
|
|
|
worksheet.WriteUTF8Text(4, 0, 'Present value');
|
|
worksheet.WriteCurrency(4, 1, PRESENT_VALUE, nfCurrency, 2, '$'); // B5
|
|
|
|
worksheet.WriteUTF8Text(5, 0, 'Payment at end (0) or at begin (1)');
|
|
worksheet.WriteNumber(5, 1, ord(PAYMENT_WHEN)); // B6
|
|
|
|
// future value calculation
|
|
fval := FutureValue(INTEREST_RATE, NUMBER_PAYMENTS, REG_PAYMENT, PRESENT_VALUE, PAYMENT_WHEN);
|
|
worksheet.WriteUTF8Text(7, 0, 'CALCULATION OF THE FUTURE VALUE');
|
|
worksheet.WriteFontStyle(7, 0, [fssBold]);
|
|
worksheet.WriteUTF8Text(8, 0, 'Direct calculation');
|
|
worksheet.WriteCurrency(8, 1, fval, nfCurrency, 2, '$');
|
|
|
|
worksheet.WriteUTF8Text(9, 0, 'Worksheet calculation using constants');
|
|
worksheet.WriteNumberFormat(9, 1, nfCurrency, 2, '$');
|
|
worksheet.WriteNumberFormat(9, 1, nfCurrency, 2, '$');
|
|
formula := Format('FV(%f,%d,%f,%f,%d)',
|
|
[1.0*INTEREST_RATE, NUMBER_PAYMENTS, 1.0*REG_PAYMENT, 1.0*PRESENT_VALUE, ord(PAYMENT_WHEN)], fs
|
|
);
|
|
worksheet.WriteFormula(9, 1, formula);
|
|
worksheet.WriteUTF8Text(10, 0, 'Worksheet calculation using cell values');
|
|
worksheet.WriteNumberFormat(10, 1, nfCurrency, 2, '$');
|
|
worksheet.WriteFormula(10, 1, 'FV(B2,B3,B4,B5,B6)');
|
|
|
|
// present value calculation
|
|
pval := PresentValue(INTEREST_RATE, NUMBER_PAYMENTS, REG_PAYMENT, fval, PAYMENT_WHEN);
|
|
worksheet.WriteUTF8Text(12, 0, 'CALCULATION OF THE PRESENT VALUE');
|
|
worksheet.WriteFontStyle(12, 0, [fssBold]);
|
|
worksheet.WriteUTF8Text(13, 0, 'Direct calculation');
|
|
worksheet.WriteCurrency(13, 1, pval, nfCurrency, 2, '$');
|
|
|
|
worksheet.WriteUTF8Text(14, 0, 'Worksheet calculation using constants');
|
|
formula := Format('PV(%f,%d,%f,%f,%d)',
|
|
[1.0*INTEREST_RATE, NUMBER_PAYMENTS, 1.0*REG_PAYMENT, fval, ord(PAYMENT_WHEN)], fs
|
|
);
|
|
worksheet.WriteNumberFormat(14, 1, nfCurrency, 2, '$');
|
|
worksheet.WriteFormula(14, 1, formula);
|
|
Worksheet.WriteUTF8Text(15, 0, 'Worksheet calculation using cell values');
|
|
worksheet.WriteNumberFormat(15, 1, nfCurrency, 2, '$');
|
|
worksheet.WriteFormula(15, 1, 'PV(B2,B3,B4,B11,B6)');
|
|
|
|
// payments calculation
|
|
pmtval := Payment(INTEREST_RATE, NUMBER_PAYMENTS, PRESENT_VALUE, fval, PAYMENT_WHEN);
|
|
worksheet.WriteUTF8Text(17, 0, 'CALCULATION OF THE PAYMENT');
|
|
worksheet.WriteFontStyle(17, 0, [fssBold]);
|
|
worksheet.WriteUTF8Text(18, 0, 'Direct calculation');
|
|
worksheet.WriteCurrency(18, 1, pmtval, nfCurrency, 2, '$');
|
|
|
|
worksheet.WriteUTF8Text(19, 0, 'Worksheet calculation using constants');
|
|
worksheet.WriteNumberFormat(19, 1, nfCurrency, 2, '$');
|
|
formula := Format('PMT(%g,%d,%g,%g,%d)',
|
|
[INTEREST_RATE, NUMBER_PAYMENTS, PRESENT_VALUE, fval, ord(PAYMENT_WHEN)], fs
|
|
);
|
|
worksheet.WriteFormula(19, 1, formula);
|
|
Worksheet.WriteUTF8Text(20, 0, 'Worksheet calculation using cell values');
|
|
worksheet.WriteNumberFormat(20, 1, nfCurrency, 2, '$');
|
|
worksheet.WriteFormula(20, 1, 'PMT(B2,B3,B5,B11,B6)');
|
|
|
|
// number of periods calculation
|
|
nperval := NumberOfPeriods(INTEREST_RATE, REG_PAYMENT, PRESENT_VALUE, fval, PAYMENT_WHEN);
|
|
worksheet.WriteUTF8Text(22, 0, 'CALCULATION OF THE NUMBER OF PAYMENT PERIODS');
|
|
worksheet.WriteFontStyle(22, 0, [fssBold]);
|
|
worksheet.WriteUTF8Text(23, 0, 'Direct calculation');
|
|
worksheet.WriteNumber(23, 1, nperval, nfFixed, 2);
|
|
|
|
worksheet.WriteUTF8Text(24, 0, 'Worksheet calculation using constants');
|
|
worksheet.WriteNumberFormat(24, 1, nfFixed, 2);
|
|
formula := Format('NPER(%g,%g,%g,%g,%d)',
|
|
[1.0*INTEREST_RATE, 1.0*REG_PAYMENT, 1.0*PRESENT_VALUE, fval, ord(PAYMENT_WHEN)], fs
|
|
);
|
|
worksheet.WriteFormula(24, 1, formula);
|
|
Worksheet.WriteUTF8Text(25, 0, 'Worksheet calculation using cell values');
|
|
worksheet.WriteNumberFormat(25, 1, nfFixed, 2);
|
|
worksheet.WriteFormula(25, 1, 'NPER(B2,B4,B5,B11,B6)');
|
|
|
|
// interest rate calculation
|
|
rateval := InterestRate(NUMBER_PAYMENTS, REG_PAYMENT, PRESENT_VALUE, fval, PAYMENT_WHEN);
|
|
worksheet.WriteUTF8Text(27, 0, 'CALCULATION OF THE INTEREST RATE');
|
|
worksheet.WriteFontStyle(27, 0, [fssBold]);
|
|
worksheet.WriteUTF8Text(28, 0, 'Direct calculation');
|
|
worksheet.WriteNumber(28, 1, rateval, nfPercentage, 2);
|
|
|
|
worksheet.WriteUTF8Text(29, 0, 'Worksheet calculation using constants');
|
|
worksheet.WriteNumberFormat(29, 1, nfPercentage, 2);
|
|
formula := Format('RATE(%d,%g,%g,%g,%d)',
|
|
[NUMBER_PAYMENTS, 1.0*REG_PAYMENT, 1.0*PRESENT_VALUE, fval, ord(PAYMENT_WHEN)], fs
|
|
);
|
|
worksheet.WriteFormula(29, 1, formula);
|
|
Worksheet.WriteUTF8Text(30, 0, 'Worksheet calculation using cell values');
|
|
worksheet.WriteNumberFormat(30, 1, nfPercentage, 2);
|
|
worksheet.WriteFormula(30, 1, 'RATE(B3,B4,B5,B11,B6)');
|
|
|
|
workbook.WriteToFile(AFileName, 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.Options := workbook.Options + [boReadFormulas, boAutoCalc];
|
|
workbook.ReadFromFile(AFilename);
|
|
worksheet := workbook.GetFirstWorksheet;
|
|
|
|
// Write all cells with contents to the console
|
|
WriteLn('');
|
|
WriteLn('Contents of file "', AFileName, '"');
|
|
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
|
|
if s2 = '' then
|
|
WriteLn(s1)
|
|
else
|
|
WriteLn(s1+': ':50, s2);
|
|
end;
|
|
|
|
finally
|
|
workbook.Free;
|
|
end;
|
|
end;
|
|
|
|
const
|
|
TestFile='test_user_formula.xlsx'; // Format depends on extension selected
|
|
// !!!! ods not working yet !!!!
|
|
|
|
begin
|
|
WriteLn('This demo registers user-defined functions for financial calculations');
|
|
WriteLn('and writes and reads the corresponding spreadsheet file.');
|
|
WriteLn;
|
|
|
|
WriteFile(TestFile);
|
|
ReadFile(TestFile);
|
|
|
|
WriteLn;
|
|
WriteLn('Open the file in Excel or OpenOffice/LibreOffice.');
|
|
WriteLn('Press [ENTER] to close...');
|
|
ReadLn;
|
|
end.
|
|
|
|
|