1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Добрый день! Нужна помощь в решении такой задачи: Построить движущегося вправо,влево.. человечка с анимированными конечностями с помощью псевдографики, с использованием собственных процедур, никаких модулей кроме CRT использовать нельзя. Собственно не могу сделать руки, получается либо сделать их подвижными по оси Y, но по оси X они не двигаются, либо наоборот
Код для построения человечка написал:
uses CRT; var g,i:integer;
procedure circle(Radius,Horizontal,Vertical:integer); var l,x,y:integer; begin for l:=0 to 360 do begin x:=round(Radius*sin(l)+Horizontal); y:=round(Radius*cos(l)+Vertical); GoToXY(x,y); write('*'); end end;
procedure HorizontalLine(y,b1,b2:integer); begin for g:=b1 to b2 do begin GoToXY(g,y); writeln('*'); end end;
procedure VerticalLine(x,b1,b2:integer); begin for g:=b1 to b2 do begin GoToXY(x,g); writeln('*'); end end;
begin clrscr; for i:=1 to 60 do begin textcolor(red);
-------------------------------------------------------------------------- Помогите пожалуйста приклеить к нему руки+еще чтобы двигались вправо и вверх вниз, вообщем что руками махал)) сам похоже уже не справлюсь
знакомые вроде как сказали что агоритм брезенхема можно использовать, но как это осуществить без модуля graph не нашел, знакомые тоже с алгоритмом этим не сталкивались, только слышали, помогите кто может пожалуйста!
procedure circle(Radius,Horizontal,Vertical:integer); var l,x,y:integer; begin for l:=0 to 360 do begin x:=round(Radius*sin(l)+Horizontal); y:=round(Radius*cos(l)+Vertical); GoToXY(x,y); write('*'); end; end;
procedure HorizontalLine(y,b1,b2:integer); begin for g:=b1 to b2 do begin GoToXY(g,y); writeln('*'); end; end;
procedure VerticalLine(x,b1,b2:integer); begin for g:=b1 to b2 do begin GoToXY(x,g); writeln('*'); end; end;
procedure line(x1,y1,x2,y2:integer;sim:string); {liniya - algoritm Bresenhema} var g,x,y,dx,dy,s1,s2,e,i:integer; begin x:=x1; y:=y1; dx:=abs(x2-x1); dy:=abs(y2-y1); if x2-x1>0 then s1:=1 else if x2-x1<0 then s1:=-1 else s1:=0; if y2-y1>0 then s2:=1 else if y2-y1<0 then s2:=-1 else s2:=0; if dy<=dx then begin e:=2*dy-dx; for i:=0 to dx do begin gotoxy(x,y); write(sim); if e>=0 then begin y:=y+s2; e:=e-2*dx; end; e:=e+2*dy; x:=x+s1; end; end else begin e:=2*dx-dy; for i:=0 to dy do begin gotoxy(x,y); write(sim); if e>=0 then begin x:=x+s1; e:=e-2*dy; end; e:=e+2*dx; y:=Y+s2; end; end; end;
begin g:=1; clrscr; for i:=1 to 50 do begin textcolor(red);
сделал! правда руки все равно не знаю как сделать чтобы двигались вверх-вниз..(вообще то знаю,но тогда они по оси X двигаться не будут, не знаю как объеденить) и еще такая штука не знаю почему, но программа не заканчивается после нажатия кнопки, приходиться ctrl+break использовать, кто знает как поправить, поправте пожалуйста, извините, что туплю так, но в программировании я почти 0, но есть жедание научиться!
Помогите пожалуйста!!! хотя бы с until keypressed`ом который у меня почему то не работает, в четверг сдавать нужно, а программа даже нормально не закрывается
3. Вот рисую линии с помощью алгоритма Брезенхема:
uses crt; var i:integer;
procedure line(x0,y0,x1,y1:integer); var x,y:integer; begin if (x0=x1) then begin {func goriz - ТВОЯ ФУНКЦИЯ ГОРИЗОНАЛЬНОЙ ЛИНИИ} exit; end; if (y0=y1) then begin {func vert - ВЕРТИКАЛЬНОЙ} exit; end;
{РИСУЕМ} for x:=x0 downto x1 do begin GotoXY(x,round ( ((y1-y0) / (x1-x0)) * (x-x0)+y0)); write('*'); end;
for y:=y0 downto y1 do begin GotoXY(round ( ((y-y0) / (y1-y0)) * (x1-x0)+x0), y); write('*'); end;
for x:=x0 to x1 do begin GotoXY(x,round ( ((y1-y0) / (x1-x0)) * (x-x0)+y0)); write('*'); end;
for y:=y0 to y1 do begin GotoXY(round ( ((y-y0) / (y1-y0)) * (x1-x0)+x0), y); write('*'); end;
end;
begin clrscr; line(10,10,11,20); line(10,10,25,14); line(10,10,2,2); line(10,10,15,3); line(10,10,3,15); readkey;
end.
Я не стал писать конструкции if в построении, неверные ситуации итак игнорируются. Рисует во все стороны.
3. Вот рисую линии с помощью алгоритма Брезенхема:
В алгоритме Брезенхема не используются ни числа с плавающей точкой, ни операция округления, ни операции деления внутри цикла. Это вас кто-то обманул.
Procedure Line(x1,y1,x2,y2,c:Integer); var dx,dy,sx,sy,d,d1,d2,x,y,i:Integer; begin dx:=abs(x2-x1); dy:=abs(y2-y1); if (x2>x1) then sx:=1 else sx:=-1; if (y2>y1) then sy:=1 else sy:=-1; if dy<=dx then begin d:=dy shl 1 - dx; d1:=dy shl 1; d2:=(dy-dx) shl 1; PutPixel(x1,y1,c); x:=x1+sx;y:=y1; for i:=1 to dx do begin if (d>0) then begin inc(d,d2);inc(y,sy); end else inc(d,d1); PutPixel(x,y,c); inc(x,sx); end; end else begin d:=dx shl 1 - dy; d1:=dx shl 1; d2:=(dx-dy) shl 1; PutPixel(x1,y1,c); y:=y1+sy;x:=x1; for i:=1 to dy do begin if (d>0) then begin inc(d,d2);inc(x,sx); end else inc(d,d1); PutPixel(x,y,c); inc(y,sy); end; end; end;
program Human; uses CRT; var g,j,i:integer; k:boolean;
procedure circle(Radius,Horizontal,Vertical:integer); {postroenie kruga} var l,x,y:integer; begin for l:=0 to 360 do {cikl s parametrom} begin x:=round(Radius*sin(l)+Horizontal); {nahodim i okruglyaem koordinatu X} y:=round(Radius*cos(l)+Vertical); {nahodim i okruglyaem koordinatu Y} GoToXY(x,y); {peremeshaem kursor v tochku c koordinatami (X,Y)} write('*'); {stavim v tochke s koordinatami (X,Y) simvol * } end; end;
procedure HorizontalLine(y,b1,b2:integer); {postroenie gorizontalnoy linii} begin for g:=b1 to b2 do {cikl s parametrom} begin GoToXY(g,y); {perevodim kursor v tochku s koordinatami (G,Y)} writeln('*'); {stavim v tochke s koordinatami (G,Y) simvol * } end; end;
procedure VerticalLine(x,b1,b2:integer); {postroenie vertikalnoy linii} begin for g:=b1 to b2 do {cikl s parametrom} begin GoToXY(x,g); {perevodim kursor v tochku s koordinatami (X,G)} writeln('*'); {stavim v tochke s koordinatami (X,G) simvol * } end; end;
procedure line(x1,y1,x2,y2:integer); {liniya - algoritm Brasenhaima} var g,x,y,dx,dy,s1,s2,e,i:integer; begin x:=x1; y:=y1; dx:=abs(x2-x1); dy:=abs(y2-y1); if x2-x1>0 then s1:=1 else {operator uslovnogo perehoda} if x2-x1<0 then s1:=-1 else s1:=0; if y2-y1>0 then s2:=1 else if y2-y1<0 then s2:=-1 else s2:=0; if dy<=dx then begin e:=2*dy-dx; for i:=0 to dx do {cikl s parametrom} begin gotoxy(x,y); {peremeshaem kursor v tochku s koordinatami (X,Y)} write('*'); {stavim v tochke s koordinatami (X,Y) simvol * } if e>=0 then {cikl uslovnogo perehoda} begin y:=y+s2; e:=e-2*dx; end; e:=e+2*dy; x:=x+s1; end; end else begin e:=2*dx-dy; for i:=0 to dy do {cikl s parametrom} begin gotoxy(x,y); {peremeshaem kursor v tochku s koordinatami (X,Y)} write('*'); {stavim v tochke s koordinatami (X,Y) simvol * } if e>=0 then {uslovie, operator uslovnogo perehoda} begin x:=x+s1; e:=e-2*dy; end; e:=e+2*dx; y:=Y+s2; end; end; end;
begin clrscr; {ochistka ekrana} j:=0; k:=true; repeat {povtor, cikl s post usloviem} repeat inc(i); {shag, analogichno i:=i+1}
Line(8+i,9,4+i,13-j); {ruki} Line(22+i,9,26+i,13-j); delay(30000); {zaderzhka} if (j<2) and (k=true) then {uslovie, operator uslovnogo perehoda} inc(j) {tozhe samoe chto i j:=j+1} else begin k:=false; dec(j); {tozhe samoe chto i j:=j-1} end; if j=0 then {uslovie, operator uslovnogo perehoda} begin k:=true; end; clrscr; {ochistka ekrana} until (i=50)or(keypressed=true); {cikl s post usloviem} repeat {cikl s post usloviem} dec(i); {tozhe samoe chto i i:=i-1}
Line(8+i,9,4+i,13-j); {ruki} Line(22+i,9,26+i,13-j); delay(30000); {zaderzhka} if (j<2) and (k=true) then {uslovie, operator uslovnogo perehoda} inc(j) {tozhe samoe chto j:=j+1} else begin k:=false; dec(j); {tozhe samoe chto i j:=j-1} end; if j=0 then {uslovie, operator uslovnogo perehoda} begin k:=true; end; clrscr; {ochistka ekrana} until (i=0)or(keypressed=true); {cikl s post usloviem} until keypressed=true; end.
Правила форума
Прочтите прежде чем задавать вопрос!
