скрыть

скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Google  
 

Сумма прописью - Способ 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.






Copyright © 2004-2016 "Delphi Sources". Delphi World FAQ




Группа ВКонтакте   Ссылка на Twitter   Группа на Facebook