unit Facto2F;
//*******************************************************
// Example program demonstrating non-recursive factorials
// using tail recursion removal.
//*******************************************************
// Copyright (C) 1998 John Wiley & Sons, Inc.
// All rights reserved. See additional copyright
// information in Readme.txt.
//*******************************************************

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Menus;


type
  TFactorialForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    mnuExit: TMenuItem;
    Help1: TMenuItem;
    mnuAbout: TMenuItem;
    NEdit: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    ResultLabel: TLabel;
    CmdCompute: TButton;
    procedure NEditChange(Sender: TObject);
    procedure NumbersOnly(Sender: TObject; var Key: Char);
    procedure CmdComputeClick(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
    procedure mnuAboutClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  FactorialForm: TFactorialForm;

    function Factorial(n : Double) : Double;

implementation

{$R *.DFM}

procedure TFactorialForm.NEditChange(Sender: TObject);
begin
    CmdCompute.Enabled := (NEdit.Text <> '');
end;

procedure TFactorialForm.NumbersOnly(Sender: TObject; var Key: Char);
begin
    if (Key = #8) then exit; // Backspace.
    if ((Key >= '0') and (Key <= '9')) then exit;
    Key := #0;
end;

procedure TFactorialForm.CmdComputeClick(Sender: TObject);
var
    n : Double;
begin
    n := StrToFloat(NEdit.Text);
    if (n > 170) then
        ShowMessage('N nie może być większe niż 170.')
    else
        ResultLabel.Caption :=
            Format('%.6g', [Factorial(n)]);
end;

procedure TFactorialForm.mnuExitClick(Sender: TObject);
begin
    Close;
end;

procedure TFactorialForm.mnuAboutClick(Sender: TObject);
const
    CR = #13#10;
    CRCR = #13#10#13#10;
begin
  MessageDlg(
        'Niniejszy program demonstruje eliminację rekurencji końcowej' +CR +
        'na przykładzie funkcji silnia' + CRCR +
        'Wprowad argument i kliknij w przycisk "Oblicz".'
        , mtInformation, [mbOK], 0);


end;



// Use tail recursion removal to compute factorials
// non-recursively.
function Factorial(n : Double) : Double;
begin
    Result := 1;
    while (n > 1) do
    begin
        Result := Result * n;
        n := n - 1; // Prepare arguments for "recursion."
    end;
end;

end.
