Upload of the trusty old NumberToWords unit

NumberToWords.pas

unit NumberToWords;

{$mode ObjFPC}{$H+}{$J-}
{$ImplicitExceptions Off}

{-----------------------------------------------------------------------------
 Unit Name: NumberToWords
 Author:    Dave Keighan
 Date:      29-Jan-2006
 Purpose:   Provide Number To Words functionality.
 History:   29 Jan 2006 originally written.

 **** IMPORTANT ****
 1) You are free to use this code within your own applications, but you are
 expressly forbidden from selling or otherwise distributing this source code
 including inclusion of the code in a unit, module or component where this code
 would reasonably be considered to be a defining element of the unit or
 component without prior written consent.
 2) You must include this header in all instances of the code.
 3) You must ensure that you have read, understand and have modified the code as
 required for your use. This code is provided "as is" and the author makes no
 representations or warranties, express or implied. The user is solely
 responsible for the use and all results of the code provided herein.
-----------------------------------------------------------------------------}
interface

uses
  SysUtils, Classes;

const
  Ones: array[0..9] of string = ('zero ', 'one ', 'two ', 'three ', 'four ', 'five ', 'six ', 'seven ', 'eight ', 'nine ');
  Teens: array[10..19] of string = ('ten ', 'eleven ', 'twelve ', 'thirteen ', 'fourteen ', 'fifteen ', 'sixteen ', 'seventeen ', 'eighteen ', 'nineteen ');
  Tens: array[2..9] of string = ('twenty ', 'thirty ', 'forty ', 'fifty ', 'sixty ', 'seventy ', 'eighty ', 'ninety ');
  Suffix: array[0..5] of string = ('hundred ', 'thousand, ', 'million, ', 'billion, ', 'trillion, ', 'quadrillion, ');

var
  fs : TFormatSettings;

function ConvertToWords(const Number: double; UseCurrency: Boolean = True): string;

implementation

{-----------------------------------------------------------------------------
  Procedure: ConvertToWords
  Author:    Dave Keighan
  Date:      24-Jan-2006
  Arguments: const Number: double UseCurrency: Boolean
  Result:    string
-----------------------------------------------------------------------------}
{Note: This function uses the American "Short Scale" format for Names of large
 numbers See: http://en.wikipedia.org/wiki/Names_of_large_numbers .
 It's very simple to edit the code to accommodate your locale and system.

 The program gets two variables from the user.
 The first is: Number a double that represents the number to be formatted.
 Second is: UseCurrency a boolean value to get Currency formatting output.
}

function ConvertToWords(const Number: double; UseCurrency: Boolean): string;
{
There is one inline routine that occurs before the main processing code:
 DoHundreds - takes a three character shortstring and returns a value.
}

  function DoHundreds(const NumStr: string): string;
  var
    iCount: integer;
    iCurNum: integer;
    bFinished: Boolean;
    sLocNum: string;
  begin
    Result := '';
    sLocNum := NumStr;
    bFinished := False;
    //buffer the string with 0s depending on length.
    case Length(sLocNum) of
      1: sLocNum := '00' + sLocNum;
      2: sLocNum := '0' + sLocNum;
    end;
    //Process the string.
    for iCount := 1 to 3 do
      begin
        iCurNum := StrToInt(sLocNum[iCount]);
        if iCurNum > 0 then // it needs to be processed.
          case iCount of
            1:
              begin
                Result := Result + Ones[iCurNum] + Suffix[0];
                //append "and" if the value of last to digits is greated than 0.
                if strtoint(copy(sLocNum, 2, 2)) > 0 then
                  Result := Result + 'and ';
              end;
            2:
              begin
                if iCurNum = 1 then
                  begin
                    iCurNum := strtoint(copy(sLocNum, 2, 2));
                    Result := Result + Teens[iCurNum];
                    bFinished := True;
                  end
                else
                  Result := Result + Tens[iCurNum];
              end;
            3: if (not bFinished) then
                Result := Result + Ones[iCurNum];
          end;
      end;
  end;

  // This is where the main routine actually starts.
var
  sIntValue: string; //to hold the integer value.
  sDecValue: string; //value of the decimal value.
  sSectionVal: string; //the hundreds section to be processed.
  slValSections: TStringList; //array of the hundreds sections.
  iCount: integer; //counter variable.
  bIsNegative: boolean;
begin
  //Process the integer section first.

  bIsNegative := False;
  if Number < 0 then
    bIsNegative := True;

  //Extract the integer and fractional parts of Number as strings.
  //Use Try because FormatFloat, as used, will blow up if Lenght(sIntValue) >= 19.
  try
    sIntValue := FormatFloat('#,###', trunc(abs(Number)));
    sDecValue := Copy(FormatFloat('.#########', frac(abs(Number))), 2);
    if (Pos('E', sIntValue) > 0) then //the number is too big.
    begin
      Result := 'ERROR:';
      exit;
    end;
  except
    Result := 'ERROR:';
    exit;
  end;

  if (Length(sIntValue) <= 3) and (Length(sIntValue) > 0) then Result := DoHundreds(sIntValue)
  else if Length(sIntValue) = 0 then Result := ''
  else
    begin
      slValSections := TStringList.Create;
      //load the values, in groups of 100 using the comma positions.
      //slValSections.CommaText := sIntValue;
      slValSections.Delimiter := fs.ThousandSeparator;
      slValSections.DelimitedText := sIntValue;

      //swap the order of the numbers in the StringList.
      for iCount := 1 to slValSections.Count - 1 do
        slValSections.Move(iCount, 0);
      //process all the Integer values.
      for iCount := 0 to slValSections.Count - 1 do
        begin
          sSectionVal := '';
          sSectionVal := DoHundreds(slValSections[iCount]);
          if iCount > 0 then
            Result := sSectionVal + Suffix[iCount] + Result
          else
            Result := sSectionVal
        end;
      FreeAndNil(slValSections);
    end;

  //Remove trailing commas if there are any.
  if LastDelimiter(fs.DecimalSeparator, Result) = (length(Result) - 1) then  Delete(Result, Length(Result) - 1, 1);

  //Process the decimal section of the Number.
  if (Length(sDecValue) > 0) and UseCurrency then
    begin
      if Result > '' then //there was an integer value.
        Result := Result + 'dollars and ';
      if (Length(sDecValue) = 1) then
        sDecValue := sDecValue + '0';
      Result := Result + DoHundreds(copy(sDecValue, 1, 2)) + 'cents.';
    end
  else if UseCurrency then
    begin
      if Result > '' then //there was an integer value.
        Result := Result + 'dollars.'
    end
  else if (Length(sDecValue) > 0) then
    begin
      Result := Result + 'decimal ';
      for iCount := 1 to Length(sDecValue) do
        Result := Result + Ones[strtoint(sDecValue[iCount])];
    end;

  //Add the negative indicator if needed.
  if UseCurrency and bIsNegative then
    Result := 'minus ' + Result
  else if bIsNegative then
    Result := 'negative ' + Result;

  { TODO : Add result formatting at this point.
    This will require changing the function call to allow format selection. }
end;

initialization
  GetFormatSettings;

end.