Delphi World - Сумма прописью

Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...

Сумма прописью - Способ 10

Еще два решения конвертации денежной суммы на английском языке

function HundredAtATime(TheAmount: Integer): string;
var
  TheResult: string;
begin
  TheResult := '';
  TheAmount := Abs(TheAmount);
  while TheAmount > 0 do
  begin
    if TheAmount >= 900 then
    begin
      TheResult := TheResult + 'Nine hundred ';
      TheAmount := TheAmount - 900;
    end;
    if TheAmount >= 800 then
    begin
      TheResult := TheResult + 'Eight hundred ';
      TheAmount := TheAmount - 800;
    end;
    if TheAmount >= 700 then
    begin
      TheResult := TheResult + 'Seven hundred ';
      TheAmount := TheAmount - 700;
    end;
    if TheAmount >= 600 then
    begin
      TheResult := TheResult + 'Six hundred ';
      TheAmount := TheAmount - 600;
    end;
    if TheAmount >= 500 then
    begin
      TheResult := TheResult + 'Five hundred ';
      TheAmount := TheAmount - 500;
    end;
    if TheAmount >= 400 then
    begin
      TheResult := TheResult + 'Four hundred ';
      TheAmount := TheAmount - 400;
    end;
    if TheAmount >= 300 then
    begin
      TheResult := TheResult + 'Three hundred ';
      TheAmount := TheAmount - 300;
    end;
    if TheAmount >= 200 then
    begin
      TheResult := TheResult + 'Two hundred ';
      TheAmount := TheAmount - 200;
    end;
    if TheAmount >= 100 then
    begin
      TheResult := TheResult + 'One hundred ';
      TheAmount := TheAmount - 100;
    end;
    if TheAmount >= 90 then
    begin
      TheResult := TheResult + 'Ninety ';
      TheAmount := TheAmount - 90;
    end;
    if TheAmount >= 80 then
    begin
      TheResult := TheResult + 'Eighty ';
      TheAmount := TheAmount - 80;
    end;
    if TheAmount >= 70 then
    begin
      TheResult := TheResult + 'Seventy ';
      TheAmount := TheAmount - 70;
    end;
    if TheAmount >= 60 then
    begin
      TheResult := TheResult + 'Sixty ';
      TheAmount := TheAmount - 60;
    end;
    if TheAmount >= 50 then
    begin
      TheResult := TheResult + 'Fifty ';
      TheAmount := TheAmount - 50;
    end;
    if TheAmount >= 40 then
    begin
      TheResult := TheResult + 'Fourty ';
      TheAmount := TheAmount - 40;
    end;
    if TheAmount >= 30 then
    begin
      TheResult := TheResult + 'Thirty ';
      TheAmount := TheAmount - 30;
    end;
    if TheAmount >= 20 then
    begin
      TheResult := TheResult + 'Twenty ';
      TheAmount := TheAmount - 20;
    end;
    if TheAmount >= 19 then
    begin
      TheResult := TheResult + 'Nineteen ';
      TheAmount := TheAmount - 19;
    end;
    if TheAmount >= 18 then
    begin
      TheResult := TheResult + 'Eighteen ';
      TheAmount := TheAmount - 18;
    end;
    if TheAmount >= 17 then
    begin
      TheResult := TheResult + 'Seventeen ';
      TheAmount := TheAmount - 17;
    end;
    if TheAmount >= 16 then
    begin
      TheResult := TheResult + 'Sixteen ';
      TheAmount := TheAmount - 16;
    end;
    if TheAmount >= 15 then
    begin
      TheResult := TheResult + 'Fifteen ';
      TheAmount := TheAmount - 15;
    end;
    if TheAmount >= 14 then
    begin
      TheResult := TheResult + 'Fourteen ';
      TheAmount := TheAmount - 14;
    end;
    if TheAmount >= 13 then
    begin
      TheResult := TheResult + 'Thirteen ';
      TheAmount := TheAmount - 13;
    end;
    if TheAmount >= 12 then
    begin
      TheResult := TheResult + 'Twelve ';
      TheAmount := TheAmount - 12;
    end;
    if TheAmount >= 11 then
    begin
      TheResult := TheResult + 'Eleven ';
      TheAmount := TheAmount - 11;
    end;
    if TheAmount >= 10 then
    begin
      TheResult := TheResult + 'Ten ';
      TheAmount := TheAmount - 10;
    end;
    if TheAmount >= 9 then
    begin
      TheResult := TheResult + 'Nine ';
      TheAmount := TheAmount - 9;
    end;
    if TheAmount >= 8 then
    begin
      TheResult := TheResult + 'Eight ';
      TheAmount := TheAmount - 8;
    end;
    if TheAmount >= 7 then
    begin
      TheResult := TheResult + 'Seven ';
      TheAmount := TheAmount - 7;
    end;
    if TheAmount >= 6 then
    begin
      TheResult := TheResult + 'Six ';
      TheAmount := TheAmount - 6;
    end;
    if TheAmount >= 5 then
    begin
      TheResult := TheResult + 'Five ';
      TheAmount := TheAmount - 5;
    end;
    if TheAmount >= 4 then
    begin
      TheResult := TheResult + 'Four ';
      TheAmount := TheAmount - 4;
    end;
    if TheAmount >= 3 then
    begin
      TheResult := TheResult + 'Three ';
      TheAmount := TheAmount - 3;
    end;
    if TheAmount >= 2 then
    begin
      TheResult := TheResult + 'Two ';
      TheAmount := TheAmount - 2;
    end;
    if TheAmount >= 1 then
    begin
      TheResult := TheResult + 'One ';
      TheAmount := TheAmount - 1;
    end;
  end;
  HundredAtATime := TheResult;
end;

function Real2CheckAmount(TheAmount: Real): string;
var

  IntVal: LongInt;
  TmpVal: Integer;
  TmpStr,
    RetVal: string;
begin

  TheAmount := Abs(TheAmount);

  { центы }
  TmpVal := Round(Frac(TheAmount) * 100);
  IntVal := Trunc(TheAmount);
  TmpStr := HundredAtATime(TmpVal);
  if TmpStr = '' then
    TmpStr := 'Zero ';
  RetVal := TmpStr + 'cents';
  if IntVal > 0 then
    RetVal := 'dollars and ' + RetVal;

  { сотни }
  TmpVal := Round(Frac((IntVal * 1.0) / 1000.0) * 1000);
  IntVal := Trunc((IntVal * 1.0) / 1000.0);
  TmpStr := HundredAtATime(TmpVal);
  RetVal := TmpStr + RetVal;

  { тысячи }
  TmpVal := Round(Frac((IntVal * 1.0) / 1000.0) * 1000);
  IntVal := Trunc((IntVal * 1.0) / 1000.0);
  TmpStr := HundredAtATime(TmpVal);
  if TmpStr <> '' then
    RetVal := TmpStr + 'Thousand ' + RetVal;

  { миллионы }
  TmpVal := Round(Frac((IntVal * 1.0) / 1000.0) * 1000);
  IntVal := Trunc((IntVal * 1.0) / 1000.0);
  TmpStr := HundredAtATime(TmpVal);
  if TmpStr <> '' then
    RetVal := TmpStr + 'Million ' + RetVal;

  { миллиарды }
  TmpVal := Round(Frac((IntVal * 1.0) / 1000.0) * 1000);
  IntVal := Trunc((IntVal * 1.0) / 1000.0);
  TmpStr := HundredAtATime(TmpVal);
  if TmpStr <> '' then
    RetVal := TmpStr + 'Billion ' + RetVal;

  Real2CheckAmount := RetVal;
end;

Хммммм... вроде бы работает, но как все громоздко и неуклюже.... добавьте в код немного рекурсии и вы получите более элегантную программу..:)))

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    num: TEdit;
    spell: TEdit;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    function trans9(num: integer): string;
    function trans19(num: integer): string;
    function trans99(num: integer): string;
    function IntToSpell(num: integer): string;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

function TForm1.IntToSpell(num: integer): string;
var
  spell: string;
  hspell: string;
  hundred: string;
  thousand: string;
  tthousand: string;
  hthousand: string;
  million: string;
begin
  if num ≶
  10 then
    spell := trans9(num);
  {endif}
  if (num < 20) and (num > 10) then
    spell := trans19(num);
  {endif}
  if (((num < 100) and (num > 19)) or (num = 10)) then
  begin
    hspell := copy(IntToStr(num), 1, 1) + '0';
    spell := trans99(StrToInt(hspell));
    hspell := copy(IntToStr(num), 2, 1);
    spell := spell + ' ' + IntToSpell(StrToInt(hspell));
  end;

  if (num < 1000) and (num > 100) then
  begin
    hspell := copy(IntToStr(num), 1, 1);
    hundred := IntToSpell(StrToInt(hspell));
    hspell := copy(IntToStr(num), 2, 2);
    hundred := hundred + ' hundred and ' + IntToSpell(StrToInt(hspell));
    spell := hundred;
  end;

  if (num < 10000) and (num > 1000) then
  begin
    hspell := copy(IntToStr(num), 1, 1);
    thousand := IntToSpell(StrToInt(hspell));
    hspell := copy(IntToStr(num), 2, 3);
    thousand := thousand + ' thousand ' + IntToSpell(StrToInt(hspell));
    spell := thousand;
  end;

  if (num < 100000) and (num > 10000) then
  begin
    hspell := copy(IntToStr(num), 1, 2);
    tthousand := IntToSpell(StrToInt(hspell));
    hspell := copy(IntToStr(num), 3, 3);
    tthousand := tthousand + ' thousand ' + IntToSpell(StrToInt(hspell));
    spell := tthousand;
  end;

  if (num < 1000000) and (num > 100000) then
  begin
    hspell := copy(IntToStr(num), 1, 3);
    hthousand := IntToSpell(StrToInt(hspell));
    hspell := copy(IntToStr(num), 4, 3);
    hthousand := hthousand + ' thousand and ' +
      IntToSpell(StrToInt(hspell));

    spell := hthousand;
  end;

  if (num < 10000000) and (num > 1000000) then
  begin
    hspell := copy(IntToStr(num), 1, 1);
    million := IntToSpell(StrToInt(hspell));
    hspell := copy(IntToStr(num), 2, 6);
    million := million + ' million and ' + IntToSpell(StrToInt(hspell));
    spell := million;
  end;

  IntToSpell := spell;
end;

function TForm1.trans99(num: integer): string;
var
  spell: string;
begin
  case num of
    10: spell := 'ten';
    20: spell := 'twenty';
    30: spell := 'thirty';
    40: spell := 'fourty';
    50: spell := 'fifty';
    60: spell := 'sixty';
    70: spell := 'seventy';
    80: spell := 'eighty';
    90: spell := 'ninty';
  end;
  trans99 := spell;
end;

function TForm1.trans19(num: integer): string;
var
  spell: string;
begin
  case num of
    11: spell := 'eleven';
    12: spell := 'twelve';
    13: spell := 'thirteen';
    14: spell := 'fourteen';
    15: spell := 'fifteen';
    16: spell := 'sixteen';
    17: spell := 'seventeen';
    18: spell := 'eighteen';
    19: spell := 'nineteen';
  end;
  trans19 := spell;
end;

function TForm1.trans9(num: integer): string;
var
  spell: string;
begin
  case num of
    1: spell := 'one';
    2: spell := 'two';
    3: spell := 'three';
    4: spell := 'four';
    5: spell := 'five';
    6: spell := 'six';
    7: spell := 'seven';
    8: spell := 'eight';
    9: spell := 'nine';
  end;
  trans9 := spell;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  numb: integer;
begin
  spell.text := IntToSpell(StrToInt(num.text));
end;

end.