Вернуться   CoderX :: Forums > Основные форумы > Программинг
Войти через OpenID

Программинг Форум для тем связанных с программированием

Чат (Новых сообщений с момента вашего последнего визита нет)
Загрузка...
Задавайте ваши вопросы на форуме. Чат предназначен для небольших разговоров.
 
 
 
Опции темы Опции просмотра
Старый 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 нажился спасибкой от:
 

  CoderX :: Forums > Основные форумы > Программинг



Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.


Часовой пояс GMT +4, время: 07:43.

vBulletin style designed by MSC Team.
Powered by vBulletin® Version 3.6.11
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd. Перевод: zCarot
Locations of visitors to this page
Rambler's Top100

Вы хотите чувствовать себя в безопасности? чоп Белган обеспечит её!