Работа с целыми числами Опции

[Тома]

Товарищи, выручайте! Есть такая задачка:
С клавы вводят число (n>0). Нужно создать программу, выводящую фразу:"...Эти порядки существовали n лет". n изменяется на год. года в соответствии с нормами русского языка. Заранее большое спасибо!

М

не надо постить свои вопросы в чужие темы ! klem4

М

to klem4: спасибо что не удалил просто... а то бы мне нечего вечермо делать было Altair

[Altair]

Ну вот я покалякал...
работает с миллионами включая... если надо дальше то в прогу внести совсем немного добавления..

{$mode delphi}
uses STACK;
const

{t :array[1..9] of string = ('один',
                             'два',
                             'три',
                             'четыре',
                             'пять',
                             'шесть',
                             'семь',
                             'восемь',
                             'девять' );
}
 t :array[1..9] of string = ('®¤Ё­',
                             '¤ў ',
                             'ваЁ',
                             'зҐвлаҐ',
                             'Їпвм',
                             'иҐбвм',
                             'ᥬм',
                             'ў®бҐ¬м',
                             '¤Ґўпвм' );
{
_sti='сти';
_sta='ста';
_sot='сот';
_sto='сто';
_dcat='дцать';
_sorok='сорок';
_des9t='десят';
_no='яно';
_tis9ch='тысяч';
_milliona='миллиона';
_ov='ов';
_a='а';
_i='и';
_mz='ь';
_nadzat='надцать' ;
}
_sti='бвЁ';
_sta='бв ';
_sot='б®в';
_sto='бв®';
_dcat='¤ж вм';
_sorok='б®а®Є';
_des9t='¤Ґбпв';
_no='п­®';
_tis9ch='влбпз';
_milliona='¬Ё««Ё®­ ';
_ov='®ў';
_a=' ';
_i='Ё';
_mz='м';
_nadzat='­ ¤ж вм';


function strtoint(s:string):integer;
var
 r,code:integer;
begin
 val(s,r,code);
 strtoint:=r;
end;


procedure inttowords(N:integer);
var
 ST:     TSTACK;

         procedure print3cintscack(s:string;r:integer);
         var j:integer; res:string;
         begin
          res:='';
          if s<>'' then begin
             if s[1]<>'0' then begin
              if strtoint(s[1])=1 then res:=_sto+' ';
              if strtoint(s[1])=2 then res:=t[strtoint(s[1])]+_sti+' ';
              if (strtoint(s[1])>=3) and (strtoint(s[1])<=4) then res:=t[strtoint(s[1])]+_sta+' ';
              if strtoint(s[1])>=5 then res:=t[strtoint(s[1])]+_sot+' ';
             end;
             if s[2]<>'0' then begin
              if (strtoint(s[2])=1) then begin
               if s[3]='0' then res:=res+_des9t+_mz+' ';
               if s[3]>='1' then begin
                if s[3]='2' then res:=res+copy(t[strtoint(s[3])],1,length(t[strtoint(s[3])])-1)+'e'+_nadzat+' '; {!!!!!!!!!e}
                if s[3]='3' then res:=res+copy(t[strtoint(s[3])],1,length(t[strtoint(s[3])]))+_nadzat+' ';
                if (s[3]>='4') or (s[3]='1') then res:=res+copy(t[strtoint(s[3])],1,length(t[strtoint(s[3])])-1)+_nadzat+' ';
               end;
              end;

              if (strtoint(s[2])>=2) and (strtoint(s[2])<=3) then  res:=res+t[strtoint(s[2])]+_dcat+' ';
              if (strtoint(s[2])=4) then  res:=res+_sorok+' ';
              if (strtoint(s[2])>=5) and (strtoint(s[2])<9)  then  res:=res+t[strtoint(s[2])]+_des9t+' ';
              if (strtoint(s[2])=9) then res:=res+ copy(t[strtoint(s[2])],1,3)+_no+_sto+' ';
             end;
             if (s[3]<>'0') and (s[2]<>'1') then res:=res+t[strtoint(s[3])];
             case r of
              2: begin
                  if s[3]='1' then  begin  res:=res+' '+_tis9ch+_a+' ';   end;
                  if (s[3]>='2') and (s[3]<='4') then begin res:=res+' '+_tis9ch+_i+' ';   end;
                  if s[3]>'4' then  begin res:=res+' '+_tis9ch+' ';   end;
                 end;

              3: begin
               if s[3]='1' then begin  res:=res+' '+copy(_milliona,1,length(_milliona)-1)+' ' end;
               if (s[3]>='2') and (s[3]<='4') then begin  res:=res+' '+copy(_milliona,1,length(_milliona))+' ' end;
               if (s[3]>'4') then begin  res:=res+' '+copy(_milliona,1,length(_milliona)-1)+_ov+' ' end;
              end;
             end;
             stackpush(st,res);
          end;
         end;
         procedure printstack;
         var
          s:string;
         begin
          while not stackempty(ST) do begin
           s:=stackpop(st);
           write(s,' ');
          end
         end;

var
 int:string;
 i:integer;
 r:integer;

begin
 str(n,int);
 StackInit(ST);
 while length(int) mod 3 <>0 do int:='0'+int;
 r:=1;
 for i:=length(int)+1 div 3  downto 0 do begin
  if copy(int,i*3+1,3)<>'' then print3cintscack(copy(int,i*3+1,3),r);
  if copy(int,i*3+1,3)<>'' then inc®;
 end;
 printstack;
end;

var
 n:integer;
begin
 readln(n);
 inttowords(n);
 readln
end.

Константы записанны в кодировке DOS и WIN. (я с жтим мучался в FPC).
Компилятор FPC.
(должно и под TP пойти если первую директиву убрать)

скриншеты:



Модуль stack отсюда (FAQ->ДСД, стек)

Просьба обо всех замеченных ошибках сообщить. При желании исправить

На всякий случай - скомпилированная программа с исходниками в архиве:  inttowords.zip ( 12.78 килобайт ) Кол-во скачиваний: 495