Форум программистов, компьютерный форум, киберфорум
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
Рейтинг 5.00/6: Рейтинг темы: голосов - 6, средняя оценка - 5.00
0 / 0 / 0
Регистрация: 19.12.2018
Сообщений: 19
1
Delphi 6-7

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

22.10.2019, 19:24. Просмотров 1110. Ответов 7

Помогите пожалуйста сделать или разобраться, нужно сделать на форме произвольный многоугольник, на вершины которого можно кликнуть и перетащить их, этим изменив его форму. Я так понял это нужно делать через метод Polygon, но не могу найти нормального объяснения как им пользоваться.
0
Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
22.10.2019, 19:24
Ответы с готовыми решениями:

Перетащить pictureBox на форме и сделать его копию
Добрых времени суток. Задача состотит в том что бы создать копию имеющегося pictureBox'a в нужном...

Как сделать, чтобы форму можно было перетащить не только за самый верх?
Добрый день! Подскажите пожалуйста, как сделать, чтобы форму можно было перетащить не только за...

Построить выпуклый многоугольник, вершины которого — заданные точки
Подскажите,пожалуйста,как решается такая задача: дано множество точек, построить выпуклый...

Построить произвольный многоугольник, закрасить его выбранным цветом и стилем
Построить произвольный многоугольник, закрасить его выбранным цветом и стилем. Для выбора стиля...

__________________
7
880 / 583 / 178
Регистрация: 28.02.2017
Сообщений: 2,359
Записей в блоге: 1
22.10.2019, 23:46 2
Лучший ответ Сообщение было отмечено Wector как решение

Решение

Вам нужно обрабатывать события: 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.
1
0 / 0 / 0
Регистрация: 19.12.2018
Сообщений: 19
23.10.2019, 00:31  [ТС] 3
Я уже успел настрогать вот в таким виде, построение фигуры, изменение формы и смену цвета она обеспечивает, но на закрытии выдает 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.
0
0 / 0 / 0
Регистрация: 19.12.2018
Сообщений: 19
23.10.2019, 13:36  [ТС] 4
Нашел эту глупую ошибку походу, нужно было исправить в этом цикле 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 минуты
Уже разобрался в остальном сам и доделал) спасибо за заготовку
0
2007 / 998 / 368
Регистрация: 15.11.2015
Сообщений: 4,037
23.10.2019, 13:55 5
Ещё вариант с подсвечивающимися вершинами:
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.
1
Продавец времени
4989 / 2754 / 630
Регистрация: 12.03.2015
Сообщений: 13,332
23.10.2019, 14:01 6
Лет 100500 назад я писал такую лабу для кого-то. Не совсем такую, там квадрат был.
2
Миниатюры
Сделать на форме произвольный многоугольник, на вершины которого можно кликнуть и перетащить их, изменив его форму  
Вложения
Тип файла: 7z pf_287492.7z (558.7 Кб, 4 просмотров)
880 / 583 / 178
Регистрация: 28.02.2017
Сообщений: 2,359
Записей в блоге: 1
23.10.2019, 15:52 7
Wector, смотрите, если у вас метод (функция/процедура класса) начинается с { Procedure или Function } TForm1., то писать внутри неё Form1. очень не нужно.
Вместо глобальных переменных это всё надо было указывать в полях класса, т.е. вместо { Private declarations }. А устанавливать им значения в FormCreate.
Рисовать следует только в FormPaint, а при нажатиях кнопок лишь менять значения настроек и вызывать перерисовку Repaint();. InvalidateRect() это WinAPI-функция, в VCL-проекте не надо её трогать.
1
0 / 0 / 0
Регистрация: 19.12.2018
Сообщений: 19
23.10.2019, 15:58  [ТС] 8
Спасибо большое
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
23.10.2019, 15:58

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

Как в форме Access сделать список, из которого можно выбрать не одно, а несколько значений?
Всем здравствуйте! Я совсем еще новичок в Аccess, поэтому очень прошу помочь: Как сделать форму...


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

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

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