Запись числа прописью в FastReport

{
перевод на язык паскаля для Фаст Репорта
Наумов Денис
ICQ 368-254-335
mailTo denis-naymov1985@mail.ru
for my web NetSoftWare.Ucoz.ru
основна
http://delphiworld.narod.ru/base/sum_written_out7.html
  
{Пропись © Близнец Антон '99 http:\\anton-bl.chat.ru\delphi\1001.htm }
{ 1000011.01->'Один миллион одинадцать рублей 01 копейка'      
}

const
  Max000 = 6; {Кол-во триплетов - 000}
  MaxPosition = Max000 * 3; {Кол-во знаков в числе }
  var

    c100: array[0..9] of string;
    c11: array[0..9] of string;
    c10: array[0..9] of string;
    c1: array[0..1, 0..9] of string;
    c1000w: array[0..Max000] of integer;
    c1000:array[0..Max000] of string;
    w:array[0..1, 0..9] of string;
    ruble: array[0..9] of string;
    Kopeek: array[0..9] of string;


procedure initalize;
begin
       c1000[0]:='';
       c1000[1]:='тисяч';
       c1000[2]:='мільйон';
       c1000[3]:='мільярд';
       c1000[4]:='трильйон';
       c1000[5]:='квадралліон';
       c1000[6]:='квінтильйон';

       c1000w[0]:=0;
       c1000w[1]:=1;
       c1000w[2]:=0;
       c1000w[3]:=0;
       c1000w[4]:=0;
       c1000w[5]:=0;
       c1000w[6]:=0;

       w[0,0]:='ів ';
       w[0,1]:=' ';
       w[0,2]:='а ';
       w[0,3]:='а ';
       w[0,4]:='а ';
       w[0,5]:='ів ';
       w[0,6]:='ів ';
       w[0,7]:='ів ';
       w[0,8]:='ів ';
       w[0,9]:='ів ';
       w[1,0]:=' ';
       w[1,1]:='а ';
       w[1,2]:='і ';
       w[1,3]:='і ';
       w[1,4]:='і ';
       w[1,5]:=' ';
       w[1,6]:=' ';
       w[1,7]:=' ';
       w[1,8]:=' ';
       w[1,9]:=' ';
     c100[0]:='';
     c100[1]:='сто ';
     c100[2]:='двісті ';
     c100[3]:='триста ';
     c100[4]:='чотириста ';
     c100[5]:='п’ятсот ';
     c100[6]:='шістсот ';
     c100[7]:='сімсот ';
     c100[8]:='вісімсот ';
     c100[9]:='дев’ятсот ';

      c10[0]:='';
      c10[1]:='десять ';
      c10[2]:='двадцять ';
      c10[3]:='тридцять ';
      c10[4]:='сорок ';
      c10[5]:='п’ятдесят ';
      c10[6]:='шістдесят ';
      c10[7]:='сімдесят ';
      c10[8]:='вісімдесят ';
      c10[9]:='дев’яносто ';

      c11[0]:='';
      c11[1]:='один';
      c11[2]:='дві';
      c11[3]:='три';
      c11[4]:='чотир';
      c11[5]:='п’ят';
      c11[6]:='шіст';
      c11[7]:='сім';
      c11[8]:='вісім';
      c11[9]:='дев’ят';


      c1[0,0]:='';
      c1[0,1]:='один ';
      c1[0,2]:='два ';
      c1[0,3]:='три ';
      c1[0,4]:='чотири ';
      c1[0,5]:='п’ять ';
      c1[0,6]:='шість ';
      c1[0,7]:='сім ';
      c1[0,8]:='вісім ';
      c1[0,9]:='дев’ять ';

      c1[1,0]:='';
      c1[1,1]:='одна ';
      c1[1,2]:='дві ';
      c1[1,3]:='три ';
      c1[1,4]:='чотири ';
      c1[1,5]:='п’ять ';
      c1[1,6]:='шість ';
      c1[1,7]:='сім ';
      c1[1,8]:='вісім ';
      c1[1,9]:='дев’ять ';

      ruble[0]:='ень';
      ruble[1]:='ня';
      ruble[2]:='ні';
      ruble[3]:='ень';
      ruble[4]:='ні';
      ruble[5]:='ень';
      ruble[6]:='ень';
      ruble[7]:='ень';
      ruble[8]:='ень';
      ruble[9]:='ень';

      Kopeek[0]:='ок';
      Kopeek[1]:='ка';
      Kopeek[2]:='ки';
      Kopeek[3]:='ки';
      Kopeek[4]:='ки';
      Kopeek[5]:='ок';
      Kopeek[6]:='ок';
      Kopeek[7]:='ок';
      Kopeek[8]:='ок';
      Kopeek[9]:='ок';




end;

function Ceil(const X: Extended): Integer;
begin
  Result:=(Trunc(X));
  if Frac(X) > 0 then
    Inc(Result);
end;

Function IIF2( bln:boolean; TruePart:string; FalsePart:string):string;
begin
  if bln then
    Result := TruePart
  else
    Result := FalsePart;

end;

  function Num000toStr(S: string; woman: integer): string;
    {Num000toStr возвращает число для триплета}

  begin {Num000toStr}
    Result:= c100[ord(s[1])-ord('0')] + iif2((s[2] = '1') and (s[3] > '0'), c11[ord(s[3])-ord('0')] +
      'надцать ', c10[ord(s[2])-ord('0')] + c1[woman, ord(s[3])-ord('0')]);
  end; {Num000toStr}

function NumToStr(s: string): string; {Возвращает число прописью}
var
  s000: string;

  isMinus: Boolean;
  isw:integer;
  i: integer; //Сч?тчик триплетов
begin

  Result := '';
  i := 0;
   isMinus := (s <> '') and (s[1] = '-');

  if isMinus then
    s := 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, strtoint(iif2(s000[2] = '1', '0', s000[3]))] + Result;
    Result := Num000toStr(s000, isw) + Result;
    Inc(i)
  end;
  if Result = '' then
    Result := 'ноль';
  if isMinus then
    Result := 'минус ' + Result;
end; {NumToStr}

function TrimLeft(const S: string): string;
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and (S[i] <= ' ') do Inc(I);
  Result := Copy(S, I, 32565555);
end;

function RealToRouble(c: Extended): string;


  function ending(const s: string): Char;
  var
    l: Integer; //С l на 8 байт коротче $50->$48->$3F
  begin //Возвращает индекс окончания

    l := Length(s);
     if(l > 1) and (s[l-1]='1') then
     result:='0'
    else
    result:=s[l];

  end;

var
  rub: string;
  kop: string;
  h,x:integer;
begin {Возвращает число прописью с рублями и копейками}

  Result:=formatfloat('0.00',c);
  h:=length(Result);
  for X:=h to 18 do Result:=' '+Result;
  //Str(c: MaxPosition + 3: 2, Result);

  if Pos('E', Result) = 0 then //Если число можно представить в строке <>1E+99
  begin
    rub := TrimLeft(Copy(Result, 1, Length(Result) - 3));
    kop := Copy(Result, Length(Result) - 1, 2);
    Result := NumToStr(rub) + ' грив'+ruble[strtoint(ending(rub))]
      + ' ' + kop + ' копій' + Kopeek[strtoint(ending(kop))];
    Result := UpperCase(Result[1]) + Copy(Result, 2, Length(Result) - 1);

  end;
end;
function GetSummaToText(r:real):string;
begin
initalize;
result:=RealToRouble(r);
end;
  
begin
   memo1.lines.text:=GetSummaToText(125159256458359.44);
end.