Сумма прописью

Комментарии

• tinkov Киев

  February 2004 отредактировано 06:26

  Лови
  
  function digit2str(Value: integer; m: boolean): string;
  const
  
  MAX3 = 5; {Максимальное количество триад}
  
  A11: array[1..2] of string[20] = ('одна ', 'две ');
  
  A1: array[0..19] of string [20] = ('', 'один ', 'два ', 'три ', 'четыре ',
  'пять ', 'шесть ', 'семь ', 'восемь ', 'девять ', 'десять ', 'одиннадцать ',
  'двенадцать ', 'тринадцать ', 'четырнадцать ', 'пятнадцать ',
  'шестнадцать ', 'семнадцать ', 'восемнадцать ', 'девятнадцать ');
  A10: array[0..9] of string [20] = ('', 'десять ', 'двадцать ', 'тридцать ',
  'сорок ', 'пятьдесят ', 'шестьдесят ', 'семьдесят ', 'восемьдесят ', 'девяносто ');
  
  A100: array[0..9] of string[20] = ('', 'сто ', 'двести ', 'триста ',
  'четыреста ', 'пятьсот ', 'шестьсот ', 'семьсот ', 'восемьсот ', 'девятьсот ');
  
  {четвертым параметром является обозначение мужского или женского рода,
  
  где '0' - женский род;
  '1' - мужской род.
  
  Это дает возможность, например, изменяя "рубли" на "штуки" просто поменять '1' на '0' не меняя кода.}
  A0: array[0..MAX3 - 1, 0..3] of string[20] = (('гривна', 'гривні', 'гривен', '0'),
  ('тысяча ', 'тысячи ', 'тысяч ', '0'), ('миллион ', 'миллиона ', 'миллионов ', '1'),
  ('миллиард ', 'миллиарда ', 'миллиардов ', '1'),
  ('триллион ', 'триллиона ', 'триллионов', '1'));
  var
  i100, i10, i1: integer;
  V, p, n: integer;
  a, s: string;
  begin
  try
  s := '';
  n := 0;
  {ѕСаРСЮвЪР ЮваШжРвХЫмЭЮУЮ ЧЭРзХЭШп Ш ЭгЫп}
  if Value < 0 then
  begin
  s := s + 'ЬШЭгб';
  Value := -Value;
  end
  else if Value = 0 then s := s + 'ЭЮЫм'
  else
  s := s + '';
  repeat
  {АРЧСШТЪР ЭР ваШРФл б ЪЮЭжР}
  V := Value mod 1000;
  Value := Value div 1000;
  {ѕСаРСЮвЪР}
  if (V > 0) or (n = 0) then
  begin
  i100 := V div 100;
  V := V - (i100 * 100);
  if V >= 20 then
  begin
  i1 := V mod 10;
  V := V div 10;
  i10 := V mod 10;
  end
  else
  begin
  i1 := V;
  i10 := 0;
  end;
  case i1 of
  1: p := 0;
  2..4: p := 1;
  else
  p := 2;
  end;
  {ёЧЬХЭХЭШХ Т ЧРТШбШЬЮбвШ Юв ЦХЭбЪЮУЮ ШЫШ ЬгЦбЪЮУЮ аЮФР}
  if m then
  begin
  if (A0[n, 3] = '0') and ((i1 = 1) or (i1 = 2)) then
  insert(A100[i100] + A10[i10] + A11[i1] + A0[n, p], s, 0)
  else
  insert(A100[i100] + A10[i10] + A1[i1] + A0[n, p], s, 0);
  end
  else
  begin
  if (A0[n, 3] = '0') and ((i1 = 1) or (i1 = 2)) then
  insert(A100[i100] + A10[i10] + A11[i1]{+A0[n,p]}, s, 0)
  else
  insert(A100[i100] + A10[i10] + A1[i1]{+A0[n,p]}, s, 0);
  end;
  end;
  Inc(n);
  {їаЮТХаЪР ТлеЮФР ЧР ЬРЪбШЬРЫмЭЮХ ЪЮЫШзХбвТЮ ваШРФ}
  if n > MAX3 then Exit;
  until Value <= 0;
  except
  s := 'Ошибка при переводе числа';
  end;
  a := s[1];
  a := AnsiUpperCase(a);
  S[1] := a[1];
  Result := s;
  end;
  
  
• StasK

  February 2004 отредактировано 06:26

  Спасибо !!!