1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Товарищи, выручайте! Есть такая задачка: С клавы вводят число (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!!');
?
Сообщение отредактировано: Altair -
--------------------
Помогая друг другу, мы справимся с любыми трудностями! "Не опускать крылья!" (С)
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 пойти если первую директиву убрать)