Help - Search - Members - Calendar
Full Version: Число строкой
форум о программировании : > General Programming (только для чтения) > Faq > Числа


Lamer
Число строкой V

Вот еще одно решение, присланное Олегом Клюкач.

 
 
unitNuminwrd;
interface
functionsMoneyInWords( Nin: currency ): string; export;
functionszMoneyInWords( Nin: currency ): PChar; export;
{ Денежная сумма Nin в рублях и копейках прописью
1997, в.2.1, by О.В.Болдырев}
implementation
usesSysUtils,Dialogs,Math;
type
tri=string[4];
mood=1..2;
gender=(m,f);
uns =array[0..9] of string[7];
tns =array[0..9] of string[13];
decs=array[0..9] of string[12];
huns=array[0..9] of string[10];
nums=array[0..4] of string[8];
money=array[1..2] of string[5];
endings=array[gender,mood,1..3] oftri;{окончания числительных и денег}
const
units:uns  =('','один ','два ','три ','четыре ','пять ',
'шесть ','семь ','восемь ','девять ');
unitsf:uns=('','одна ','две ','три ','четыре ','пять ',
'шесть ','семь ','восемь ','девять ');
teens:tns=  ('десять ','одиннадцать ','двенадцать ','тринадцать ',
'четырнадцать ','пятнадцать ','шестнадцать ',
'семнадцать ','восемнадцать ','девятнадцать ');
decades:decs=('','десять ','двадцать ','тридцать ','сорок ',
'пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ',
'девяносто ');
hundreds:huns=('','сто ','двести ','триста ','четыреста ',
'пятьсот ','шестьсот ','семьсот ','восемьсот ',
'девятьсот ');
numericals:nums=('','тысяч','миллион','миллиард','триллион');
RusMon:money=('рубл','копе');
ends:endings=((('','а','ов'),('ь','я','ей')),
(('а','и',''),('йка','йки','ек')));
threadvar
str: string;
functionEndingIndex(Arg: integer): integer;
begin
if((Arg div10) mod10) <> 1then
case(Arg mod10) of
1:    Result := 1;
2..4: Result := 2;
else  Result := 3;
end
else
Result := 3;
end;
functionsMoneyInWords( Nin: currency ): string; { Число Nin прописью, как функция }
var
//  str: string;
g: gender; //род
Nr:  comp; {целая часть числа}
Fr:  integer; {дробная часть числа}
i,iTri,Order: longint; {триада}
procedureTriad;
var
iTri2: integer;
un, de, ce :byte; //единицы, десятки, сотни
functionGetDigit: byte;
begin
Result := iTri2 mod10;
iTri2  := iTri2 div10;
end;
begin
iTri := trunc(Nr/IntPower(1000,i));
Nr := Nr - int( iTri*IntPower(1000,i));
iTri2:=iTri;
ifiTri > 0then
begin
un := GetDigit;
de := GetDigit;
ce := GetDigit;
ifi=1theng:=f
else g:=m; {женского рода только тысяча}
str := TrimRight(str)+' '+Hundreds[ce];
ifde = 1then
str := TrimRight(str)+' '+Teens[un]
else
begin
str := TrimRight(str)+' '+Decades[de];
caseg of
m: str := TrimRight(str)+' '+Units[un];
f: str := TrimRight(str)+' '+UnitsF[un];
end;
end;
iflength(numericals[i]) > 1then
begin
str := TrimRight(str)+' '+numericals[i];
str := TrimRight(str)+ends[g,1,EndingIndex(iTri)];
end;
end; //triad is 0 ?
ifi=0thenExit;
Dec(i);
Triad;
end;
begin
str := '';
Nr  := int( Nin );
Fr  := round( Nin*100+ 0.00000001) mod100;
ifNr>0thenOrder := trunc(Log10(Nr)/3)
else
begin
str := 'ноль';
Order := 0
end;
ifOrder > High(numericals) then
raiseException.Create('Слишком большое число для суммы прописью');
i:= Order;
Triad;
str :=
Format('%s %s%s %.2d %s%s', [Trim(str),RusMon[1],ends[m,2,EndingIndex(iTri)],
Fr, RusMon[2],ends[f,2,EndingIndex(Fr)]]);
str[1] := (ANSIUpperCase(copy(str,1,1)))[1];
str[Length(str)+1] := #0;
Result := str;
end;
functionszMoneyInWords( Nin: currency ): PChar;
begin
sMoneyInWords(Nin);
Result := @(str[1]);
end;
end.
Lamer
Число строкой VI
Еще два решения конвертации денежной суммы на английском языке

 
 
Function  HundredAtATime(TheAmount:Integer):String;
var
TheResult : String;
Begin
TheResult := '';
TheAmount := Abs(TheAmount);
WhileTheAmount > 0do Begin
IfTheAmount >= 900Then Begin
TheResult := TheResult + 'Nine hundred ';
TheAmount := TheAmount - 900;
End;
IfTheAmount >= 800Then Begin
TheResult := TheResult + 'Eight hundred ';
TheAmount := TheAmount - 800;
End;
IfTheAmount >= 700Then Begin
TheResult := TheResult + 'Seven hundred ';
TheAmount := TheAmount - 700;
End;
IfTheAmount >= 600Then Begin
TheResult := TheResult + 'Six hundred ';
TheAmount := TheAmount - 600;
End;
IfTheAmount >= 500Then Begin
TheResult := TheResult + 'Five hundred ';
TheAmount := TheAmount - 500;
End;
IfTheAmount >= 400Then Begin
TheResult := TheResult + 'Four hundred ';
TheAmount := TheAmount - 400;
End;
IfTheAmount >= 300Then Begin
TheResult := TheResult + 'Three hundred ';
TheAmount := TheAmount - 300;
End;
IfTheAmount >= 200Then Begin
TheResult := TheResult + 'Two hundred ';
TheAmount := TheAmount - 200;
End;
IfTheAmount >= 100Then Begin
TheResult := TheResult + 'One hundred ';
TheAmount := TheAmount - 100;
End;
IfTheAmount >= 90Then Begin
TheResult := TheResult + 'Ninety ';
TheAmount := TheAmount - 90;
End;
IfTheAmount >= 80Then Begin
TheResult := TheResult + 'Eighty ';
TheAmount := TheAmount - 80;
End;
IfTheAmount >= 70Then Begin
TheResult := TheResult + 'Seventy ';
TheAmount := TheAmount - 70;
End;
IfTheAmount >= 60Then Begin
TheResult := TheResult + 'Sixty ';
TheAmount := TheAmount - 60;
End;
IfTheAmount >= 50Then Begin
TheResult := TheResult + 'Fifty ';
TheAmount := TheAmount - 50;
End;
IfTheAmount >= 40Then Begin
TheResult := TheResult + 'Fourty ';
TheAmount := TheAmount - 40;
End;
IfTheAmount >= 30Then Begin
TheResult := TheResult + 'Thirty ';
TheAmount := TheAmount - 30;
End;
IfTheAmount >= 20Then Begin
TheResult := TheResult + 'Twenty ';
TheAmount := TheAmount - 20;
End;
IfTheAmount >= 19Then Begin
TheResult := TheResult + 'Nineteen ';
TheAmount := TheAmount - 19;
End;
IfTheAmount >= 18Then Begin
TheResult := TheResult + 'Eighteen ';
TheAmount := TheAmount - 18;
End;
IfTheAmount >= 17Then Begin
TheResult := TheResult + 'Seventeen ';
TheAmount := TheAmount - 17;
End;
IfTheAmount >= 16Then Begin
TheResult := TheResult + 'Sixteen ';
TheAmount := TheAmount - 16;
End;
IfTheAmount >= 15Then Begin
TheResult := TheResult + 'Fifteen ';
TheAmount := TheAmount - 15;
End;
IfTheAmount >= 14Then Begin
TheResult := TheResult + 'Fourteen ';
TheAmount := TheAmount - 14;
End;
IfTheAmount >= 13Then Begin
TheResult := TheResult + 'Thirteen ';
TheAmount := TheAmount - 13;
End;
IfTheAmount >= 12Then Begin
TheResult := TheResult + 'Twelve ';
TheAmount := TheAmount - 12;
End;
IfTheAmount >= 11Then Begin
TheResult := TheResult + 'Eleven ';
TheAmount := TheAmount - 11;
End;
IfTheAmount >= 10Then Begin
TheResult := TheResult + 'Ten ';
TheAmount := TheAmount - 10;
End;
IfTheAmount >= 9Then Begin
TheResult := TheResult + 'Nine ';
TheAmount := TheAmount - 9;
End;
IfTheAmount >= 8Then Begin
TheResult := TheResult + 'Eight ';
TheAmount := TheAmount - 8;
End;
IfTheAmount >= 7Then Begin
TheResult := TheResult + 'Seven ';
TheAmount := TheAmount - 7;
End;
IfTheAmount >= 6Then Begin
TheResult := TheResult + 'Six ';
TheAmount := TheAmount - 6;
End;
IfTheAmount >= 5Then Begin
TheResult := TheResult + 'Five ';
TheAmount := TheAmount - 5;
End;
IfTheAmount >= 4Then Begin
TheResult := TheResult + 'Four ';
TheAmount := TheAmount - 4;
End;
IfTheAmount >= 3Then Begin
TheResult := TheResult + 'Three ';
TheAmount := TheAmount - 3;
End;
IfTheAmount >= 2Then Begin
TheResult := TheResult + 'Two ';
TheAmount := TheAmount - 2;
End;
IfTheAmount >= 1Then 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);
IfTmpStr  = ''ThenTmpStr := 'Zero ';
RetVal    := TmpStr + 'cents';
IfIntVal > 0Then 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);
IfTmpStr <> ''Then
RetVal    := TmpStr + 'Thousand '+ RetVal;
{ миллионы }
TmpVal    := Round(Frac((IntVal * 1.0) / 1000.0) * 1000);
IntVal    := Trunc((IntVal * 1.0) / 1000.0);
TmpStr    := HundredAtATime(TmpVal);
IfTmpStr <> ''Then
RetVal    := TmpStr + 'Million '+ RetVal;
{ миллиарды }
TmpVal    := Round(Frac((IntVal * 1.0) / 1000.0) * 1000);
IntVal    := Trunc((IntVal * 1.0) / 1000.0);
TmpStr    := HundredAtATime(TmpVal);
IfTmpStr <> ''Then
RetVal    := TmpStr + 'Billion '+ RetVal;
Real2CheckAmount := RetVal;
end;


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

 
 
unitUnit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
num: TEdit;
spell: TEdit;
Button1: TButton;
procedureButton1Click(Sender: TObject);
private
{ Private declarations }
functiontrans9(num: integer): string;
functiontrans19(num: integer): string;
functiontrans99(num: integer): string;
functionIntToSpell(num: integer): string;
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
functionTForm1.IntToSpell(num: integer): string;
var
spell: string;
hspell: string;
hundred: string;
thousand: string;
tthousand: string;
hthousand: string;
million: string;
begin
ifnum &lg; 10then
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;
functionTForm1.trans99(num: integer): string;
var
spell: string;
begin
casenum 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;
functionTForm1.trans19(num: integer): string;
var
spell: string;
begin
casenum 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;
functionTForm1.trans9(num: integer): string;
var
spell : string;
begin
casenum 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;
procedureTForm1.Button1Click(Sender: TObject);
var
numb: integer;
begin
spell.text := IntToSpell(StrToInt(num.text));
end;
Lamer
Число строкой III

Вот еще одно решение, присланное читателем.

 
 
unitRoubleUnit;
{$D Пропись c Близнец Антон '99 http:\anton-bl.chat.rudelphi1001.htm }
{ 1000011.01->'Один миллион одинадцать рублей 01 копейка'               }
interface
FunctionRealToRouble(c:Extended):String;
implementation
usesSysUtils,math;
constMax000     =       6;{Кол-во триплетов - 000}
MaxPosition=Max000*3;{Кол-во знаков в числе }
//Аналог IIF в Dbase есть в proc.pas для основных типов, частично объявлена тут для независимости
functionIIF(i:Boolean;s1,s2:Char   ):Char   ;overload;begin ifi thenresult:=s1 elseresult:=s2 end;
functionIIF(i:Boolean;s1,s2:String):String;overload;begin ifi thenresult:=s1 elseresult:=s2 end;
FunctionNumToStr(s:String):String;{Возвращает число прописью}
Constc1000 :array[0..Max000]of string=(''   ,'тысяч','миллион','миллиард','триллион','квадраллион','квинтиллион');
c1000w:array[0..Max000]ofBoolean=(False,True   ,False    ,False     ,False     ,False        ,False        );
w:Array[False..True,'0'..'9']of String[3]=(('ов ',' ','а ','а ','а ','ов ','ов ','ов ','ов ','ов '),
(' ','а ','и ','и ','и ',' ',' ',' ',' ',' '));
functionNum000toStr(S:String;woman:Boolean):String;{Num000toStr возвращает число для триплета}
constc100:Array['0'..'9']of String=('','сто '   ,'двести '  ,'триста '  ,'четыреста ','пятьсот ','шестьсот ','семьсот '  ,'восемьсот '  ,'девятьсот ');
c10:Array['0'..'9']of String=('','десять ','двадцать ','тридцать ','сорок ','пятьдесят ','шестьдесят ','семьдесят ','восемьдесят ','девяносто ');
c11:Array['0'..'9']of String=('','один','две','три','четыр','пят','шест','сем','восем','девят');
c1:Array[False..True,'0'..'9']of String=(('','один ','два ','три ','четыре ','пять ','шесть ','семь ','восемь ','девять '),
('','одна ','две ','три ','четыре ','пять ','шесть ','семь ','восемь ','девять '));
begin{Num000toStr}
Result:=c100[s[1]]+iif((s[2]='1')and(s[3]>'0'),c11[s[3]]+'надцать ',c10[s[2]]+c1[woman,s[3]]);
end;{Num000toStr}
vars000:String[3];
isw,isMinus:Boolean;
i:integer;//Счётчик триплетов
Begin
Result:='';i:=0;
isMinus:=(s<>'') and(s[1]='-');
ifisMinus thens:=Copy(s,2,Length(s)-1);
while not((i>=Ceil(Length(s)/3))or(i>=Max000)) do
begin
s000:=Copy('00'+s,Length(s)-i*3,3);
isw:=c1000w[i];
if(i>0)and(s000<>'000') then//тысячи и т.д.
Result:=c1000[i]+w[Isw,iif(s000[2]='1','0',s000[3])]+Result;
Result:=Num000toStr(s000,isw)+Result;
Inc(i)
end;
ifResult=''thenResult:='ноль';
ifisMinus   thenResult:='минус '+Result;
End;{NumToStr}
FunctionRealToRouble(c:Extended):String;
Construble :array['0'..'9']of string[2]=('ей','ь','я','я','я','ей','ей','ей','ей','ей');
Kopeek:array['0'..'9']of string[3]=('ек','йка','йки','йки','йки','ек','ек','ек','ек','ек');
Functionending(consts:String):Char;
varl:Integer;//С l на 8 байт коротче $50->$48->$3F
begin//Возвращает индекс окончания
l:=Length(s);
Result:=iif((l>1) and(s[l-1]='1'),'0',s[l]);
end;
varrub:String[MaxPosition+3]; kop:String[2];
begin{Возвращает число прописью с рублями и копейками}
Str(c:MaxPosition+3:2,Result);
ifPos('E',Result)=0then//Если число можно представить в строке <>1E+99
begin
rub:=TrimLeft(Copy(Result,1,Length(Result)-3));
kop:=         Copy(Result,Length(Result)-1,2) ;
Result:=NumToStr(rub)+' рубл'+ ruble[ending(rub)]
+' '+    kop +' копе'+Kopeek[ending(kop)];
Result:=AnsiUpperCase(Result[1])+Copy(Result,2,Length(Result)-1);
end;
end;
end.
Lamer
Число строкой II

Нашлись умельцы работать с русским языком! Ниже я приведу письмо, пришедшее мне вскоре после опубликования предыдущего совета.
Валентин!
Только сегодня скачал и с удовольствием читаю Ваши "Советы". Дойдя до просьбы прислать русский вариант "Сумма прописью", выдрал эту процедуру из своей (старой, на Паскале, но до сих пор эксплуатирующейся) программы.
Александр

 
 
{------------------------ Деньги прописью ---------------------}
functionTextSum(S: double): string;
functionConv999(M: longint; fm: integer): string;
const
c1to9m: array[1..9] of string[6] =
('один','два','три','четыре','пять','шесть','семь','восемь','девять');
c1to9f: array[1..9] of string[6] =
('одна','две','три','четыре','пять','шесть','семь','восемь','девять');
c11to19: array[1..9] of string[12] =
('одиннадцать','двенадцать','тринадцать','четырнадцать','пятнадцать',
'шестнадцать','семнадцать','восемнадцать','девятнадцать');
c10to90: array[1..9] of string[11] =
('десять','двадцать','тридцать','сорок','пятьдесят','шестьдесят',
'семьдесят','восемьдесят','девяносто');
c100to900: array[1..9] of string[9] =
('сто','двести','триста','четыреста','пятьсот','шестьсот','семьсот',
'восемьсот','девятьсот');
var
s: string;
i: longint;
begin
s := '';
i := M div100;
ifi<>0then s:=c100to900[i]+' ';
M := M mod100;
i := M div10;
if(M>10) and(M<20) thens:=s+c11to19[M-10]+' '
else
begin
ifi<>0thens:=s+c10to90[i]+' ';
M := M mod10;
ifM<>0then
iffm=0thens:=s+c1to9f[M]+' '
elses:=s+c1to9m[M]+' ';
end;
Conv999 := s;
end;
{--------------------------------------------------------------}
var
i: longint;
j: longint;
r: real;
t: string;
begin
t := '';
j := Trunc(S/1000000000.0);
r := j;
r := S - r*1000000000.0;
i := Trunc®;
ifj<>0then
begin
t:=t+Conv999(j,1)+'миллиард';
j := j mod100;
if(j>10) and(j<20) thent:=t+'ов '
else
casej mod10of
0: t:=t+'ов ';
1: t:=t+' ';
2..4: t:=t+'а ';
5..9: t:=t+'ов ';
end;
end;
j := i div1000000;
ifj<>0then
begin
t:=t+Conv999(j,1)+'миллион';
j := j mod100;
if(j>10) and(j<20) thent:=t+'ов '
else
casej mod10of
0: t:=t+'ов ';
1: t:=t+' ';
2..4: t:=t+'а ';
5..9: t:=t+'ов ';
end;
end;
i := i mod1000000;
j := i div1000;
ifj<>0then
begin
t:=t+Conv999(j,0)+'тысяч';
j := j mod100;
if(j>10) and(j<20) thent:=t+' '
else
casej mod10of
0: t:=t+' ';
1: t:=t+'а ';
2..4: t:=t+'и ';
5..9: t:=t+' ';
end;
end;
i := i mod1000;
j := i;
ifj<>0thent:=t+Conv999(j,1);
t := t+'руб. ';
i := Round(Frac(S)*100.0);
t := t+Long2Str(i)+' коп.';
TextSum := t;
end;
Lamer
Число строкой I

Данный код "считает" до миллиона долларов. Поэкспериментируйте с ним - попробуйте "посчитать" до миллиарда, конвертировать ее в рубли или переделать ее для работы с русским языком. Только не забудьте прислатьмне ваши решения!

 
 
unituNum2Str;
// Possible enhancements
// Move strings out to resource files
// Put in a general num2str utility
interface
functionNum2Dollars( dNum: double ) : String;
implementation
usesSysUtils;
functionLessThan99( dNum: double ) : String; forward;
// floating point modulus
functionFloatMod( i,j: double ): double;
begin
result := i - (Int(i/j) * j);
end;
functionHundreds( dNum: double ) : String;
var
workVar: double;
begin
if( dNum < 100) or( dNum > 999) then
raiseException.Create( 'hundreds range exceeded');
result := '';
workVar := Int( dNum / 100);
ifworkVar > 0then
result := LessThan99(workVar) + ' Hundred';
end; functionOneToNine( dNum: Double ) : String;
begin
if( dNum < 1) or(dNum > 9) then
raiseexception.create( 'onetonine: value out of range');
result := 'woops';
ifdNum = 1thenresult := 'One'
else ifdNum = 2thenresult := 'Two'
else ifdNum = 3thenresult := 'Three'
else ifdNum = 4thenresult := 'Four'
else ifdNum = 5.0thenresult := 'Five'
else ifdNum = 6thenresult := 'Six'
else ifdNum = 7thenresult := 'Seven'
else ifdNum = 8thenresult := 'Eight'
else ifdNum = 9thenresult := 'Nine';
end;
functionZeroTo19( dNum: double ) : String;
begin
if(dNum < 0) or(dNum > 19) then
raiseException.Create( 'Bad value in dNum');
result := '';
ifdNum = 0thenresult := 'Zero'
else if(dNum <= 1) and(dNum >= 9) thenresult := OneToNine( dNum )
else ifdNum = 10thenresult := 'Ten'
else ifdNum = 11thenresult := 'Eleven'
else ifdNum = 12thenresult := 'Twelve'
else ifdNum = 13thenresult := 'Thirteen'
else ifdNum = 14thenresult := 'Fourteen'
else ifdNum = 15thenresult := 'Fifteen'
else ifdNum = 16thenresult := 'Sixteen'
else ifdNum = 17thenresult := 'Seventeen'
else ifdNum = 18thenresult := 'Eighteen'
else ifdNum = 19thenresult := 'Nineteen'
elseresult := 'woops!';
end;
functionTwentyTo99( dNum: double ) : String;
var
BigNum: String;
begin
if( dNum < 20) or( dNum > 99) then
raiseexception.Create( 'TwentyTo99: dNum out of range!');
BigNum := 'woops';
ifdNum >= 90thenBigNum := 'Ninety'
else ifdNum >= 80thenBigNum := 'Eighty'
else ifdNum >= 70thenBigNum := 'Seventy'
else ifdNum >= 60thenBigNum := 'Sixty'
else ifdNum >= 50thenBigNum := 'Fifty'
else ifdNum >= 40thenBigNum := 'Forty'
else ifdNum >= 30thenBigNum := 'Thirty'
else ifdNum >= 20thenBigNum := 'Twenty';
// lose the big num
dNum := FloatMod( dNum, 10);
ifdNum > 0.00then
result := BigNum + ' '+ OneToNine( dNum )
else
result := BigNum;
end;
functionLessThan99( dNum: double ) : String;
begin
ifdNum <= 19then
result := ZeroTo19(dNum)
else
result := TwentyTo99(dNum);
end;
functionNum2Dollars( dNum: double ) : String;
var
centsString: String;
cents: double;
workVar: double;
begin
result := '';
ifdNum < 0then
raiseException.Create( 'Negative numbers not supported');
ifdNum > 999999999.99then
raiseException.Create( 'Num2Dollars only supports up to the millions at this point!');
cents := (dNum - Int( dNum )) * 100.0;
ifcents = 0.0then
centsString := 'and 00/100 Dollars'
else ifcents < 10then
centsString := Format( 'and 0%1.0f/100 Dollars', [cents] )
else
centsString := Format( 'and %2.0f/100 Dollars', [cents] );
dNum := Int( dNum - (cents / 100.0) ); // lose the cents
// deal with million's
if(dNum >= 1000000) and( dNum <= 999999999) then
begin
workVar := dNum / 1000000;
workVar := Int( workVar );
if(workVar <= 9) then
result := ZeroTo19(workVar)
else if( workVar <= 99) then
result := LessThan99( workVar )
else if( workVar <= 999) then
result := Hundreds( workVar )
else
result := 'mill fubar';
result := result + ' Million';
dNum := dNum - ( workVar * 1000000);
end;
// deal with 1000's
if(dNum >= 1000) and( dNum <= 999999.99) then
begin
// doing the two below statements in one line of code yields some really
// freaky floating point errors
workVar := dNum/1000;
workVar := Int( workVar );
if(workVar <= 9) then
result := ZeroTo19(workVar)
else if( workVar <= 99) then
result := LessThan99( workVar )
else if( workVar <= 999) then
result := Hundreds( workVar )
else
result := 'thou fubar';
result := result + ' Thousand';
dNum := dNum - ( workVar * 1000);
end;
// deal with 100's
if(dNum >= 100.00) and(dNum <= 999.99) then
begin
result := result + ' '+ Hundreds( dNum );
dNum := FloatMod( dNum, 100);
end;
// format in anything less than 100
if( dNum > 0) or((dNum = 0) and(Length( result ) = 0)) then
begin
result := result + ' '+ LessThan99( dNum );
end;
result := result + ' '+ centsString;
end;
end.
This is a "lo-fi" version of our main content. To view the full version with more information, formatting and images, please click here.