Число украинской строкой
unitUkrRecog;
{копирайт непомню чей. Был для русских циферок, а я переделал под
украинские}
{если кто что найдет пришлите
}
{by Andrew Tkachenko, proektwo@netcity.ru, Ukraine,
}
interface
const
UkrMonthString:
array[1..12]
of string[9] = (
'січня', 'лютого', 'березня', 'квiтня', 'травня',
'червня', 'липня', 'серпня', 'вересня', 'жовтня',
'листопада', 'грудня');
function UkrRecognizeAmount(Amount: real;
CurrName, CurrSubname:
string):
string;
implementation
uses Sysutils;
function UkrRecognizeAmount(Amount: real;
CurrName, CurrSubname:
string):
string;
{* CurrName in [грн.]
CurrSubName in [коп.]
Распознается число <= 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;
STR(Amount: 16: 2, sAmount);
sdInt := Copy(sAmount, 1, 13);
sdDec := Copy(sAmount, 15, 2);
IsMln := false;
//IsDcm:=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 + 'одна '
else
begin
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}
sResult := sResult + CurrName + ',' + suffBL + sdDec + suffBL + CurrSubname;
sResult := AnsiUpperCase(sResult[1]) + Copy(sResult, 2, length(sResult) - 1);
Result := sResult;
end;
end.
С уважением,
Andrew Tkachenko
ООО "Проект ВО"
Украина, г.Харьков
Взято из
Советов по Delphi от
Сборник Kuliba
Содержание Назад Вперед
Forekc.ru
Рефераты, дипломы, курсовые, выпускные и квалификационные работы, диссертации, учебники, учебные пособия, лекции, методические пособия и рекомендации, программы и курсы обучения, публикации из профильных изданий