Inc(i) // формування стрічки-числа з вихідною основою
until v = 0;
SetLength(ResultStr,i-1);
p := Length(ResultStr);
RadixChar:=Copy(ResultStr,0,p);
for i := 1 to p do ResultStr[i]:= RadixChar[p-i+1];
// обернення стрічки
end;
end;
end.
3) unit UkrRecog;
{by Andrew Tkachenko, proektwo@netcity.ru, Ukraine}
// Перевід цілого числа в словесну форму
interface
Const
UkrMonthString : array[1..12] of string[9] = (
'січня', 'лютого', 'березня', 'квiтня', 'травня',
'червня', 'липня', 'серпня', 'вересня', 'жовтня',
'листопада','грудня');
Function UkrRecognizeAmount(Amount:real):string;
implementation
Uses Sysutils;
Function UkrRecognizeAmount(Amount:real):string;
{Распознаетсячисло <= 999 999 999 999.99*}
const suffBL:string=' ';
suffDCT:string='дцять';
suffNA:string='надцять ';
suffDCM:string='десят';
suffMZ:string='ь';
sot:string='сот';
st:string='ст';
aa:string='а';
ee:string='и'; {e}
ii:string='і'; {и}
oo:string='о';
ov:string='ів';{ов}
C2:string='дв';
C3:string='тpи';
C4:string='чотир';
C5:string='п''ят';
C6:string='шіст';
C7:string='сім';
C8:string='вісім';
C9:string='дев''ят';
var
i:byte;
sAmount,sdInt,sdDec:string;
IsMln,IsTha{,IsDcm},IsRange1019:boolean;
currNum,endMlx,sResult:string;
begin
if (amount<0)or(amount>999999999999.99) then
begin
Result:='<<<< Помилкавдіапазоні >>>>';
Exit;
end;
if amount=0 then
begin
Result:='Нуль';
Exit;
end;
STR(Amount:16:2,sAmount);
sdInt:=Copy(sAmount,1,13);
sdDec:=Copy(sAmount,15,2);
IsMln:=false;
IsTha:=false;
IsRange1019:=false;
sResult:='';
for i:=1 to 13 do
begin
currNum:=Copy(sdInt,i,1);
if currNum<>suffBL then
begin
case i of
5,6, 7:if currNum<>'0' then IsMln:=true;
8,9,10:if currNum<>'0' then IsTha:=true;
end;
if i IN [2,5,8,11] then {сотні}
begin
if currNum='1' then sResult:=sResult+st+oo+suffBL;
if currNum='2' then sResult:=sResult+C2+ii+st+ii+suffBL;
if currNum='3' then sResult:=sResult+C3+st+aa+suffBL;
if currNum='4' then sResult:=sResult+C4+ee+st+aa+suffBL;
if currNum='5' then sResult:=sResult+C5+sot+suffBL;
if currNum='6' then sResult:=sResult+C6+sot+suffBL;
if currNum='7' then sResult:=sResult+C7+sot+suffBL;
if currNum='8' then sResult:=sResult+C8+sot+suffBL;
if currNum='9' then sResult:=sResult+C9+sot+suffBL;
end;
if i IN [3,6,9,12] then{десятки}
begin
if currNum='1' then IsRange1019:=true;
if currNum='2' then sResult:=sResult+C2+aa+suffDCT+suffBL;
if currNum='3' then sResult:=sResult+C3+suffDCT+suffBL;
if currNum='4' then sResult:=sResult+'соpок ';
if currNum='5' then
sResult:=sResult+C5+suffMZ+suffDCM+suffBL;
if currNum='6' then
sResult:=sResult+C6+suffMZ+suffDCM+suffBL;
if currNum='7' then
sResult:=sResult+C7+suffMZ+suffDCM+suffBL;
if currNum='8' then
sResult:=sResult+C8+suffMZ+suffDCM+suffBL;
if currNum='9' then
sResult:=sResult+'дев''ян'+oo+st+oo+suffBL;
end;
if i in [4,7,10,13] then {одиниці}
begin
if (currNum='0') then
if IsRange1019 then sResult:=sResult+suffDCM+suffMZ+suffBL;
if (currNum='1') then
begin
if (i=13)and(not IsRange1019) then sResult:=sResult+'один '
elsebegin
if (i=10)and(IsRange1019) then sResult:=sResult+'оди'
else
if (i=10)and(not IsRange1019) then sResult:=sResult+'один '
else
sResult:=sResult+'один'{ин};
if IsRange1019 and (i=13) then
sResult:=sResult+'адцять'+suffBL
else
if IsRange1019 then sResult:=sResult+suffNA
else sResult:=sResult+suffBL;
end;
end;
if (currNum='2') then
begin
sResult:=sResult+C2;
if (i=10)and(IsRange1019=False) then sResult:=sResult+ii
else
if (i=10)or(IsRange1019) then sResult:=sResult+aa
else sResult:=sResult+{aa}ii;
if IsRange1019 then sResult:=sResult+suffNA
else sResult:=sResult+suffBL;
end;
if (currNum='3') then
begin
sResult:=sResult+C3;
if IsRange1019 then sResult:=sResult+suffNA
else sResult:=sResult+suffBL;
end;
if (currNum='4') then
begin
sResult:=sResult+C4;
if IsRange1019 then sResult:=sResult+suffNA
else sResult:=sResult+ee+suffBL;
end;
if (currNum='5') then
begin
sResult:=sResult+C5;
if IsRange1019 then sResult:=sResult+suffNA
else sResult:=sResult+suffMZ+suffBL;
end;
if (currNum='6') then
begin
sResult:=sResult+C6;
if IsRange1019 then sResult:=sResult+suffNA
else sResult:=sResult+suffMZ+suffBL;
end;
if (currNum='7') then
begin
sResult:=sResult+C7;
if IsRange1019 then sResult:=sResult+suffNA
else sResult:=sResult+suffBL;
end;
if (currNum='8') then
begin
sResult:=sResult+C8;
if IsRange1019 then sResult:=sResult+suffNA
else sResult:=sResult+suffBL;
end;
if (currNum='9') then
begin
sResult:=sResult+C9;
if IsRange1019 then sResult:=sResult+suffNA
else sResult:=sResult+suffMZ+suffBL;
end;
end;
endMlx:='';
case i of
4:begin
if IsRange1019 then endMlx:=ov+suffBL else
if currNum='1' then endMlx:=suffBL else
if (currNum='2')or(currNum='3')or(currNum='4') then
endMlx:=aa+suffBL else endMlx:=ov+suffBL;
sResult:=sResult+'мiльярд'+endMlx;
end;
7:if IsMln then
begin
if IsRange1019 then endMlx:=ov+suffBL else
if currNum='1' then endMlx:=suffBL else
if (currNum='2')or(currNum='3')or(currNum='4') then
endMlx:=aa+suffBL else endMlx:=ov+suffBL;
sResult:=sResult+'мiльйон'+endMlx;
end;
10:if IsTha then
begin
if IsRange1019 then endMlx:=suffBL else
if currNum='1' then endMlx:=aa+suffBL else
if (currNum='2')or(currNum='3')or(currNum='4') then
endMlx:=ii+suffBL else endMlx:=suffBL;
sResult:=sResult+'тисяч'+endMlx;
end;
end;{case}
if i IN [4,7,10,13] then IsRange1019:=false;
end;{IF}
end;{FOR}
Result:= copy(sResult,0,length(sResult)-1);
if Result[length(Result)]='ь' then SetLength(Result, length(Result)-1);
end;
end.