{ 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.