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

М

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

М

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

if n>0 then begin
 if n>4 then writeln('...Эти порядки существовали ',n,' лет') else writeln('...Эти порядки существовали ',n,' года')
end else writeln('Enter n>0!!');

?

Кажется имелось ввиду сообщение типа:
...Эти порядки существовали пять тысяч семисот лет

тогла я не вижу ограничение сверху

как будешь описывать все описания для 1000000000000 например ?
это уже даже не миллиарды..

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

{$mode delphi}
uses STACK;
const

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

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

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

скриншеты:
Нажмите для просмотра прикрепленного файла
Нажмите для просмотра прикрепленного файла
Нажмите для просмотра прикрепленного файла
Модуль stack отсюда (FAQ->ДСД, стек)

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

На всякий случай - скомпилированная программа с исходниками в архиве:Нажмите для просмотра прикрепленного файла

А что предела n не должно быть ? Я когда-то похожую задачу решал, но там до 1000. ссылка

Спасибочки!

To: klem4
а что та твоя прога делает ?у меня все время 0 возвращает как рельузтат и все...

да и сразу вижу у нее проблеммы будут... не по русски выводить будет.
тома, всегда пожалуйста, только ты бы хоть сказал что тебе надо было

Олег, опять я с просони перепутал ) Там наоборот : Вводишь 'Сто двадцать пять'

получаешь результат : 125 ;)