Меню сайта
Мини-чат
Чтобы добавить сообщение, необходимо авторизоваться.
Категории
Алгоритмы [95]
API [111]
Pascal [153]
Базы Данных [173]
BDE [0]
Интернет [0]
Мультимедия [0]
Аппаратное обеспечение [0]
Операционная система [0]
Компоненты [0]
Классы [0]
OLE+ [0]
Миграция [0]
Ошибки [0]
DLL [0]
Продукты третьих фирм [0]
Разное [0]
События [0]
Главная » Статьи » Не стандартные примеры на Delphi » Алгоритмы
Число строкой VI

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

    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 &lg; 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;  
Категория: Алгоритмы | Добавил: DelphiAiX (28.04.2012)
Просмотров: 513 | Рейтинг: 0.0/0
Всего комментариев: 0
Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
  тИЦ и PR сайта www.aix.ucoz.ru Protected by Copyscape Web Copyright Protection Software Счетчик цитирования
Все материалы размещенные на сайте пренадлежат их владельцам и предоставляются исключительно в ознакомительных целях.
Администрация ответственности за содержание материала не несет и убытки не возмещает.
По истечению 24 часов материал должен быть удален с вашего компьютера.
Незаконная реализация карается законами РФ и Украины : "Об авторском и смежном праве".
При копировании материала, ссылка на сайт обязательна! Сделать бесплатный сайт с uCoz | Карта сайта | Карта форума