Нарисовать правильный шестиугольник и перемещать его с помощью клавиш управления

@ВоенноОтмазанны · Регистрация: 12.02.2014

Студворк — интернет-сервис помощи студентам

Ребят всем привет. Прошу у вас помощи, задача заключается в этом, мне нужно нарисовать правильный шестиугольник и перемещать его с помощью клавиш управления (стрелки -> вверх, вниз, влево, вправо).

Так вот, у меня есть процедура west для рисования шестиугольника. А теперь подскажите как его перемещать, в общем вот выкладываю свои наброски, кто может помогите! Заранее благодарен!

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Procedure west;
 
BEGIN
 
x0:=GetMaxX div 2;
y0:=GetMaxY div 2;
 
a:=0;
for i:=1 to 7 do
begin
p[i].x:=x0+round(R/2*cos(a*pi/180));
p[i].y:=y0-round(R/2*sin(a*pi/180));
a:=a+60;
end;
p[7].x:=p[1].x;
p[7].y:=p[1].y;
MoveTo(p[1].x,p[1].y);
SetColor(4);
for i:=1 to 7 do
LineTo(p[i].x,p[i].y);
 
END;

Вот управление, между бегином и ендом нужно написать смещение x0 и y0 на +-20

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
repeat
if keypressed then
begin
k:=readkey;
if k=#80 then
begin
 
end;
if k=#72 then
begin
 
end;
if k=#77 then
begin
 
end;
if k=#75 then
begin
 
end;
 
until k=#27;

@Puporev · 12.02.2014, 19:27

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
uses graph,crt;
procedure west(x,y,r,c:integer);
var p:array[1..7] of pointtype;
    i:byte;
    u:real;
begin
u:=pi/2;
for i:=1 to 7 do
 begin
  p[i].x:=x+round(r*cos(u));
  p[i].y:=y-round(r*sin(u));
  u:=u+pi/3
 end;
setcolor(c);
drawpoly(7,p)
end;
var x,y,r,d:integer;
    k:char;
begin
x:=0;
initgraph(x,y,'');
x:=getmaxX div 2;
y:=getmaxY div 2;
r:=10;
outtextXY(x-80,20,'Upravlenie - Strelki');
outtextXY(x-50,40,'Exit - Esc');
west(x,y,r,12);
repeat
if keypressed then
 begin
  k:=readkey;
  if k=#0 then k:=readkey;
  case k of
  #80:begin
      delay(50);
      west(x,y,r,0);
      if y>getmaxY-2*r then d:=0
      else d:=20;
      y:=y+d;
      west(x,y,r,12);
      end;
  #72:begin
      delay(50);
      west(x,y,r,0);
      if y<50+2*r then d:=0
      else d:=20;
      y:=y-d;
      west(x,y,r,12);
      end;
  #77:begin
      delay(50);
      west(x,y,r,0);
      if x>getmaxX-2*r then d:=0
      else d:=20;
      x:=x+d;
      west(x,y,r,12);
      end;
  #75:begin
      delay(50);
      west(x,y,r,0);
      if x<2*r then d:=0
      else d:=20;
      x:=x-d;
      west(x,y,r,12);
      end;
  #27:exit;
  end;
 end;
until k=#27;
end.

@ВоенноОтмазанны · 12.02.2014, 20:23 **[ТС]**

Puporev, спасибо большое всё отлично работает!
И еще вопросик, а что если у нас на фоне экрана круги закрашенные в рандомные цвета, и при перемещении нашего 6-угольника стрелками там остаются следы от последних перемещений.. В общем не знаю как правильно объяснить но думаю проблема понятна, подскажите как это исправить.

@Puporev · 12.02.2014, 21:01

Это совсем другая песня, завтра напишу.

@ВоенноОтмазанны · 13.02.2014, 07:14 **[ТС]**

Puporev, хорошо, заранее благодарен!

@Puporev · 13.02.2014, 07:17

Знаешь, писать лень, вот есть такая программка не моя, поправь сам.

@Puporev · 13.02.2014, 09:34

Переписал все же.

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
uses crt, graph;
const nmax=20;
procedure mng(n,x,y,r:integer);
var p:array[1..nmax+1]of pointtype;
    i:byte;
    u,du:real;
begin
u:=pi/2;
du:=2*pi/n;
for i:=1 to n+1 do
 begin
  p[i].X:=x+round(r*cos(u));
  p[i].Y:=y-round(r*sin(u));
  u:=u+du
 end;
p[n+1]:=p[1];
setlinestyle(0,0,3);
setcolor(15);
drawpoly(n+1,p);
end;
var x,y,r1,r2,c,t1,t,x1,y1,size:integer;
    k:char;
    p: pointer;
begin
initgraph(x,y,'');
randomize;
r1:=10;
r2:=30;
y:=r1;
while y<=getmaxY do
 begin
  x:=r1;
  while x<=getmaxX do
   begin
    c:=1+random(14);
    setcolor(c);
    setfillstyle(1,c);
    fillellipse(x,y,r1,r1);
    x:=x+2*r1;
   end;
  y:=y+2*r1;
 end;
x:=getmaxX div 2;
x1:=x+30;
y:=getmaxY div 2;
y1:=y+30;
size:=imagesize(x-r2,y-r2,x1+r2,y1+r2);
getmem(p,size);
getimage(x-r2,y-r2,x1+r2,y1+r2,p^);
mng(6,(x+x1) div 2,(y+y1) div 2,r2);
repeat
 if(keypressed) then
  begin
   k:=readkey;
   if k=#0 then k:=readkey;
   case k of
   #72:begin {вверх}
       putimage(x-r2,y-r2,p^,copyput);
       t:=y;
       t1:=y1;
       y:=y-20;
       y1:=y1-20;
       if y<=r2 then
        begin
         y:=t;
         y1:=t1;
        end;
       getimage(x-r2,y-r2,x1+r2,y1+r2,p^);
       mng(6,(x+x1) div 2,(y+y1) div 2,r2);
       end;
   #75:begin{влево}
       putimage(x-r2,y-r2,p^,copyput);
       t:=x;
       t1:=x1;
       x:=x-20;
       x1:=x1-20;
       if x<=r2 then
        begin
         x:=t;
         x1:=t1;
        end;
       getimage(x-r2,y-r2,x1+r2,y1+r2,p^);
       mng(6,(x+x1) div 2,(y+y1) div 2,r2);
       end;
   #77:begin{вправо}
       putimage(x-r2,y-r2,p^,copyput);
       t:=x;
       t1:=x1;
       x:=x+20;
       x1:=x1+20;
       if x1>=getmaxX-r2 then
        begin
         x:=t;
         x1:=t1;
        end;
       getimage(x-r2,y-r2,x1+r2,y1+r2,p^);
       mng(6,(x+x1) div 2,(y+y1) div 2,r2);
       end;
   #80:begin{вниз}
       putimage(x-r2,y-r2,p^,copyput);
       t:=y;
       t1:=y1;
       y:=y+20;
       y1:=y1+20;
       if y1>=getmaxY-r2 then
        begin
         y:=t;
         y1:=t1;
        end;
       getimage(x-r2,y-r2,x1+r2,y1+r2,p^);
       mng(6,(x+x1) div 2,(y+y1) div 2,r2);
       end;
   end;
 end;
until k=#27;
freemem(p, size);
end.

Сделал для любого многоугольника до n=20.

@ВоенноОтмазанны · 13.02.2014, 17:58 **[ТС]**

Puporev, Благодарю вас! А подскажите еще как тут этот 6 угольник закрасить?? Где тут FloodFill добавить? Я что то пытался да не получилось.

@Puporev · 13.02.2014, 18:01

Pascal
1
2
3
4
5
setlinestyle(0,0,3);
setcolor(15);
setfillstyle(1,15);
fillpoly(n+1,p);
end;

@ВоенноОтмазанны · 13.02.2014, 20:22 **[ТС]**

Puporev, Большое Вам Человеческое Спасибо!

@ВоенноОтмазанны · 17.02.2014, 15:19 **[ТС]**

Puporev, подскажите еще пожалуйста как тут сделать так чтобы он вполную до краев экрана доходил? В вашем последнем коде менял 44 и 46 строки, как я понял вот там уменьшается это.. Но что то не совсем получилось. Подскажите пожалуйста!

Ваше:

Pascal
1
2
3
4
x:=getmaxX div 2;
x1:=x+30;
y:=getmaxY div 2;
y1:=y+30;

Моё:

Pascal
1
2
3
4
x:=getmaxX div 2;
x1:=x+0;
y:=getmaxY div 2;
y1:=y+0;

@Puporev · 18.02.2014, 07:42

напиши

Pascal
1
2
3
4
x:=getmaxX div 2;
x1:=x+2;
y:=getmaxY div 2;
y1:=y+2;

Ближе ко краю не знаю как сделать.

Новые блоги и статьи Все статьи Все блоги /
Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .	My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.	Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .
Настройки VS Code Loafer 13.04.2026 { "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .	Оптимизация кода на разграничение прав доступа к элементам формы Maks 13.04.2026 Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .	Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .	Архитектура слоя интернета для сервера-слоя. Hrethgir 11.04.2026 В продолжение https:/ / www. cyberforum. ru/ blogs/ 223907/ 10860. html Знаешь что я подумал? Раз мы все источники пишем в голове ветки, то ничего не мешает добавить в голову такой источник, который сам. . .

@ВоенноОтмазанны 0 / 0 / 0 Регистрация: 12.02.2014 Сообщений: 39
	12.02.2014, 20:23 [ТС]
	Puporev, спасибо большое всё отлично работает! И еще вопросик, а что если у нас на фоне экрана круги закрашенные в рандомные цвета, и при перемещении нашего 6-угольника стрелками там остаются следы от последних перемещений.. В общем не знаю как правильно объяснить но думаю проблема понятна, подскажите как это исправить. 0

@Puporev Почетный модератор 64319 / 47615 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	12.02.2014, 21:01
	Это совсем другая песня, завтра напишу. 0

@ВоенноОтмазанны 0 / 0 / 0 Регистрация: 12.02.2014 Сообщений: 39
	13.02.2014, 07:14 [ТС]
	Puporev, хорошо, заранее благодарен! 0

@ВоенноОтмазанны 0 / 0 / 0 Регистрация: 12.02.2014 Сообщений: 39
	13.02.2014, 17:58 [ТС]
	Puporev, Благодарю вас! А подскажите еще как тут этот 6 угольник закрасить?? Где тут FloodFill добавить? Я что то пытался да не получилось. 0

@ВоенноОтмазанны 0 / 0 / 0 Регистрация: 12.02.2014 Сообщений: 39
	13.02.2014, 20:22 [ТС]
	Puporev, Большое Вам Человеческое Спасибо! 0

Нарисовать правильный шестиугольник и перемещать его с помощью клавиш управления

Решение