Показать сообщение отдельно
Старый 02.04.2010, 21:34   #7
Местный
 
Аватар для J-Fobos
 
Регистрация: 09.06.2008
Сообщений: 867
Сказал Спасибо: 175
Имеет 468 спасибок в 259 сообщенях
J-Fobos пока неопределено
По умолчанию

У меня тоже когда то была надобность в таком коде. Пару лет уже прошло, но получилось найти его у себя в записях. Код не мой, но где нашел уже не помню, автора к сожалению указать не могу.
Код легко расширяется под любые диапазоны чисел.
Код:
const
  Mas1: array['0'..'9', 1..3] of string =
  (('', '', ''),
    ('сто ', '', 'один '),
    ('двести ', 'двадцать ', 'два '),
    ('триста ', 'тридцать ', 'три '),
    ('четыреста ', 'сорок ', 'четыре '),
    ('пятьсот ', 'пятьдесят ', 'пять '),
    ('шестьсот ', 'шестьдесят ', 'шесть '),
    ('семьсот ', 'семьдесят ', 'семь '),
    ('восемьсот ', 'восемьдесят ', 'восемь '),
    ('девятьсот ', 'девяносто ', 'девять '));
  Mas2: array['0'..'9'] of string =
  ('десять ', 'одиннадцать ', 'двенадцать ', 'тринадцать ',
    'четырнадцать ', 'пятнадцать ', 'шестнадцать ', 'семнадцать ',
    'восемнадцать ', 'девятнадцать ');
  Mas3: array['1'..'2'] of string = ('одна ', 'две ');
  Mas4: array['0'..'9', 1..4] of string =
  (('', 'тысяч ', 'миллионов ', 'миллиардов '),
    ('', 'тысяча ', 'миллион ', 'миллиард '),
    ('', 'тысячи ', 'миллиона ', 'миллиарда '),
    ('', 'тысячи ', 'миллиона ', 'миллиарда '),
    ('', 'тысячи ', 'миллиона ', 'миллиарда '),
    ('', 'тысяч ', 'миллионов ', 'миллиардов '),
    ('', 'тысяч ', 'миллионов ', 'миллиардов '),
    ('', 'тысяч ', 'миллионов ', 'миллиардов '),
    ('', 'тысяч ', 'миллионов ', 'миллиардов '),
    ('', 'тысяч ', 'миллионов ', 'миллиардов '));

function GetRepresentationInWords(S: string): string;
var
  i: Byte;
  Str: PChar;
begin

  Result := '';
  if S = '' then
    Exit;
  for i := 1 to Length(S) do
    if S[i] <> '0' then
      Break;
  if i = Length(S) + 1 then
  begin
    Result := 'Ноль';
    Exit
  end;
  Str := @S[1];
  while Length(S) mod 3 <> 0 do
    Insert('0', S, 1);
  for i := Length(S) div 3 downto 1 do
  begin
    if (Str[0] = '0') and (Str[1] = '0') and (Str[2] = '0') then
    begin
      Inc(Str, 3);
      Continue;
    end;
    Result := Result + Mas1[Str[0], 1];
    if Str[1] = '1' then
      Result := Result + Mas2[Str[2]] + Mas4['0', i]
    else
    begin
      Result := Result + Mas1[Str[1], 2];
      if (i = 2) and (Str[2] in ['1'..'2']) then
        Result := Result + Mas3[Str[2]]
      else
        Result := Result + Mas1[Str[2], 3];
      Result := Result + Mas4[Str[2], i];
    end;
    Inc(Str, 3)
  end;
  SetLength(Result, Length(Result) - 1)

end;
Ну и пример использования
Код:
Memo1.Lines.Text := GetRepresentationInWords(IntToStr(2006));
зы: на с++ думаю переделать проблемы не составит?)
__________________

В любом из нас спит гений. И с каждым днем все крепче.

Переходим на протокол нового поколения jabber

Последний раз редактировалось J-Fobos, 02.04.2010 в 21:37.
J-Fobos вне форума   Ответить с цитированием
За это сообщение J-Fobos нажился спасибкой от: