Число украинской строкой

=== Число украинской строкой ===
unit UkrRecog;
{ копирайт непомню чей. Был для русских циферок, а я переделал под
украинские
если кто что найдет пришлите
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
ООО "Проект ВО"
Украина, г.Харьков
Сборник Kuliba
Author: Andrew Tkachenko
Source: Взято из Советов по Delphi от Валентина Озерова
ID: 00216