Модераторы: Poseidon, Snowy, bems, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Преобразования, Преобразовать число в надпись 
:(
    Опции темы
RTV
Дата 17.1.2007, 12:34 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 53
Регистрация: 11.4.2006
Где: Днепропетровск

Репутация: нет
Всего: нет
Доброго дня Всем, подскажите как преобразовать число в надпись, например (2147, в "две тысячи сто сорок семь").
PM MAIL   Вверх
Yanis
Дата 17.1.2007, 12:40 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Участник Клуба
Сообщений: 2937
Регистрация: 9.2.2004
Где: Москва

Репутация: 72
Всего: 111
http://vingrad.ru/DELPHI-DLP-000230


--------------------
user posted image *щёлк*
PM MAIL WWW ICQ   Вверх
Akella
Дата 17.1.2007, 12:54 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Творец
****


Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329
суммы, гривны, короче на украинском языке
Код

Function TfmMain.DigitsByWords(x:String):String;
var i, l:Integer;
    a1:array[0..19] of String;
    b1:array[0..9] of String;
    c1:array[0..9,0..9] of String;
    d1:array[0..9] of String;
    s1:array[0..9] of String;
    xc, dr:string;
    f1:double;

Label L1;

begin
  a1[0]:='нуль';
  a1[1]:='один';
  a1[2]:='два';
  a1[3]:='три';
  a1[4]:='чотири';
  a1[5]:='п''ять';
  a1[6]:='шiсть';
  a1[7]:='сiм';
  a1[8]:='вiсiм';
  a1[9]:='дев''ять';
  a1[10]:='десять';
  a1[11]:='одинадцять';
  a1[12]:='дванадцять';
  a1[13]:='тринадцять';
  a1[14]:='чотирнадцять';
  a1[15]:='п''ятнадцять';
  a1[16]:='шiстнадцять';
  a1[17]:='сiмнадцять';
  a1[18]:='вісімнадцять';
  a1[19]:='дев''ятнадцять';
  b1[0]:='нуль';
  b1[1]:='одна';
  b1[2]:='дві';
  b1[3]:='три';
  b1[4]:='чотири';
  b1[5]:='п''ять';
  b1[6]:='шiсть';
  b1[7]:='сiм';
  b1[8]:='вiсiм';
  b1[9]:='дев''ять';
  c1[1,1]:='тисяча';
  c1[2,1]:='тисячі';
  c1[3,1]:='тисячі';
  c1[4,1]:='тисячі';
  c1[5,1]:='тисяч';
  c1[6,1]:='тисяч';
  c1[7,1]:='тисяч';
  c1[8,1]:='тисяч';
  c1[9,1]:='тисяч';
  c1[1,2]:='мільйон';
  c1[2,2]:='мільйона';
  c1[3,2]:='мільйона';
  c1[4,2]:='мільйона';
  c1[5,2]:='мільйонів';
  c1[6,2]:='мільйонів';
  c1[7,2]:='мільйонів';
  c1[8,2]:='мільйонів';
  c1[9,2]:='мільйонів';
  c1[1,3]:='міль''ярд';
  c1[2,3]:='міль''ярда';
  c1[3,3]:='міль''ярда';
  c1[4,3]:='міль''ярда';
  c1[5,3]:='міль''ярдів';
  c1[6,3]:='міль''ярдів';
  c1[7,3]:='міль''ярдів';
  c1[8,3]:='міль''ярдів';
  c1[9,3]:='міль''ярдів';
  s1[0]:='';
  s1[1]:='сто';
  s1[2]:='двісті';
  s1[3]:='триста';
  s1[4]:='чотириста';
  s1[5]:='п''ятсот';
  s1[6]:='шістьсот';
  s1[7]:='сімсот';
  s1[8]:='вісімсот';
  s1[9]:='дев''ятсот';
  d1[0]:='';
  d1[1]:='десять';
  d1[2]:='двадцять';
  d1[3]:='тридцять';
  d1[4]:='сорок';
  d1[5]:='п''ятдесят';
  d1[6]:='шістдесят';
  d1[7]:='сімдесят';
  d1[8]:='вісімдесят';
  d1[9]:='дев''яносто';
  f1:=StrToFloat(x);
  x:=FloatToStr(RoundTo(f1,-2));
  i:=Pos('.',x);
  if i=0 then
    i:=Pos(',',x);
  if i>0 then
  begin
    dr:=copy(x,i+1,length(x)-i+1);
    Delete(x,i,length(x)-i+1);
  end;

L1:

  L:=length(x);
  case L of
    1: begin
         if x<>'0' then
           xc:=xc+b1[StrToInt(x[1])];
       end;
    2: begin
        if x[1]='0' then
        begin
          Delete(x,1,1);
          if x<>'0' then
          begin
            if xc<>'' then xc:=xc+' ';
            goto L1;
          end
          else
            goto L1;
        end;
        if StrToInt(x)<20 then xc:=xc+a1[StrToInt(x)] else
        begin
          xc:=xc+d1[StrToInt(x[1])];
          Delete(x,1,1);
          if x<>'0' then
          begin
            xc:=xc+' ';
            goto L1;
          end;
        end;
       end;
    3: begin
         xc:=xc+s1[StrToInt(x[1])];
         Delete(x,1,1);
         if x[1]<>'0' then
         begin
           xc:=xc+' ';
           goto L1;
         end
         else
           goto L1;
       end;
    4: begin
         if x[1]='0' then
         begin
           Delete(x,1,1);
//           xc:=xc+'тысяч';
           goto L1;
         end;
         xc:=xc+b1[StrToInt(x[1])]+' '+c1[StrToInt(x[1]),1];
         Delete(x,1,1);
         if x[1]<>'0' then
           xc:=xc+' ';
         goto L1;
       end;
    5: begin
        if x[1]='0' then
        begin
          Delete(x,1,1);
          if x<>'0' then
          begin
            if xc<>'' then xc:=xc+' ';
            goto L1;
          end
          else
            goto L1;
        end;
        if StrToInt(x[1]+x[2])<20 then
        begin
          xc:=xc+a1[StrToInt(x[1]+x[2])]+' тисяч ';
          Delete(x,1,2);
          goto L1;
        end
        else
        begin
          xc:=xc+d1[StrToInt(x[1])];
          Delete(x,1,1);
          if x[1]<>'0' then
          begin
            xc:=xc+' ';
            goto L1;
          end
          else
          begin
            xc:=xc+' тисяч';
            Delete(x,1,1);
            goto L1;
          end;
        end;
       end;
    6: begin
         if x[1]='0' then
         begin
           Delete(x,1,1);
           goto L1;
         end;
         if x[1]<>'0' then
           xc:=xc+s1[StrToInt(x[1])];
           if StrToInt(x[2]+x[3])=0 then
           begin
             xc:=xc+' тисяч';
             Delete(x,1,3);
           end;
           Delete(x,1,1);
         if x[1]<>'0' then
         begin
           xc:=xc+' ';
           goto L1;
         end
         else
           goto L1;
       end;
    7: begin
         xc:=xc+a1[StrToInt(x[1])]+' '+c1[StrToInt(x[1]),2];
         Delete(x,1,1);
           xc:=xc+' ';
         goto L1;
       end;
    8: begin
        if x[1]='0' then
        begin
          Delete(x,1,1);
          if x<>'0' then
          begin
            if xc<>'' then xc:=xc+' ';
            goto L1;
          end
          else
            goto L1;
        end;
        if StrToInt(x[1]+x[2])<20 then
        begin
          xc:=xc+a1[StrToInt(x[1]+x[2])]+' мільйонів';
          Delete(x,1,2);
          if StrToInt(x)<>0 then
          begin
            xc:=xc+' ';
            goto L1;
          end;
        end
        else
        begin
          xc:=xc+d1[StrToInt(x[1])];
          Delete(x,1,1);
          if x[1]<>'0' then
          begin
            xc:=xc+' ';
            goto L1;
          end
          else
          begin
            xc:=xc+' мільйонів';
            Delete(x,1,1);
            if StrToInt(x)<>0 then
            begin
              xc:=xc+' ';
              goto L1;
            end;
          end;
        end;
       end;
    9: begin
         if x[1]='0' then
         begin
           Delete(x,1,1);
           goto L1;
         end;
         if x[1]<>'0' then
           xc:=xc+s1[StrToInt(x[1])];
           if StrToInt(x[2]+x[3])=0 then
           begin
             xc:=xc+' мільйонів';
             Delete(x,1,3);
           end;
           Delete(x,1,1);
         if x[1]<>'0' then
         begin
           xc:=xc+' ';
           goto L1;
         end
         else
           goto L1;
       end;

  end; {case}
  if Length(dr)=0 then dr:='00';
  if Length(dr)=1 then dr:=dr+'0';

  result := xc + ' грн. ' + dr + ' коп.';
end;


Это сообщение отредактировал(а) Akella - 17.1.2007, 13:32
PM MAIL   Вверх
Dremlin
Дата 17.1.2007, 13:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Quo vadis?
*


Профиль
Группа: Участник
Сообщений: 157
Регистрация: 21.9.2006
Где: Киев

Репутация: нет
Всего: 4
Akella,  smile ! Но: сходу обнаружил два небольших косяка:

1.
Код

d1[5]:='пятдесят'; //наверное все-таки 'п''ятдесят'

2.
Код

    9: begin
         if x[1]='0' then
         begin
           Delete(x,1,1);
           goto L1;
         end;
         if x[1]<>'0' then
           xc:=xc+s1[StrToInt(x[1])];
           if StrToInt(x[2]+x[3])=0 then
           begin
             xc:=xc+' тисяч'; //тут нужно ' мільйонів'
             Delete(x,1,3); //а тут Delete(x,1,2);
           end;
           Delete(x,1,1);
         if x[1]<>'0' then
         begin
           xc:=xc+' ';
           goto L1;
         end
         else
           goto L1;
       end;

--------------------
Каждый дурак знает, что до звезд не достать, а умные, не обращая внимания на дураков, пытаются...
PM MAIL   Вверх
Akella
Дата 17.1.2007, 13:25 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Творец
****


Профиль
Группа: Модератор
Сообщений: 18485
Регистрация: 14.5.2003
Где: Корусант

Репутация: 36
Всего: 329
возможно, не спорю

Добавлено @ 13:32 
ща отредактирую, предыдущий пост

Добавлено @ 13:33 
теперь вроде порядок
PM MAIL   Вверх
RTV
Дата 18.1.2007, 21:10 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Шустрый
*


Профиль
Группа: Участник
Сообщений: 53
Регистрация: 11.4.2006
Где: Днепропетровск

Репутация: нет
Всего: нет
Всем спасибо за консультацию.
PM MAIL   Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0499 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.