Форум программистов, компьютерный форум, киберфорум
Алгоритмы
Войти
Регистрация
Восстановить пароль
Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.67/6: Рейтинг темы: голосов - 6, средняя оценка - 4.67
40 / 29 / 15
Регистрация: 07.02.2019
Сообщений: 126

Алгоритм круга. Расставить точки по порядку

03.01.2020, 13:07. Показов 1172. Ответов 7
Метки нет (Все метки)

Студворк — интернет-сервис помощи студентам
Рисую круг по алгоритму Брезенхема, точки ставятся правильно но не по порядку:
Кликните здесь для просмотра всего текста
Delphi
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
procedure TForm3.Sircle(); // Нарисовать круг по формуле Брезенхема
var
i,j,x,y,x_,y_,r_,x_2,y_2,x_m,y_m,d1,d2 : integer;
begin
   x_:=7; // Центр по X
   y_:=7; // Центр по Y
   r_:=5;  // Радиус окружности
   x:=0;
   y:=r_;
   j := 0;
   while ( x<=round(r_/sqrt(2)) )
   do begin
    for i := 0 to 3 do // Расширение "к верхним и нижним краям" по горизонтали. 0 - Верхняя точка для Y, Левая для X. 1 - Верхняя точка для Y, Правая для X. 2 - Нижняя точка для Y, Левая для X. 3 - Нижняя точка для Y, Правая для X.
    begin
     x_m := x_m*-1;
     y_m := Round(i/3)*2-1;
     x_2 := x_+x*x_m;
     y_2 := y_+y*y_m;
     if (StringGrid1.Cells[x_2,y_2]='') then
     begin
      StringGrid1.Cells[x_2,y_2]   := floattostr(j);
      j := j+1;
     end;
    end;
 
    if (StringGrid1.Cells[x_+y,y_-x]<>'')
    then
    begin
     x:=x+1;
     d1:=ABS(r_*r_-x*x-y*y);
     d2:=ABS(r_*r_-x*x-(y-1)*(y-1));
     if(d1>d2)  then  y:=y-1;
     continue;
    end;
 
    for i := 0 to 3 do // Расширение "к верхним и нижним краям" по горизонтали. 0 - Верхняя точка для Y, Левая для X. 1 - Верхняя точка для Y, Правая для X. 2 - Нижняя точка для Y, Левая для X. 3 - Нижняя точка для Y, Правая для X.
    begin
     x_m := Round(i/3)*2-1;
     y_m := y_m*-1;
     x_2 := x_+y*y_m;
     y_2 := y_+x*x_m;
     if (StringGrid1.Cells[x_2,y_2]='') then
     begin
      StringGrid1.Cells[x_2,y_2]   := floattostr(j);
      j := j+1;
     end;
    end;
 
    x:=x+1;
    d1:=ABS(r_*r_-x*x-y*y);
    d2:=ABS(r_*r_-x*x-(y-1)*(y-1));
    if(d1>d2)  then  y:=y-1;
   end;
end;

Как можно нарисовать такой же круг, прорисовывая точки, по часовой стрелке?
Как на второй картинке.
Миниатюры
Алгоритм круга. Расставить точки по порядку   Алгоритм круга. Расставить точки по порядку  
0
Programming
Эксперт
39485 / 9562 / 3019
Регистрация: 12.04.2006
Сообщений: 41,671
Блог
03.01.2020, 13:07
Ответы с готовыми решениями:

Расставить элементы по порядку
Торможу. В массиве A в беспорядке находятся элементы 0, 1, 2. Переставить их так, чтобы сначала шли нули, потом единицы, а потом - двойки....

Расставить слова по алфавитному порядку
Товарищи помогите написать прогу)) Пользователь вводит в строку 2 слова, нужно расставить эти слова по алфавитному порядку. Не буквы, а...

Расставить строчки по порядку в функции dequeue и enqueue
Имплементация очереди чисел с помощью соединенного массива функция enquene вложить число на конец очереди,dequene удалит число с начала...

7
фрилансер
 Аватар для Алексей1153
6451 / 5652 / 1129
Регистрация: 11.10.2019
Сообщений: 15,054
03.01.2020, 13:46
Ученик_333, алгоритм Брезенхема вычисляет один квадрант, остальные три получает зеркальным отражением вокруг осей. Тем самым достигается дополнительный выигрыш в скорости отрисовки.

Если скорость отрисовки не в приоритете, то можешь запомнить путь отрисовки первого квадранта, затем в нужных местах и в нужном порядке вывести эти координаты (отзеркаливая их при этом, само собой)

Добавлено через 5 минут
ну и между выводом отдельных точек придётся искусственно паузу вводить, а то глаз просто не успеет рассмотреть, что там и в каком направлении рисуется

Добавлено через 4 минуты
Цитата Сообщение от Ученик_333 Посмотреть сообщение
sqrt(2)
и откуда взялся квадратный корень, в алгоритме Брезенхема только сложение и умножение
0
40 / 29 / 15
Регистрация: 07.02.2019
Сообщений: 126
03.01.2020, 14:00  [ТС]
Цитата Сообщение от Алексей1153 Посмотреть сообщение
Ученик_333, алгоритм Брезенхема вычисляет один квадрант, остальные три получает зеркальным отражением вокруг осей.
В этом алгоритме, даже 1 четверть круга и та идет не по порядку.
В прочем, методом тыка вроде расставил точки в 1 квадранте по порядку, но код большой получился.
Цитата Сообщение от Алексей1153 Посмотреть сообщение
и откуда взялся квадратный корень, в алгоритме Брезенхема только сложение и умножение
Может я алгоритм кривой с интернета скопировал))... Хотя круг рисует правильно.
0
фрилансер
 Аватар для Алексей1153
6451 / 5652 / 1129
Регистрация: 11.10.2019
Сообщений: 15,054
03.01.2020, 14:08
Цитата Сообщение от Ученик_333 Посмотреть сообщение
Может я алгоритм кривой с интернета скопировал
вот тут пример с анимацией (в конце страницы)

Добавлено через 1 минуту
точки первого квадранта -
Code
1
       drawpixel(X1 + x, Y1 + y)
а это отзеркаливание в остальные три
Code
1
2
3
       drawpixel(X1 + x, Y1 - y)
       drawpixel(X1 - x, Y1 + y)
       drawpixel(X1 - x, Y1 - y)
0
40 / 29 / 15
Регистрация: 07.02.2019
Сообщений: 126
03.01.2020, 15:28  [ТС]
Цитата Сообщение от Алексей1153 Посмотреть сообщение
вот тут пример с анимацией
Этот алгоритм расставляет точки по порядку, но почему-то овал вместо круга рисует?
Скопировал прямо с сайта и перевел в дельфи, на радиусе 2 рисует овал, на всех остальных получается круг, но в моем случае и на радиусе 2 нужен круг(
Кликните здесь для просмотра всего текста
Delphi
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
procedure TForm3.Button1Click(Sender: TObject);
var
R,j,x,y,X1,Y1,delta,error : integer;
begin
   // R - радиус, X1, Y1 - координаты центра
   X1 := 7;
   Y1 := 7;
   R := 2;
   x := 0;
   y := R;
   delta := 1 - 2 * R;
   error := 0;
   j := 0;
   while (y >= 0) do
   begin
       StringGrid1.Cells[X1 + x, Y1 + y] := '1';
       StringGrid1.Cells[X1 + x, Y1 - y] := inttostr(j);
       StringGrid1.Cells[X1 - x, Y1 + y] := '1';
       StringGrid1.Cells[X1 - x, Y1 - y] := '1';
       error := 2 * (delta + y) - 1;
       if ((delta < 0) and (error <= 0)) then
       begin
           x := x+1;
           delta := delta + 2 * x + 1;
           j := j+1;
           continue;
       end;
       if ((delta > 0) and (error > 0)) then
       begin
           y := y-1;
           delta := delta - 2 * y + 1;
           j := j+1;
           continue;
       end;
       x := x+1;
       delta := delta + 2 * (x - y);
       y := y-1;
       j := j+1;
   end;
end;

Нашел переделанное для дельфи, тут вообще везде овал
Кликните здесь для просмотра всего текста
Delphi
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
procedure TForm3.Button2Click(Sender: TObject);
var j,x,y,X1,Y1,R,error,delta : integer;
begin
 X1 := 7;
 Y1 := 7;
 R := 5;
 x := 0;
 y := R;
 delta := (2 - 2 * R);
 error := 0;
 j := 0;
 while y >= 0 do
 begin
  StringGrid1.Cells[X1 + x, Y1 + y] := '1';
  StringGrid1.Cells[X1 + x, Y1 - y] := inttostr(j);
  StringGrid1.Cells[X1 - x, Y1 + y] := '1';
  StringGrid1.Cells[X1 - x, Y1 - y] := '1';
  error := 2 * (delta + y) - 1;
  if ((delta < 0) and (error <= 0)) then
  begin
   inc(x);
   delta := delta + (2 * x + 1);
   inc(j);
   continue;
  end;
  error := 2 * (delta - x) - 1;
  if ((delta > 0) and (error > 0)) then
  begin
   dec(y);
   delta := delta + (1 - 2 * y);
   inc(j);
   continue;
  end;
  inc(x);
  delta := delta + (2 * (x - y));
  dec(y);
  inc(j);
 end;
end;
0
фрилансер
 Аватар для Алексей1153
6451 / 5652 / 1129
Регистрация: 11.10.2019
Сообщений: 15,054
03.01.2020, 15:42
тут точно "2" сразу после открывающей скобки?
Code
1
delta := (2 - 2 * R);
Добавлено через 4 минуты
Цитата Сообщение от Ученик_333 Посмотреть сообщение
на радиусе 2 рисует овал
мне кажется, это погрешность вычислений выползает. Попробуй на радиусах <=2 ограничивать максимальную координату. Тогда те острые уголки пропадут
1
40 / 29 / 15
Регистрация: 07.02.2019
Сообщений: 126
03.01.2020, 16:03  [ТС]
Цитата Сообщение от Алексей1153 Посмотреть сообщение
тут точно "2" сразу после открывающей скобки?
Не знаю как правильно) Скопировал как есть.
Вставил в первый алгоритм "delta := (2 - 2 * R);", уже больше походит на круг)

Цитата Сообщение от Алексей1153 Посмотреть сообщение
мне кажется, это погрешность вычислений выползает. Попробуй на радиусах <=2 ограничивать максимальную координату. Тогда те острые уголки пропадут
Да видимо погрешность, поменял пару значений, все равно овал получается)
Я вроде разобрался с громоздким алгоритмом, так-что пока думаю оставить все как есть.
0
40 / 29 / 15
Регистрация: 07.02.2019
Сообщений: 126
04.01.2020, 05:10  [ТС]
Вот медленный алгоритм отрисовки точек круга по порядку:
Круг по формуле Брезенхема (по часовой стрелке)
Delphi
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
procedure TForm3.Sircle(); // Нарисовать круг по формуле Брезенхема (точки по порядку - по часовой стрелке)
var
i2,i3,j,j2,j3,countOfPoints,count_1,number_1,x45,y45,
w_,h_,x,y,x_,y_,r_,x_2,y_2,d1,d2 : integer;
radian1: extended;
next_cikle: boolean;
begin
 // Очистить таблицу
 with StringGrid_1 do for i2:=0 to ColCount-1 do Cols[i2].Clear;
 
 w_:= StringGrid_1.ColCount; // Ширина таблицы (изображения)
 h_:= StringGrid_1.RowCount; // Высота таблицы (изображения)
 x_:= Trunc(StringGrid_1.ColCount/2); // Центр по X
 y_:= Trunc(StringGrid_1.RowCount/2); // Центр по Y
 r_:= TrackBar_1.Position;  // Радиус окружности
 //////////////////////////////////////////////////////////////
 
 countOfPoints := 0; // Отрисованное количество точек
 j2 := 0;
 j3 := 0;
 count_1 := round(r_/sqrt(2));  //sqrt квадратный корень
 radian1 := 45*pi/180; // Градусы в радианы
 x45 := x_+Round(cos (radian1) * r_);
 y45 := y_-Round(sin (radian1) * r_);
 
 for i3 := 0 to 3 do
 begin
  next_cikle := true;
  j := 0;
 
  for i2 := 0 to 1 do
  begin
   if (next_cikle=false) then
    j := j*2-1;
   x:=0;
   y:=r_;
   next_cikle := false;
 
   while ( x<=count_1 )
   do begin
    if (i2=0) then
    begin
     x_2 := x_+x;
     y_2 := y_-y;
 
     if (x_2=x45) and (y_2=y45) then
     begin
      x := count_1+1;
      j := j*2;
      next_cikle := true;
      break;
     end
     else
     if (x_2>x45) or (y_2>y45) then
     begin
      x := count_1+1;
      break;
     end;
     // Чтобы поменять последовательность, в строках "if (i3=...) then" заменить от 0..3 в каждой четверти
     {if (i3=0) then // 1 четверть
     begin
      x_2 := x_+x;        y_2 := y_-y;
     end
     else }
     if (i3=1) then // 2 четверть
     begin
      x_2 := x_+y;        y_2 := y_+x;
     end
     else
     if (i3=2) then // 3 четверть
     begin
      x_2 := x_-x;        y_2 := y_+y;
     end
     else
     if (i3=3) then // 4 четверть
     begin
      x_2 := x_-y;        y_2 := y_-x;
     end;
    end
    else
    begin
     x_2 := x_+y;
     y_2 := y_-x;
 
     if (x_2<x45) or (y_2<y45) then
     begin
      x := count_1+1;
      break;
     end;
     // Чтобы поменять последовательность, в строках "if (i3=...) then" заменить от 0..3 в каждой четверти
     {if (i3=0) then // 1 четверть
     begin
      x_2 := x_+y;        y_2 := y_-x;
     end
     else }
     if (i3=1) then // 2 четверть
     begin
      x_2 := x_+x;       y_2 := y_+y;
     end
     else
     if (i3=2) then // 3 четверть
     begin
      x_2 := x_-y;       y_2 := y_+x;
     end
     else
     if (i3=3) then // 4 четверть
     begin
      x_2 := x_-x;       y_2 := y_-y;
     end;
    end;
 
     if (i2=0) or (x>0) then
     if (x_2>-1) and (y_2>-1) and (x_2<w_) and (y_2<h_) then // Если в пределах таблицы (изображения)
     begin
      countOfPoints := countOfPoints+1; // Отрисованное количество точек
      number_1 := j+j3*i3; // Порядковый номер пикселя
 
      StringGrid_1.Cells[x_2,y_2] := inttostr(number_1); // Выделить точку на таблице (изображении)
     end;
 
    if (i2=0) then
    begin
     j := j+1;
     if (i3=0) then j2 := j2+1;
    end
    else
    begin
     j := j-1;
     if (i3=0) and (x>0) then j2 := j2+1;
    end;
 
    x:=x+1;
    d1:=ABS(r_*r_-x*x-y*y);
    d2:=ABS(r_*r_-x*x-(y-1)*(y-1));
    if(d1>d2)  then  y:=y-1;
   end;
  end;
  if (i3=0) then j3 := j2;
 end;
end;
Круг по формуле Брезенхема (против часовой стрелки)
Delphi
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
procedure TForm3.Sircle_Reverse(); // Нарисовать круг по формуле Брезенхема (точки по порядку - против часовой стрелки)
var
i2,i3,j,j2,j3,countOfPoints,count_1,number_1,x45,y45,
w_,h_,x,y,x_,y_,r_,x_2,y_2,d1,d2 : integer;
radian1: extended;
next_cikle: boolean;
begin
 // Очистить таблицу
 with StringGrid_1 do for i2:=0 to ColCount-1 do Cols[i2].Clear;
 
 w_:= StringGrid_1.ColCount; // Ширина таблицы (изображения)
 h_:= StringGrid_1.RowCount; // Высота таблицы (изображения)
 x_:= Trunc(StringGrid_1.ColCount/2); // Центр по X
 y_:= Trunc(StringGrid_1.RowCount/2); // Центр по Y
 r_:= TrackBar_1.Position;  // Радиус окружности
 //////////////////////////////////////////////////////////////
 
 countOfPoints := 0; // Отрисованное количество точек
 j2 := 0;
 j3 := 0;
 count_1 := round(r_/sqrt(2));  //sqrt квадратный корень
 radian1 := 45*pi/180; // Градусы в радианы
 x45 := x_+Round(cos (radian1) * r_);
 y45 := y_-Round(sin (radian1) * r_);
 
 for i3 := 0 to 3 do
 begin
  next_cikle := true;
  j := 0;
 
  for i2 := 1 downto 0 do
  begin
   if (next_cikle=false) then
    j := j*2-1;
   x:=0;
   y:=r_;
   next_cikle := false;
 
   while ( x<=count_1 )
   do begin
    if (i2=0) then
    begin
     x_2 := x_+x;
     y_2 := y_-y;
 
     if (x_2>x45) or (y_2>y45) then
     begin
      x := count_1+1;
      break;
     end;
     // Чтобы поменять последовательность, в строках "if (i3=...) then" заменить от 0..3 в каждой четверти
     {if (i3=3) then // 4 четверть
     begin
      x_2 := x_+x;        y_2 := y_-y;
     end
     else }
     if (i3=2) then // 3 четверть
     begin
      x_2 := x_+y;        y_2 := y_+x;
     end
     else
     if (i3=1) then // 2 четверть
     begin
      x_2 := x_-x;        y_2 := y_+y;
     end
     else
     if (i3=0) then // 1 четверть
     begin
      x_2 := x_-y;        y_2 := y_-x;
     end;
    end
    else
    begin
     x_2 := x_+y;
     y_2 := y_-x;
 
     if (x_2=x45) and (y_2=y45) then
     begin
      x := count_1+1;
      j := j*2;
      next_cikle := true;
      break;
     end
     else
     if (x_2<x45) or (y_2<y45) then
     begin
      x := count_1+1;
      break;
     end;
 
     // Чтобы поменять последовательность, в строках "if (i3=...) then" заменить от 0..3 в каждой четверти
     {if (i3=3) then // 4 четверть
     begin
      x_2 := x_+y;        y_2 := y_-x;
     end
     else }
     if (i3=2) then // 3 четверть
     begin
      x_2 := x_+x;       y_2 := y_+y;
     end
     else
     if (i3=1) then // 2 четверть
     begin
      x_2 := x_-y;       y_2 := y_+x;
     end
     else
     if (i3=0) then // 1 четверть
     begin
      x_2 := x_-x;       y_2 := y_-y;
     end;
    end;
 
     if (i2=1) or (x>0) then
     if (x_2>-1) and (y_2>-1) and (x_2<w_) and (y_2<h_) then // Если в пределах таблицы (изображения)
     begin
      countOfPoints := countOfPoints+1; // Отрисованное количество точек
      number_1 := j+j3*i3; // Порядковый номер пикселя
 
      StringGrid_1.Cells[x_2,y_2] := inttostr(number_1); // Выделить точку на таблице (изображении)
     end;
 
    if (i2=1) then
    begin
     j := j+1;
     if (i3=0) then j2 := j2+1;
    end
    else
    begin
     j := j-1;
     if (i3=0) and (x>0) then j2 := j2+1;
    end;
 
    x:=x+1;
    d1:=ABS(r_*r_-x*x-y*y);
    d2:=ABS(r_*r_-x*x-(y-1)*(y-1));
    if(d1>d2)  then  y:=y-1;
   end;
  end;
  if (i3=0) then j3 := j2;
 end;
end;
Круг по формуле Брезенхема (Пример Delphi)
Delphi
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
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
unit Unit3;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.Grids, Vcl.ComCtrls;
 
type
  TForm3 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure TrackBar_1Change(Sender: TObject); // Изменение позиции ползунка (по часовой)
    procedure TrackBar_2Change(Sender: TObject); // Изменение позиции ползунка (против часовой)
    procedure Sircle();         // Нарисовать круг по формуле Брезенхема (точки по порядку - по часовой стрелке)
    procedure Sircle_Reverse(); // Нарисовать круг по формуле Брезенхема (точки по порядку - против часовой стрелки)
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form3: TForm3;
  TrackBar_1,
  TrackBar_2: TTrackBar;
  StringGrid_1: TStringGrid;
implementation
 
{$R *.dfm}
 
procedure TForm3.FormCreate(Sender: TObject);
var
i,StrCellWidth,StrFontSize:integer;
begin
 Form3.Width := Screen.Width-60;
 Form3.Height := Screen.Height-100;
 if (Form3.Width<Form3.Height) then
  Form3.Height := Form3.Width
 else Form3.Width := Form3.Height;
 
 Form3.Left := (Screen.Width div 2) - (Form3.Width div 2);
 Form3.Top := (Screen.Height div 2) - (Form3.Height div 2) - 20;
 if Form3.Top<0 then Form3.Top := 0;
 
 StrCellWidth := 20; // Ширина квадрата в "StringGrid"
 StrFontSize := round(StrCellWidth/2.5); // Размер шрифта
 
 StringGrid_1 := TStringGrid.Create( Form3 );  // Создать таблицу
 with StringGrid_1 do
 begin
  Parent := Form3;
  Left := 0;
  Top := 0;
  RowCount := Trunc((Form3.ClientHeight)/StrCellWidth)-6;
  ColCount := Trunc((Form3.ClientWidth)/StrCellWidth)-5;
 
  FixedCols := 0;
  FixedRows := 0;
  Options := [goVertLine,goHorzLine,goEditing,goRangeSelect];
 
  Font.Size := StrFontSize; // Размер шрифта
 
   for i := 0 to RowCount-1 do
    RowHeights[i] := StrCellWidth;
 
   for i := 0 to ColCount-1 do
    ColWidths[i] := StrCellWidth;
 
  Width := ColCount*ColWidths[0]+ColWidths[0]+StrCellWidth*4;
  Height := RowCount*RowHeights[0]+RowHeights[0]+StrCellWidth*3;
 end;
 
 TrackBar_1 := TTrackBar.Create( Form3 );  // Создать ползунок (по часовой)
 with TrackBar_1 do
 begin
  Parent := Form3;
  Width := Trunc(Form3.ClientWidth/2.1);
  Height := 25;
  Left := (Form3.ClientWidth div 4) - (Width div 2);
  Top := StringGrid_1.Top+StringGrid_1.Height+10;
  if (StringGrid_1.RowCount>StringGrid_1.ColCount) then
   Max := Trunc(StringGrid_1.RowCount/2)+10
  else Max := Trunc(StringGrid_1.ColCount/2)+10;
  Position := Trunc(Max/2);
  OnChange := TrackBar_1Change; // По изменению позиции ползунка
 end;
 
 TrackBar_2 := TTrackBar.Create( Form3 );  // Создать ползунок (против часовой)
 with TrackBar_2 do
 begin
  Parent := Form3;
  Width := Trunc(Form3.ClientWidth/2.1);
  Height := 25;
  Left := Form3.ClientWidth-((Form3.ClientWidth div 4)) - (Width div 2);
  Top := StringGrid_1.Top+StringGrid_1.Height+10;
  if (StringGrid_1.RowCount>StringGrid_1.ColCount) then
   Max := Trunc(StringGrid_1.RowCount/2)+10
  else Max := Trunc(StringGrid_1.ColCount/2)+10;
  Position := Trunc(Max/2);
  OnChange := TrackBar_2Change; // По изменению позиции ползунка
 end;
 
 Sircle(); // Нарисовать круг по формуле Брезенхема (точки по порядку - по часовой стрелке)
end;
 
procedure TForm3.TrackBar_1Change(Sender: TObject);
begin
 Form3.Caption := 'Радиус: '+inttostr(TrackBar_1.Position);
 
 Sircle(); // Нарисовать круг по формуле Брезенхема (точки по порядку - по часовой стрелке)
end;
 
procedure TForm3.TrackBar_2Change(Sender: TObject);
begin
 Form3.Caption := 'Радиус: '+inttostr(TrackBar_2.Position);
 
 Sircle_Reverse(); // Нарисовать круг по формуле Брезенхема (точки по порядку - против часовой стрелки)
end;
 
procedure TForm3.Sircle(); // Нарисовать круг по формуле Брезенхема (точки по порядку - по часовой стрелке)
var
i2,i3,j,j2,j3,countOfPoints,count_1,number_1,x45,y45,
w_,h_,x,y,x_,y_,r_,x_2,y_2,d1,d2 : integer;
radian1: extended;
next_cikle: boolean;
begin
 // Очистить таблицу
 with StringGrid_1 do for i2:=0 to ColCount-1 do Cols[i2].Clear;
 
 w_:= StringGrid_1.ColCount; // Ширина таблицы (изображения)
 h_:= StringGrid_1.RowCount; // Высота таблицы (изображения)
 x_:= Trunc(StringGrid_1.ColCount/2); // Центр по X
 y_:= Trunc(StringGrid_1.RowCount/2); // Центр по Y
 r_:= TrackBar_1.Position;  // Радиус окружности
 //////////////////////////////////////////////////////////////
 
 countOfPoints := 0; // Отрисованное количество точек
 j2 := 0;
 j3 := 0;
 count_1 := round(r_/sqrt(2));  //sqrt квадратный корень
 radian1 := 45*pi/180; // Градусы в радианы
 x45 := x_+Round(cos (radian1) * r_);
 y45 := y_-Round(sin (radian1) * r_);
 
 for i3 := 0 to 3 do
 begin
  next_cikle := true;
  j := 0;
 
  for i2 := 0 to 1 do
  begin
   if (next_cikle=false) then
    j := j*2-1;
   x:=0;
   y:=r_;
   next_cikle := false;
 
   while ( x<=count_1 )
   do begin
    if (i2=0) then
    begin
     x_2 := x_+x;
     y_2 := y_-y;
 
     if (x_2=x45) and (y_2=y45) then
     begin
      x := count_1+1;
      j := j*2;
      next_cikle := true;
      break;
     end
     else
     if (x_2>x45) or (y_2>y45) then
     begin
      x := count_1+1;
      break;
     end;
     // Чтобы поменять последовательность, в строках "if (i3=...) then" заменить от 0..3 в каждой четверти
     {if (i3=0) then // 1 четверть
     begin
      x_2 := x_+x;        y_2 := y_-y;
     end
     else }
     if (i3=1) then // 2 четверть
     begin
      x_2 := x_+y;        y_2 := y_+x;
     end
     else
     if (i3=2) then // 3 четверть
     begin
      x_2 := x_-x;        y_2 := y_+y;
     end
     else
     if (i3=3) then // 4 четверть
     begin
      x_2 := x_-y;        y_2 := y_-x;
     end;
    end
    else
    begin
     x_2 := x_+y;
     y_2 := y_-x;
 
     if (x_2<x45) or (y_2<y45) then
     begin
      x := count_1+1;
      break;
     end;
     // Чтобы поменять последовательность, в строках "if (i3=...) then" заменить от 0..3 в каждой четверти
     {if (i3=0) then // 1 четверть
     begin
      x_2 := x_+y;        y_2 := y_-x;
     end
     else }
     if (i3=1) then // 2 четверть
     begin
      x_2 := x_+x;       y_2 := y_+y;
     end
     else
     if (i3=2) then // 3 четверть
     begin
      x_2 := x_-y;       y_2 := y_+x;
     end
     else
     if (i3=3) then // 4 четверть
     begin
      x_2 := x_-x;       y_2 := y_-y;
     end;
    end;
 
     if (i2=0) or (x>0) then
     if (x_2>-1) and (y_2>-1) and (x_2<w_) and (y_2<h_) then // Если в пределах таблицы (изображения)
     begin
      countOfPoints := countOfPoints+1; // Отрисованное количество точек
      number_1 := j+j3*i3; // Порядковый номер пикселя
 
      StringGrid_1.Cells[x_2,y_2] := inttostr(number_1); // Выделить точку на таблице (изображении)
     end;
 
    if (i2=0) then
    begin
     j := j+1;
     if (i3=0) then j2 := j2+1;
    end
    else
    begin
     j := j-1;
     if (i3=0) and (x>0) then j2 := j2+1;
    end;
 
    x:=x+1;
    d1:=ABS(r_*r_-x*x-y*y);
    d2:=ABS(r_*r_-x*x-(y-1)*(y-1));
    if(d1>d2)  then  y:=y-1;
   end;
  end;
  if (i3=0) then j3 := j2;
 end;
end;
 
procedure TForm3.Sircle_Reverse(); // Нарисовать круг по формуле Брезенхема (точки по порядку - против часовой стрелки)
var
i2,i3,j,j2,j3,countOfPoints,count_1,number_1,x45,y45,
w_,h_,x,y,x_,y_,r_,x_2,y_2,d1,d2 : integer;
radian1: extended;
next_cikle: boolean;
begin
 // Очистить таблицу
 with StringGrid_1 do for i2:=0 to ColCount-1 do Cols[i2].Clear;
 
 w_:= StringGrid_1.ColCount; // Ширина таблицы (изображения)
 h_:= StringGrid_1.RowCount; // Высота таблицы (изображения)
 x_:= Trunc(StringGrid_1.ColCount/2); // Центр по X
 y_:= Trunc(StringGrid_1.RowCount/2); // Центр по Y
 r_:= TrackBar_2.Position;  // Радиус окружности
 //////////////////////////////////////////////////////////////
 
 countOfPoints := 0; // Отрисованное количество точек
 j2 := 0;
 j3 := 0;
 count_1 := round(r_/sqrt(2));  //sqrt квадратный корень
 radian1 := 45*pi/180; // Градусы в радианы
 x45 := x_+Round(cos (radian1) * r_);
 y45 := y_-Round(sin (radian1) * r_);
 
 for i3 := 0 to 3 do
 begin
  next_cikle := true;
  j := 0;
 
  for i2 := 1 downto 0 do
  begin
   if (next_cikle=false) then
    j := j*2-1;
   x:=0;
   y:=r_;
   next_cikle := false;
 
   while ( x<=count_1 )
   do begin
    if (i2=0) then
    begin
     x_2 := x_+x;
     y_2 := y_-y;
 
     if (x_2>x45) or (y_2>y45) then
     begin
      x := count_1+1;
      break;
     end;
     // Чтобы поменять последовательность, в строках "if (i3=...) then" заменить от 0..3 в каждой четверти
     {if (i3=3) then // 4 четверть
     begin
      x_2 := x_+x;        y_2 := y_-y;
     end
     else }
     if (i3=2) then // 3 четверть
     begin
      x_2 := x_+y;        y_2 := y_+x;
     end
     else
     if (i3=1) then // 2 четверть
     begin
      x_2 := x_-x;        y_2 := y_+y;
     end
     else
     if (i3=0) then // 1 четверть
     begin
      x_2 := x_-y;        y_2 := y_-x;
     end;
    end
    else
    begin
     x_2 := x_+y;
     y_2 := y_-x;
 
     if (x_2=x45) and (y_2=y45) then
     begin
      x := count_1+1;
      j := j*2;
      next_cikle := true;
      break;
     end
     else
     if (x_2<x45) or (y_2<y45) then
     begin
      x := count_1+1;
      break;
     end;
 
     // Чтобы поменять последовательность, в строках "if (i3=...) then" заменить от 0..3 в каждой четверти
     {if (i3=3) then // 4 четверть
     begin
      x_2 := x_+y;        y_2 := y_-x;
     end
     else }
     if (i3=2) then // 3 четверть
     begin
      x_2 := x_+x;       y_2 := y_+y;
     end
     else
     if (i3=1) then // 2 четверть
     begin
      x_2 := x_-y;       y_2 := y_+x;
     end
     else
     if (i3=0) then // 1 четверть
     begin
      x_2 := x_-x;       y_2 := y_-y;
     end;
    end;
 
     if (i2=1) or (x>0) then
     if (x_2>-1) and (y_2>-1) and (x_2<w_) and (y_2<h_) then // Если в пределах таблицы (изображения)
     begin
      countOfPoints := countOfPoints+1; // Отрисованное количество точек
      number_1 := j+j3*i3; // Порядковый номер пикселя
 
      StringGrid_1.Cells[x_2,y_2] := inttostr(number_1); // Выделить точку на таблице (изображении)
     end;
 
    if (i2=1) then
    begin
     j := j+1;
     if (i3=0) then j2 := j2+1;
    end
    else
    begin
     j := j-1;
     if (i3=0) and (x>0) then j2 := j2+1;
    end;
 
    x:=x+1;
    d1:=ABS(r_*r_-x*x-y*y);
    d2:=ABS(r_*r_-x*x-(y-1)*(y-1));
    if(d1>d2)  then  y:=y-1;
   end;
  end;
  if (i3=0) then j3 := j2;
 end;
end;
 
end.
Вложения
Тип файла: 7z Круг (по формуле Брезенхема).7z (2.10 Мб, 1 просмотров)
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
inter-admin
Эксперт
29715 / 6470 / 2152
Регистрация: 06.03.2009
Сообщений: 28,500
Блог
04.01.2020, 05:10
Помогаю со студенческими работами здесь

В строке по алфавитному порядку расставить символы! Очень нужно!
Дана строка. Напечатать в алфавитном порядке все слова из заданной строки, имеющие длину n . Просьба написать попроще , чтобы было...

В массиве расставить элементы в порядку возрастания их абсолютных значений
В массиве вещественного типа расставить элементы в порядку возрастания их абсолютных значений.

Даны координаты центра круга и его радиус, а также координаты точки. Лежит ли эта точка внутри круга?
Даны координаты центра круга и его радиус, а также координаты точки. Лежит ли эта точка внутри круга?

Найти расстояние от точки (x; y) на плоскости до ближайшей точки единичного круга - Pascal ABC
Прошу помочь разобраться в данной теме. Как вообще решать данного типа задачи? Даны координаты точки на плоскости (x; y). Надо найти...

Расставить точки в mysqli_free_result
Прошу внести ясность в функцию mysqli_free_result() , и прокомментировать изложенную ниже информацию При выполнении скрипта...


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

Или воспользуйтесь поиском по форуму:
8
Ответ Создать тему
Новые блоги и статьи
Воспроизведение звукового файла с помощью SDL3_mixer при касании экрана Android
8Observer8 26.01.2026
Содержание блога SDL3_mixer - это библиотека я для воспроизведения аудио. В отличие от инструкции по добавлению текста код по проигрыванию звука уже содержится в шаблоне примера. Нужно только. . .
Установка Android SDK, NDK, JDK, CMake и т.д.
8Observer8 25.01.2026
Содержание блога Перейдите по ссылке: https:/ / developer. android. com/ studio и в самом низу страницы кликните по архиву "commandlinetools-win-xxxxxx_latest. zip" Извлеките архив и вы увидите. . .
Вывод текста со шрифтом TTF на Android с помощью библиотеки SDL3_ttf
8Observer8 25.01.2026
Содержание блога Если у вас не установлены Android SDK, NDK, JDK, и т. д. то сделайте это по следующей инструкции: Установка Android SDK, NDK, JDK, CMake и т. д. Сборка примера Скачайте. . .
Использование SDL3-callbacks вместо функции main() на Android, Desktop и WebAssembly
8Observer8 24.01.2026
Содержание блога Если вы откроете примеры для начинающих на официальном репозитории SDL3 в папке: examples, то вы увидите, что все примеры используют следующие четыре обязательные функции, а. . .
моя боль
iceja 24.01.2026
Выложила интерполяцию кубическими сплайнами www. iceja. net REST сервисы временно не работают, только через Web. Написала за 56 рабочих часов этот сайт с нуля. При помощи perplexity. ai PRO , при. . .
Модель сукцессии микоризы
anaschu 24.01.2026
Решили писать научную статью с неким РОманом
http://iceja.net/ математические сервисы
iceja 20.01.2026
Обновила свой сайт http:/ / iceja. net/ , приделала Fast Fourier Transform экстраполяцию сигналов. Однако предсказывает далеко не каждый сигнал (см ограничения http:/ / iceja. net/ fourier/ docs ). Также. . .
http://iceja.net/ сервер решения полиномов
iceja 18.01.2026
Выкатила http:/ / iceja. net/ сервер решения полиномов (находит действительные корни полиномов методом Штурма). На сайте документация по API, но скажу прямо VPS слабенький и 200 000 полиномов. . .
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2026, CyberForum.ru