unit UkrRecog;
{копирайт непомню чей. Был для русских циферок, а я переделал под
украинские}
{если кто что найдет пришлите
}
{by Andrew Tkachenko, <a href="mailto:proektwo@netcity.ru">proektwo@netcity.ru</a>, 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.