Форум программистов, компьютерный форум, киберфорум
Turbo Pascal
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/18: Рейтинг темы: голосов - 18, средняя оценка - 5.00
0 / 0 / 0
Регистрация: 17.02.2013
Сообщений: 43
1

Движение фигуры по нажатию на клавиши-стрелки

16.01.2015, 16:24. Показов 3307. Ответов 4
Метки нет (Все метки)

Нужно чтобы фигура двигались по нажатию стрелок. Точка, круг и эллипс двигаются нормально, а вот отрезок, прямоугольник и треугольник, как-будто приклеены к одной стороне и получается что они крутятся вокруг себя.

Модуль:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
Unit FIGURA;
interface
TYPE
     tPoint=object
        x,y:integer;
        color:word;
        Procedure Init(InitX,InitY:integer; col:word);       
        Function GetX: integer;
        Function GetY: integer;
        Procedure Move(NewX,NewY:integer);
        Procedure Hide;
        Procedure Draw;
     end;
     tCircle=object(tPoint)
        R:word;
        Procedure Init(InitX,InitY:integer; col,InitR:word);
        Procedure Hide;
        Procedure Draw;
        Procedure Move(NewX,NewY:integer);
     end;
    tEllipse=object(tCircle)
        Rx,Ry:word;
        Procedure Init(InitX,InitY:integer; col,InitR,InitRx,InitRy:word);
        Procedure Hide;
        Procedure Draw;
        Procedure Move(NewX,NewY:integer);
     end;
    tLine=object(tPoint)
        Lx,Ly:integer;
        Procedure Init(InitX,InitY,InitLx,InitLy:integer; col:word);             
 
        Procedure Hide;
        Procedure Draw;
        Procedure Move(NewX,NewY:integer);
     end;
    tTriangle=object(tLine)
        TrX,TrY:integer;
        Procedure Init(InitX,InitY,InitLx,InitLy,InitTrX,InitTrY:integer; 
 
col:word);
        Procedure Hide;
        Procedure Draw;
        Procedure Move(NewX,NewY:integer);
     end;
    tRectangle=object(tLine)
        Procedure Init(InitX,InitY,InitLx,InitLy:integer; col:word);             
 
        Procedure Hide;
        Procedure Draw;
        Procedure Move(NewX,NewY:integer);
     end;
 
implementation
 
Uses Crt,Graph;
 
    {методы tPoint}
 
Procedure  tPoint.Init(InitX,InitY:integer; col:word);
begin
  x:=InitX; y:=InitY;
  color:=col;
end;
 
Function tPoint.GetX:integer;
begin
   GetX:=X;
end;
Function tPoint.GetY:integer;
begin
   GetY:=Y;
end;
 
Procedure tPoint.Move(NewX,NewY:integer);
begin
 Hide;
 x:=NewX; y:=NewY;
 Draw;
end;
 
Procedure tPoint.Hide;
begin
 PutPixel(x,y,GetBkColor);
end;
 
Procedure tPoint.Draw;
begin
 PutPixel(x,y,color);
end;
 
{методы  tCircle} 
Procedure tCircle.Init(InitX,InitY:integer; col,InitR:word);
begin
  tPoint.Init(InitX,InitY,col);
  R:=InitR;
end;
 
Procedure tCircle.Hide;
begin
 SetFillStyle(1,GetBkColor);
 SetColor(GetBkColor);
 Circle(x,y,R);
end;
 
Procedure tCircle.Draw;
begin
 SetFillStyle(1,GetBkColor);
 SetColor(color);
 Circle(x,y,R);
end;
 
Procedure tCircle.Move(NewX,NewY:integer);
begin
 Hide;
 x:=NewX; y:=NewY;
 Draw;
end;
 
    {методы  tEllipse}
Procedure tEllipse.Init(InitX,InitY:integer;
                              col,InitR,InitRx,InitRy:word);
begin
  tCircle.Init(InitX,InitY,InitR,col);
  Rx:=InitRx; Ry:=InitRy;
end;
 
Procedure tEllipse.Hide;
begin
 SetFillStyle(1,GetBkColor);
 SetColor(GetBkColor);
 FillEllipse(x,y,Rx,Ry);
end;
 
Procedure tEllipse.Draw;
begin
 SetFillStyle(1,GetBkColor);
 SetColor(color);
 FillEllipse(x,y,Rx,Ry);
end;
 
Procedure tEllipse.Move(NewX,NewY:integer);
begin
 Hide;
 x:=NewX; y:=NewY;
 Draw;
end;
 
{методы  tLine}
Procedure tLine.Init(InitX,InitY,InitLx,InitLy:integer; col:word);
begin
 tPoint.Init(InitX,InitY,col);
 Lx:=InitLx;Ly:=InitLy;
end;
 
Procedure tLine.Hide;
begin
 SetFillStyle(1,GetBkColor);
 SetColor(GetBkColor);
 Line(x,y,Lx,Ly);
end;
 
Procedure tLine.Draw;
begin
 SetFillStyle(1,GetBkColor);
 SetColor(color);
 Line(x,y,Lx,Ly);
end;
 
Procedure tLine.Move(NewX,NewY:integer);
begin
 Hide;
 x:=NewX; y:=NewY;
 Draw;
end;
 
{методы  tTriangle}
Procedure tTriangle.Init(InitX,InitY,InitLx,InitLy,InitTrX,InitTrY:integer; 
 
col:word);
begin
  tLine.Init(InitX,InitY,InitLx,InitLy,col);
  TrX:=InitTrX;
  TrY:=InitTrY;   
end;
 
Procedure TTriangle.Hide;
begin
  SetColor(GetbkColor); 
  Line(x,y,Lx,Ly);
  Line(Lx,Ly,TrX,TrY);
  Line(x,y,TrX,TrY);
end;
 
Procedure TTriangle.Draw;
begin
  SetColor(color); 
  Line(x,y,Lx,Ly);
  Line(Lx,Ly,TrX,TrY);
  Line(x,y,TrX,TrY);
end;
 
Procedure tTriangle.Move(NewX,NewY:integer);
begin
 Hide;
 x:=NewX; y:=NewY;
 Draw;
end;
 
{методы  tRectangle}
Procedure tRectangle.Init(InitX,InitY,InitLx,InitLy:integer; col:word);
begin
 tLine.Init(InitX,InitY,InitLx,InitLy,col);
end;
 
Procedure tRectangle.Hide;
begin
 SetFillStyle(1,GetBkColor);
 SetColor(GetBkColor);
 Rectangle(x,y,Lx,Ly);
end;
 
Procedure tRectangle.Draw;
begin
 SetFillStyle(1,GetBkColor);
 SetColor(color);
 Rectangle(x,y,Lx,Ly);
end;
 
Procedure tRectangle.Move(NewX,NewY:integer);
begin
 Hide;
 x:=NewX; y:=NewY;
 Draw;
end;
 
end.
Программа:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
PROGRAM GRAFICA;
Uses Crt,Graph,FIGURA;
 
const Path_of_driver='F:\BGI';
 
Procedure Coords(a:char; var NewX,NewY:integer; h:integer);
begin
    if a=#0 then begin
      a:=readkey; {в переменную a записывается код клавиши, 
                   которую Вы нажали}
 
{#80,#75,#77,#72 – это коды клавиш со стрелками;
  работа оператора case: в зависимости от значения переменной a выбирается
  соответствующая последовательность действий; подробнее можно посмотреть в
  лекциях по ПЯВУ часть1}
       case a of                    
           #80: begin 
                  Inc(NewY,h); if NewY>GetMaxY-20 then NewY:=20;
                end;
           #75: begin 
                  dec(NewX,h); if NewX<10 then NewX:=GetMaxX-10;
                end;
           #77: begin 
                  inc(NewX,h); if NewX>GetMaxX-10 then NewX:=10;
                end;
           #72: begin 
                  dec(NewY,h); if NewY<20 then NewY:=GetMaxY-20;
                end;
       end;
     end
end;
 
VAR gd,gm,NewX,NewY,NewLX,NewLY,h: integer; 
    Q,a:char; 
    str:string;
    pP:TPoint; 
    pCl:TCircle;
    pEl:TEllipse;
    pLi:TLine;
    pREc:TRectangle;
    pTri:TTriangle;
 
BEGIN
{Начало работы программы. С этого момента и надо начинать разбирать
 работу программы}
      gd:=Detect;
     InitGraph(gd,gm,Path_of_driver);
     if GraphResult<>grok then begin
         write('error:',GraphErrorMsg(GraphResult));
         halt;
     end;
 
     pP.Init(GetMaxX div 2,GetMaxY div 2,15);
     pCl.Init(GetMaxX div 2,GetMaxY div 2,10,14);
     pEl.Init(GetMaxX div 2,GetMaxY div 2,10,14,70,14);
     pLi.Init(GetMaxX div 2,GetMaxY div 2,10,14,14);
     pREc.Init(GetMaxX div 2,GetMaxY div 2,10,14,14);
     pTri.Init(GetMaxX div 2,GetMaxY div 2,10,14,70,14,11);
 
     NewX:=GetMaxX div 2; {GetMaxX - максимальное значение экрана по оси x}
     NewY:=GetMaxY div 2;
     
     h:=100; {влияет на скорость передвижения фигур при нажатии
              клавиш со стрелками}
 
   RestoreCrtMode; {восстановление текстового режима (так можно выйти из
                    графического режима и вернуться к текстовому)}
  Q:='y';
  While  Q<>'n' do begin
    write(' Выберите фигуру, для этого введите: p (если выбрали точку)');
    write (' cl (если выбрали кргу):  ');
    write (' el (если выбрали эллипс):  ');
    write (' li (если выбрали):  ');
    write (' rec (если выбрали):  ');
    write (' tri (если выбрали):  ');
    readln(str);
 
{то,ы выбрать какую фигуру перемещать по экрану }
 
    writeln('Нажмите клавишу Enter');
    writeln('Нажимайте клавиши со стрелками, чтобы двигать фигуру');
    readln;
    SetGraphMode(gm);  {восстановление графического режима}
 
    repeat
       a:=readkey;
       Coords(a,NewX,NewY,h);
       if str='p'  then pP.Move(NewX,NewY);
       if str='cl' then pCl.Move(NewX,NewY);
       if str='el' then pEl.Move(NewX,NewY);
       if str='li' then pLi.Move(NewX,NewY);
       if str='rec' then pRec.Move(NewX,NewY);
       if str='tri' then ptri.Move(NewX,NewY);
    until a=#27;                           {#27– код клавиши Esc }
 
    RestoreCrtMode;
 
    write('Продолжить? (y/n) ');
 
    readln(Q); {в переменную Q запишется введенный символ: либо y, либо n}
  end; {окончание тела цикла While}
 
  closegraph;
  clrscr;
 
END.
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
16.01.2015, 16:24
Ответы с готовыми решениями:

Движение круга по нажатию клавиши
Здравствуйте, мне надо сделать движение шарика при нажатии стрелочки(движение соответствует...

Движение картинки по нажатию клавиши
нужно сделать движение picturebox при нажатии на клавиши(вверх, вниз, вправо, влево)

Движение слова по нажатию клавиши
Имеется код, нужно дописать его так, чтобы слово Внимание двигалось по нажатию клавиш W,A,S,D....

Движение по нажатию клавиши: то ль лыжи не едут, то ль я
Идея была в том, чтоб двухмерный квадрат двигался внутри окна, реагируя на клавиши. Ниже выкладываю...

4
Модератор
Эксперт Pascal/DelphiЭксперт NIX
5725 / 3435 / 2441
Регистрация: 22.11.2013
Сообщений: 9,646
Записей в блоге: 1
16.01.2015, 16:53 2
Полагаю, так будет понятнее:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
tPoint=object
  x,y:integer;
...
tLine=object(tPoint)
  Lx,Ly:integer;
...
procedure tLine.Draw;
begin
...
  Line(x,y,Lx,Ly);
end;
 
procedure tLine.Move(NewX,NewY:integer);
begin
  Hide;
  x:=NewX; y:=NewY;
  Draw;
end;
Вот поменяли вы при сдвиге x,y, потом нарисовали из новой точки (x,y) опять в старую (Lx,Ly).
Разве этого хотелось?
0
0 / 0 / 0
Регистрация: 17.02.2013
Сообщений: 43
16.01.2015, 17:56  [ТС] 3
Т.е. я должен в процедуру tLine.Move дописать что-то типа Lx:=NewLx; Ly:=NewLy;?
0
Модератор
Эксперт Pascal/DelphiЭксперт NIX
5725 / 3435 / 2441
Регистрация: 22.11.2013
Сообщений: 9,646
Записей в блоге: 1
16.01.2015, 18:04 4
Sanekkk1,
вам виднее, что и кому вы должны.
Однако очевидно, что если у линии (и др. фигур) менять координаты только одного конца, то перемещения не получится.

На самом деле вариантов сильно больше одного. Например, хранить координаты второй точки в виде смещения от первой, и рисовать при помощи line(x,y,x+dx,y+dy), тогда при перемещении достаточно менять только x и y. Либо в вызове Move сначала посчитать смещения, затем прибавить их к каждой точке:
Pascal
1
2
3
4
  dx:=NewX-x; dy:=NewY-y;
  x:=x+dx; y:=y+dy;
  Lx:=Lx+dx; Ly:=Ly+dy;
  ...
1
0 / 0 / 0
Регистрация: 17.02.2013
Сообщений: 43
16.01.2015, 18:15  [ТС] 5
ааа понял, спасибо
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
16.01.2015, 18:15

Заказываю контрольные, курсовые, дипломные работы и диссертации здесь.

Движение фигуры по нажатию двух клавиш
Здравствуйте! Подскажите, как прописать код, чтобы фигура начинала двигать при нажатии Alt+любая...

Как реализовать движение фигуры на canvas при нажатии на клавиши up, down, left, right?
как реализовать движение фигуры на canvas с помощью клавиш up, down, left, right? Проблема в том...

Нарисовать летающий в пространстве куб. Движение и остановку реализовать по нажатию на клавиши клавиатуры
Нарисовать летающий в пространстве куб. Движение и остановку реализовать по нажатию на клавиши...

Нарисовать летающий в пространстве мяч. Движение и останов реализовать по нажатию на клавиши клавиатуры
Нарисовать летающий в пространстве мяч. Движение и останов реализовать по нажатию на клавиши...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
5
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.