Народ хэлп!
Нужно в паскале заставить фигуру двигаться в пределах экрана по определенной траектории(траектория показана на рисунке). Как делать передвижение? С помощью циклов или условий? Как сделать, чтобы двигалось в пределах экрана? Две недели мучаюсь ничего не выходит! Покопался в темах - толком ничего не нашел. Выручите плиз!!!
p.s. Фигура двигается так: из точки 0,0 по диагонали вниз (45 градусов), как только доходит до низа экрана "отскакивает" вверх, и всегда как только доходит до низа отскакивает вверх. Далее всегда как только доходит до верха опять идет по диагонали до правого предела экрана "отскакивает" и идет по горизонтали до левого предела экрана. После этого опять по диагонали. И так до бесконечности.
Эскизы прикрепленных изображений
uses crt,graph;
var
gd, gm, x, y, dx, dy: Integer;
begin
gd := detect;
initgraph(gd, gm, '');
x := 0; y := 0;
repeat
if (y = 0) or (x = 0) then begin dx := 1; dy := 1; end
else if (y = GetMaxY) then begin dx := 0; dy := -1 end
else if (x = GetMaxX) then begin dx := -1; dy := 0; end;
inc(x, dx); inc(y, dy);
PutPixel(x, y, white); Delay(2);
until keypressed;
closegraph;
end.
Вот программа которая показывает на примере движения окружности как реализовать движение в пределах экрана.
Uses
Graph, Crt;
Var
gr, gm: Integer;
MaxX, MaxY, i, x, y, dx, R :Integer;
Begin
gr := Detect;
InitGraph(gr, gm, '');
MaxX := GetMaxX;
MaxY := GetMaxY;
x := MaxX div 2;
y := MaxY div 2;
R := 20;
dx := 1;
SetColor(White);
Rectangle(0,0,MaxX,MaxY);
SetFillStyle(SolidFill,Black);
For i := 1 To 2*MaxX Do
Begin
x := x + 3*dx;
Circle(x,y,R);
Delay(15);
SetFillStyle(SolidFill,Black);
Bar(1,1,MaxX-1,MaxY-1);
If (x >= (MaxX-R)) or (x <= R) Then dx := dx*(-1);
End;
ReadKey;
CloseGraph;
End.
Sto
Ты картинку присоединенную видел ? Может пора начинать нормально читать все условия задачи ? В моем варианте осталось заменить putpixel на отрисовку нужного объекта
klem4
Конечно видел.
Я показал как сделать чтобы фигура отбивалась от границ экрана, а не решенную программу.
Недумаю что изменить траэкторию будет огромной проблемой.
var gd, gm: integer;F что, я же показал, как инициализировать графику. Что, добавление траектории - проблема? Я даже показал, где надо добавлять...
begin
initgraph(gd, gm);
{ Здесь добавляем отрисовку }
readln;
closegraph;
end.
Только ты чуть-чуть упустил вот это : p.s. Фигура двигается так: из точки 0,0 по диагонали вниз (45 градусов), как только доходит до низа экрана "отскакивает" вверх, и всегда как только доходит до низа отскакивает вверх. Далее всегда как только доходит до верха опять идет по диагонали до правого предела экрана "отскакивает" и идет по горизонтали до левого предела экрана. После этого опять по диагонали. И так до бесконечности.
Настоятельно рекомендую тебе прекратить этот бессмысленный флуд. А в следующий раз думать прежде чем что-то отвечать.
program Sharik;
uses graph,crt;
var Gd, Gm, X, Y, R: Integer; Napr: string;
begin
Gd := Detect; InitGraph(Gd, Gm, ' ');
X:=320; Y:=240; R:=10; Napr:='NP';
repeat
setcolor(15);
Line(20, 40,20, 440); Line(20,40,620,40);
Line(620,40,620,440); Line(620,440,20,440);
Circle(X,Y,R);
delay(500);
setcolor(0);
Circle(X,Y,R);
if Napr='VP' then begin
X:=X+1; Y:=Y-1;
end;
if Napr='NP' then begin
X:=X+1; Y:=Y+1;
end;
if Napr='NL' then begin
X:=X-1; Y:=Y+1;
end;
if Napr='VL' then begin
X:=X-1; Y:=Y-1;
end;
if Y=40 then begin
if Napr='VP' then Napr:='NP';
if Napr='VL' then Napr:='NL';
end;
if X=620 then begin
if Napr='VP' then Napr:='VL';
if Napr='NP' then Napr:='NL';
end;
if Y=440 then begin
if Napr='NP' then Napr:='VP';
if Napr='NL' then Napr:='VL';
end;
if X=20 then begin
if Napr='VL' then Napr:='VP';
if Napr='NL' then Napr:='NP';
end;
until keypressed;
CloseGraph
end.
оффтоп
Внимание !
в этой теме проводится конкурс: "Кто выложит решение максимально отдаленное от того что требуется в задании получает -2 в рейтинг !"
Поехали !
всем кто участвовал в решении этой задачи большое спасибо!!!
отдельное спасибо klem4!
появилась другая проблема. у меня не получается сделать так, чтобы код(взял код klem4) работал у меня в программе.то идет по диагонали, не "видя" нижнего предела экрана, то вообще не двигается.раньше думал, что проблема в условиях. теперь вроде все правильно, но все равно не работает.
Вообщем выкладываю листинг проги(вернее модуля) с которым проблемы. Может кто-нибудь разбереться.
unit ULABRAB;
interface
uses Graph,Crt,UVIDEO,UDIAGRAM;
type
{здесь все работает(убрал для уменьшения объема)}
PMyFigure4=^TMyFigure4;
TMyFigure4=object(TMyFigure3)
private
s:boolean; xf,yf:integer;
public
constructor init(axf,ayf:integer; ar:word; acolor_fig:byte);
procedure moveTraject(at:integer);
procedure dx_dy(dxfig,dyfig:integer); virtual;
end;
implementation
{здесь все работает(убрал для уменьшения объема)}
constructor TMyFigure4.init(axf,ayf:integer; ar:word; acolor_fig:byte);
begin
if (axf<0) or (axf>Video.getXmax) then xf:=(Video.getXmax div 2)
else xf:=axf;
if (ayf<0) or (ayf>Video.getYmax) then yf:=(Video.getYmax div 2)
else yf:=ayf;
inherited init(xf,yf,ar,acolor_fig);
s:=true
end;
procedure TMyFigure4.moveTraject(at:integer);
{здесь расчет передвижения}
procedure TMyFigure4.dx_dy(dxfig,dyfig:integer);
begin
inherited dx_dy(dxfig,dyfig);
end;
end.
Можеш посмотреть как на примере окружности можно сделать движение по заданой тобой траэктории.
Uses
Graph, Crt;
Var
gr, gm: Integer;
MaxX, MaxY, i, x, y, dx, dy, R :Integer;
Begin
gr := Detect;
InitGraph(gr, gm, '');
MaxX := GetMaxX;
MaxY := GetMaxY;
R := 20;
x := R;
y := R;
dx := 3;
dy := 3;
SetColor(White);
Rectangle(0,0,MaxX,MaxY);
SetFillStyle(SolidFill,Black);
For i := 1 To 2000 Do
Begin
x := x + dx;
y := y + dy;
Circle(x,y,R);
Delay(5);
SetFillStyle(SolidFill,Black);
Bar(1,1,MaxX-1,MaxY-1);
If (x >= (MaxX-R)) Then Begin dx := dx*(-1); dy := 0; End;
If (x <= R) Then Begin dx := dx*(-1); dy := 3; End;
If (y >= (MaxY-R)) Then Begin dy := dy*(-1); dx := 0; End;
If (y <= R) Then Begin dy := dy*(-1); dx := 3; End;
End;
ReadKey;
CloseGraph;
End.