Товарищи, выручайте! Есть такая задачка: С клавы вводят число (n>0). Нужно создать программу, выводящую фразу:"...Эти порядки существовали n лет". n изменяется на год. года в соответствии с нормами русского языка. Заранее большое спасибо!
М
не надо постить свои вопросы в чужие темы ! klem4
М
to klem4: спасибо что не удалил просто... а то бы мне нечего вечермо делать было Altair
Altair
20.11.2005 1:33
if n>0 then begin if n>4 then writeln('...Эти порядки существовали ',n,' лет') else writeln('...Эти порядки существовали ',n,' года') end else writeln('Enter n>0!!');
?
Дож
20.11.2005 1:41
Кажется имелось ввиду сообщение типа: ...Эти порядки существовали пять тысяч семисот лет
Altair
20.11.2005 1:52
Цитата
Кажется имелось ввиду сообщение типа: ...Эти порядки существовали пять тысяч семисот лет
тогла я не вижу ограничение сверху
Цитата
С клавы вводят число (n>0)
как будешь описывать все описания для 1000000000000 например ? это уже даже не миллиарды..
Altair
20.11.2005 3:43
Ну вот я покалякал... работает с миллионами включая... если надо дальше то в прогу внести совсем немного добавления..
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 пойти если первую директиву убрать)