تبدیل عدد به حروف انگلیسی بسیار عالی

Function RealToTxt(Amount : Real) : String;
var
 Num : LongInt;
 Fracture : Integer;

 function Num2Str(Num: LongInt): String;
 Const hundred = 100;
       thousand = 1000;
       million = 1000000;
       billion = 1000000000;
  begin
    if Num >= billion then
      if (Num mod billion) = 0 then
        Num2Str := Num2Str(Num div billion) + " Billion"
      else
        Num2Str := Num2Str(Num div billion) + " Billion " +
                   Num2Str(Num mod billion)
    else
      if Num >= million then
        if (Num mod million) = 0 then
          Num2Str := Num2Str(Num div million) + " Million"
        else
          Num2Str := Num2Str(Num div million) + " Million " +
                     Num2Str(Num mod million)
      else
        if Num >= thousand then
          if (Num mod thousand) = 0 then
            Num2Str := Num2Str(Num div thousand) + " Thousand"
          else
            Num2Str := Num2Str(Num div thousand) + " Thousand " +
                       Num2Str(Num mod thousand)
        else
          if Num >= hundred then
            if (Num mod hundred) = 0 then
              Num2Str := Num2Str(Num div hundred) + " Hundred"
            else
              Num2Str := Num2Str(Num div  hundred) + " Hundred " +
                         Num2Str(Num mod hundred)
          else
          case (Num div 10) of
         6,7,9: if (Num mod 10) = 0 then
                   Num2Str := Num2Str(Num div 10) + "ty"
                 else
                   Num2Str := Num2Str(Num div 10) + "ty-" +
                              Num2Str(Num mod 10);
              8: if Num = 80 then
                   Num2Str := "Eighty"
                 else
                   Num2Str := "Eighty-" + Num2Str(Num mod 10);
              5: if Num = 50 then
                   Num2Str := "Fifty"
                 else
                   Num2Str := "Fifty-" + Num2Str(Num mod 10);
              4: if Num = 40 then
                   Num2Str := "Forty"
                 else
                   Num2Str := "Forty-" + Num2Str(Num mod 10);
              3: if Num = 30 then
                   Num2Str := "Thirty"
                 else
                   Num2Str := "Thirty-" + Num2Str(Num mod 10);
              2: if Num = 20 then
                   Num2Str := "Twenty"
                 else
                   Num2Str := "Twenty-" + Num2Str(Num mod 10);
            0,1: case Num of
                    0: Num2Str := "Zero";
                    1: Num2Str := "One";
                    2: Num2Str := "Two";
                    3: Num2Str := "Three";
                    4: Num2Str := "Four";
                    5: Num2Str := "Five";
                    6: Num2Str := "Six";
                    7: Num2Str := "Seven";
                    8: Num2Str := "Eight";
                    9: Num2Str := "Nine";
                   10: Num2Str := "Ten";
                   11: Num2Str := "Eleven";
                   12: Num2Str := "Twelve";
                   13: Num2Str := "Thirteen";
                   14: Num2Str := "Fourteen";
                   15: Num2Str := "Fifteen";
                   16: Num2Str := "Sixteen";
                   17: Num2Str := "Seventeen";
                   18: Num2Str := "Eightteen";
                   19: Num2Str := "Nineteen"
                 end
          end
 end {Num2Str};

begin
 Num:= Trunc(Amount);
 Fracture:= Round(1000*Frac(Amount));
 if Num > 0 then
   Result := Num2Str(Num) + " and ";
 if Fracture > 0 then
   Result := Result + IntToStr(Fracture) + "/1000"
 else
   Result := Result +  "000/1000";
end;

به عنوان مثال:

procedure TForm1.Button1Click(Sender: T);
begin
form1.Caption:=realtotxt(123);
end;

برگرفته شده از سایت دنیای برنامه نویسی دلفی(http://mt85.blogfa.com)