Сделать на форме произвольный многоугольник, на вершины которого можно кликнуть и перетащить их, изменив его форму

@Wector · Регистрация: 19.12.2018

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

Помогите пожалуйста сделать или разобраться, нужно сделать на форме произвольный многоугольник, на вершины которого можно кликнуть и перетащить их, этим изменив его форму. Я так понял это нужно делать через метод Polygon, но не могу найти нормального объяснения как им пользоваться.

@GoodWeather · 22.10.2019, 23:46

Вам нужно обрабатывать события: OnResize / OnPaint / OnMouseDown / OnMouseMove / OnMouseUp.
Потребуется хранить в полях класса массив из точек, динамический или статический - зависит от задания.

Добавлено через 1 час 50 минут
Не успел доделать, но вот вам заготовка:

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
Unit Unit1;
 
Interface
 
Uses
  Windows,
  Classes,
  Graphics,
  Controls,
  Forms;
 
Type
  TForm1 = Class(TForm)
    Procedure FormResize(Sender: TObject);
    Procedure FormPaint(Sender: TObject);
    Procedure FormCreate(Sender: TObject);
    Procedure FormDestroy(Sender: TObject);
    Procedure FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
    Procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    Procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  Private
    Points: Array Of TPoint;
    BackgroundColor: TColor;
    LinesColor: TColor;
    PointsColor: TColor;
    HoveredColor: TColor;
    HoveredIndex: Integer;
  Public
  End;
 
Var
  Form1: TForm1;
 
Implementation
 
{$R *.dfm}
 
Procedure TForm1.FormCreate(Sender: TObject);
Begin
SetLength(Points, 4);
Points[0] := Point(10, 10);
Points[1] := Point(200, 60);
Points[2] := Point(180, 100);
Points[3] := Point(50, 50);
BackgroundColor := Color;
LinesColor := clBlue;
PointsColor := clRed;
HoveredColor := clLime;
HoveredIndex := Low(Points) - 1;
End;
 
Procedure TForm1.FormDestroy(Sender: TObject);
Begin
SetLength(Points, 0);
End;
 
Procedure TForm1.FormResize(Sender: TObject);
Begin
Repaint();
End;
 
Procedure TForm1.FormPaint(Sender: TObject);
Var
  i: Integer;
Begin
With Canvas Do
  Begin
  Lock();
  Brush.Color := BackgroundColor;
  FillRect(ClipRect);
  Pen.Color := LinesColor;
  Polygon(Points);
  Brush.Color := PointsColor;
  For i := Low(Points) To High(Points) Do
    Begin
    If (i = HoveredIndex) Then
      Brush.Color := HoveredColor;
    Ellipse(Points[i].X - 5, Points[i].Y - 5, Points[i].X + 5, Points[i].Y + 5);
    If (i = HoveredIndex) Then
      Brush.Color := PointsColor;
    End;
  Unlock();
  End;
End;
 
Procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Var
  i: Integer;
Begin
HoveredIndex := Low(Points) - 1;
For i := Low(Points) To High(Points) Do
  If (PtInRect(Rect(Points[i].X - 5, Points[i].Y - 5, Points[i].X + 5, Points[i].Y + 5), Point(X, Y))) Then
    Begin
    HoveredIndex := i;
    Repaint();
    Break;
    End;
End;
 
Procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
Begin
If (HoveredIndex > Low(Points) - 1) Then
  Begin
  End;
End;
 
Procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Begin
HoveredIndex := Low(Points) - 1;
Repaint();
End;
 
End.

@Wector · 23.10.2019, 00:31 **[ТС]**

Я уже успел настрогать вот в таким виде, построение фигуры, изменение формы и смену цвета она обеспечивает, но на закрытии выдает invalid pointer operation, скорее всего связанную с динамическим массивом, пытался поставить nil на событие onclosequery, но не помогло, каким образом можно сделать это при закрытии программы? Или может проблема в другом? И еще вопрос насчет того каким образом можно сохранить и считывать из файла этот динамический массив? Заранее извиняюсь за возможно глупые вопросы или косяки в программе, но я далеко не самый опытный программист.

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
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  pol:array of TPoint;
  i,ver,r,m:Integer;
  u:Extended;
  perem:TPoint;
  flag:Boolean;
implementation
 
{$R *.dfm}
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 
  for i:=0 to ver  do
  begin
    pol[i].X:=500+round(r*cos(u));
    pol[i].Y:=250-round(r*sin(u));
    u:=u+2*pi/ver;
  end;
Canvas.Brush.Color:=clyellow;
Form1.Canvas.Polygon(pol);
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
  for i:=0 to ver do
  begin
    if (pol[i].X=X) and (pol[i].y=y) then  begin flag:=true; perem.X:=pol[i].x; perem.Y:=pol[i].Y; m:=i; end;
  end;
end;
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
begin
  if Flag then
  begin
  pol[m].X:=x;
  pol[m].y:=y;
  InvalidateRect(0, nil, true);
  Form1.Canvas.Polygon(pol);
  end;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;Shift: TShiftState; X, Y: Integer);
begin
  flag := false;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  Canvas.Brush.Color:=clyellow;
  InvalidateRect(0, nil, true);
  Form1.Canvas.Polygon(pol);
end;
 
procedure TForm1.Button3Click(Sender: TObject);
begin
Canvas.Brush.Color:=clGreen;
InvalidateRect(0, nil, true);
Form1.Canvas.Polygon(pol);
end;
 
procedure TForm1.Button4Click(Sender: TObject);
begin
Canvas.Brush.Color:=clred;
InvalidateRect(0, nil, true);
Form1.Canvas.Polygon(pol);
end;
 
procedure TForm1.Button5Click(Sender: TObject);
begin
Canvas.Brush.Color:=clGray;
InvalidateRect(0, nil, true);
Form1.Canvas.Polygon(pol);
end;
 
procedure TForm1.Button6Click(Sender: TObject);
begin
Canvas.Brush.Color:=clAqua;
InvalidateRect(0, nil, true);
Form1.Canvas.Polygon(pol);
end;
 
 
 
begin
 pol:=nil;
 ver:=3;
 SetLength(pol, ver);
 r:=200;
 u:=0;
 
end.

@Wector · 23.10.2019, 13:36 **[ТС]**

Нашел эту глупую ошибку походу, нужно было исправить в этом цикле for i:=0 to ver-1 do, лишний элемент заполнялся

Сообщение от Wector

for i:=0 to ver *do
* begin
* * pol[i].X:=500+round(r*cos(u));
* * pol[i].Y:=250-round(r*sin(u));
* * u:=u+2*pi/ver;
* end;

Добавлено через 1 час 3 минуты
Уже разобрался в остальном сам и доделал) спасибо за заготовку

@AzAtom · 23.10.2019, 13:55

Ещё вариант с подсвечивающимися вершинами:

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
type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    pol: array of TPoint;
    cpoint: integer;
    polcol: TColor;
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
var
  i, r, vcnt: integer;
begin
  r := 100;
  vcnt := 5;
  SetLength(pol, vcnt);
  for i := 0 to High(pol) do begin
    pol[i].X := 500 + round(r * cos(i*2*pi/vcnt));
    pol[i].Y := 250 - round(r * sin(i*2*pi/vcnt));
  end;
  cpoint := -1;
  polcol := clBtnFace;
end;
 
procedure TForm1.FormPaint(Sender: TObject);
var
  i: integer;
begin
  Canvas.Brush.Color := polcol;
  Canvas.Polygon(pol);
  Canvas.Brush.Color := clRed;
  for i := 0 to High(pol) do
    Canvas.Rectangle(pol[i].X - 5, pol[i].Y - 5, pol[i].X + 5, pol[i].Y + 5);
end;
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  i: integer;
begin
  for i := 0 to High(pol) do begin
    if (PtInRect(Rect(pol[i].X - 5, pol[i].Y - 5, pol[i].X + 5, pol[i].Y + 5), Point(X, Y))) then
      cpoint := i;
  end;
end;
 
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if cpoint >= 0 then begin
    pol[cpoint].X := X;
    pol[cpoint].Y := Y;
    Repaint;
  end;
end;
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  cpoint := -1;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
  polcol := clBtnFace;
  Repaint;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  polcol := clYellow;
  Repaint;
end;
 
procedure TForm1.Button3Click(Sender: TObject);
begin
  polcol := clRed;
  Repaint;
end;
 
procedure TForm1.Button4Click(Sender: TObject);
begin
  polcol := clLime;
  Repaint;
end;
 
procedure TForm1.Button5Click(Sender: TObject);
begin
  polcol := clBlue;
  Repaint;
end;
 
end.

Verevkin · 23.10.2019, 14:01

Лет 100500 назад я писал такую лабу для кого-то. Не совсем такую, там квадрат был.

@GoodWeather · 23.10.2019, 15:52

Wector, смотрите, если у вас метод (функция/процедура класса) начинается с { Procedure или Function } TForm1., то писать внутри неё Form1. очень не нужно.
Вместо глобальных переменных это всё надо было указывать в полях класса, т.е. вместо { Private declarations }. А устанавливать им значения в FormCreate.
Рисовать следует только в FormPaint, а при нажатиях кнопок лишь менять значения настроек и вызывать перерисовку Repaint();. InvalidateRect() это WinAPI-функция, в VCL-проекте не надо её трогать.

@Wector · 23.10.2019, 15:58 **[ТС]**

Спасибо большое

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Desktop (MinGW): Создаём пустое окно с нуля для 2D-графики на SDL3, Си и C++ 8Observer8 10.03.2026 Содержание блога Финальные проекты на Си и на C++: hello-sdl3-c. zip hello-sdl3-cpp. zip Результат:	Установка CMake и MinGW 13.1 для сборки С и C++ приложений из консоли и из Qt Creator в EXE 8Observer8 10.03.2026 Содержание блога MinGW - это коллекция инструментов для сборки приложений в EXE. CMake - это система сборки приложений. Здесь описаны базовые шаги для старта программирования с помощью CMake и. . .	Как дизайн сайта влияет на конверсию: 7 решений, которые реально повышают заявки Neotwalker 08.03.2026 Многие до сих пор воспринимают дизайн сайта как “красивую оболочку”. На практике всё иначе: дизайн напрямую влияет на то, оставит человек заявку или уйдёт через несколько секунд. Даже если у вас. . .	Модульная разработка через nuget packages DevAlt 07.03.2026 Сложившийся в . Net-среде способ разработки чаще всего предполагает монорепозиторий в котором находятся все исходники. При создании нового решения, мы просто добавляем нужные проекты и имеем. . .
Модульный подход на примере F# DevAlt 06.03.2026 В блоге дяди Боба наткнулся на такое определение: В этой книге («Подход, основанный на вариантах использования») Ивар утверждает, что архитектура программного обеспечения — это структуры,. . .	Управление камерой с помощью скрипта OrbitControls.js на Three.js: Вращение, зум и панорамирование 8Observer8 05.03.2026 Содержание блога Финальная демка в браузере работает на Desktop и мобильных браузерах. Итоговый код: orbit-controls-threejs-js. zip. Сканируйте QR-код на мобильном. Вращайте камеру одним пальцем,. . .	SDL3 для Web (WebAssembly): Синхронизация спрайтов SDL3 и тел Box2D 8Observer8 04.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-sync-physics-sprites-sdl3-c. zip На первой гифке отладочные линии отключены, а на второй включены:. . .	SDL3 для Web (WebAssembly): Идентификация объектов на Box2D v3 - использование userData и событий коллизий 8Observer8 02.03.2026 Содержание блога Финальная демка в браузере. Итоговый код: finish-collision-events-sdl3-c. zip Сканируйте QR-код на мобильном и вы увидите, что появится джойстик для управления главным героем. . . .

@Wector 0 / 0 / 0 Регистрация: 19.12.2018 Сообщений: 19

	Delphi 6-7 Сделать на форме произвольный многоугольник, на вершины которого можно кликнуть и перетащить их, изменив его форму 22.10.2019, 19:24. Показов 1619. Ответов 7 Метки delphi 7, фигура (Все метки) Помогите пожалуйста сделать или разобраться, нужно сделать на форме произвольный многоугольник, на вершины которого можно кликнуть и перетащить их, этим изменив его форму. Я так понял это нужно делать через метод Polygon, но не могу найти нормального объяснения как им пользоваться. 0

@GoodWeather 886 / 588 / 179 Регистрация: 28.02.2017 Сообщений: 2,359 Записей в блоге: 1
	23.10.2019, 15:52
	Wector, смотрите, если у вас метод (функция/процедура класса) начинается с `{ Procedure или Function } TForm1.`, то писать внутри неё `Form1.` очень не нужно. Вместо глобальных переменных это всё надо было указывать в полях класса, т.е. вместо `{ Private declarations }`. А устанавливать им значения в `FormCreate`. Рисовать следует только в `FormPaint`, а при нажатиях кнопок лишь менять значения настроек и вызывать перерисовку `Repaint();`. `InvalidateRect()` это WinAPI-функция, в VCL-проекте не надо её трогать. 1

@Wector 0 / 0 / 0 Регистрация: 19.12.2018 Сообщений: 19
	23.10.2019, 15:58 [ТС]
	Спасибо большое 0

Сделать на форме произвольный многоугольник, на вершины которого можно кликнуть и перетащить их, изменив его форму

Решение