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
| unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, ExtCtrls, StdCtrls, TeEngine, Series, TeeProcs, Chart;
type // точка на плоскости
Point = record
X : Extended;
Y : Extended;
end;
TForm1 = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
OpenDialog1: TOpenDialog;
Panel1: TPanel;
Memo1: TMemo;
Button1: TButton;
Button2: TButton;
SaveDialog1: TSaveDialog;
Chart1: TChart;
Series1: TPointSeries;
Button3: TButton;
Series2: TPointSeries;
Label1: TLabel;
Series3: TLineSeries;
Button4: TButton;
procedure N2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
function ParseString(str: string;var cnt:integer):TStringlist;
procedure Button3Click(Sender: TObject);
function FindCentreCircle(a,b,c : Point; var r : extended):Point;
function SquareThreeAngle(a,b,c : Point): extended;
function InTA(a,b,c,O : Point): boolean;
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
pnts : array of Point;
implementation
uses Math;
{$R *.dfm}
procedure TForm1.N2Click(Sender: TObject);// открываем файл посредством компонента OpenDialog
begin
memo1.Lines.Clear;//очищаем memo1
if OpenDialog1.Execute then //открываем диалог для выбора файла и загружаем содержимое в memo1
Memo1.Lines.LoadFromFile(OpenDialog1.FileName);
end;
procedure TForm1.Button1Click(Sender: TObject);// считываем в массив координаты из файла загруженного в memo
var i,cnt,tmp : integer; // считать координаты из memo1 в массив точек pnts
workarray : TStringList;//workarray - временный массив с помощью которого точки вводятся в массив pnts
begin
if Memo1.Lines.Count = 0 then // если файл пуст, то заврешаем
Exit;
cnt := StrToInt(Memo1.Lines[0]);//cnt = колличеству точек которое дано в 1 строке memo1
Series1.Clear;//очищаем компоненты на которых будем рисовать
Series2.Clear;
Series3.Clear;
SetLength(pnts,cnt); // указываем длинну массива значением из первой строчки файла
for i := 1 to cnt do
begin
workarray := ParseString(memo1.Lines[i],tmp);// используем функцию разделения строки на слова, то есть получаем 2 координаты
pnts[i-1].X := StrToInt(workarray[0]);//координату X из workarray переносим в pnts
pnts[i-1].Y := StrToInt(workarray[1]);//координату Y из workarray переносим в pnts
Series1.AddXY(pnts[i-1].X,pnts[i-1].Y)// выводим точки на график
end;
end;
function TForm1.ParseString(str: string;var cnt:integer):TStringlist;// функция разделения строки на слова
var strs : TStringlist;
tmp : string;
i,j : integer;
begin
strs := TStringlist.Create;//список в который будем заносить уже разделенные координаты
i := 1;
j := 1;
repeat
if (str[i] = ';')or(i = Length(str)+1) then // если в строке попадается символ ; или конец строки, то они являются делитлемя строки на слова
begin
tmp := Copy(str,j,i-j);//заносим в переменную tmp отделенную координату
strs.Add(tmp);//добавляем эту координату в наш список
j := i+1//увеличиваем счетчик
end;
inc(i);//увеличиваем счетчик
until i > Length(str)+1;//повторяем цыкл пока i не бедет больше длины строки
cnt := strs.Count;//колличество координат
result := strs;//передаем наш список туда откуда вызывалась функция
end;
procedure TForm1.Button2Click(Sender: TObject);// дополнительная функция для создания файла с координатами
var i,r1,r2 : integer; // // метод для создания файла со случайными координатами, необходим, чтобы быстро получить необходимый файл)
begin
memo1.Lines.Clear;
memo1.Lines.Add('21');//добавляем в memo1 1строку в которой записываем количество точек
randomize;
for i:=0 to 20 do
begin
r1 := Random(20)-10;//r1:= случайное число в пределах от -10 до 9
r2 := Random(20)-10;//r2:= случайное число в пределах от -10 до 9
memo1.Lines.Add(IntToStr(r1)+';'+IntToStr(r2));//добавляем случайные координаты в memo1
end;
if SaveDialog1.Execute then
memo1.Lines.SaveToFile(SaveDialog1.FileName);//сохраняем наши координаты в текстовый файл который указываем с помощью SaveDialog
end;
procedure TForm1.Button3Click(Sender: TObject);// определяем окружность и треугольник
var i,j,k,n,cnt1,cnt2,cnttmp,cnttemp : integer;
//cnttemp - количество точек в треугольнике
//cnttmp - количество точек в круге
fi,Sq,rtmp,r : extended;
//Sq - площадь искомого треугольника
//rtmp - радиус искомого круга
//fi - угол который используется для вывода окружности на екран
p : array [0..3] of Point;
p0 : Point;//p0 - координаты центра окружности
begin
cnt1 := 0;
cnt2 := 0;
r := 2;
Series2.Clear;//очищаем поле
Series3.Clear;//очищаем поле
for i := 0 to Length(pnts)-3 do // пробегаемся по всем неповторяющимся тройкам точек
for j:= i+1 to Length(pnts)-2 do
for k:= j+1 to Length(pnts)-1 do
begin
// if (i=0)and(j=29)and(k=100) then
// rtmp := 0;
Sq := SquareThreeAngle(pnts[i],pnts[j],pnts[k]);// определяем, не лежат ли 3 точки на одной прямой, то есть находим площадь треугольника, и если она > 0, значит не лежат 3 точки на 1 прямой
if Sq > 0.001 then
begin
p0 := FindCentreCircle(pnts[i],pnts[j],pnts[k],rtmp); // Используем функция для определения центра окружности и радиуса
// Label1.Caption := IntToStr(i)+' '+IntToStr(j)+' '+IntToStr(k);
cnttmp := 0;
for n:=0 to Length(pnts)-1 do // проверяем какие точки лежат на окружности
if (n<>i)and(n<>j)and(n<>k) then
if (sqrt(sqr(pnts[n].X-p0.X)+sqr(pnts[n].Y-p0.Y))< rtmp)then // То есть подставляем координаты точки в уравнение окружности
inc(cnttmp);//увеличиваем количество точек в окружности
cnttemp := 0;
for n:=0 to Length(pnts)-1 do // проверяем какие точки лежат в треугольнике
if (n<>i)and(n<>j)and(n<>k) then
if (InTA(pnts[i],pnts[j],pnts[k],pnts[n]))then // Используем специальную функцию для проверки
inc(cnttemp);//увеличиваем количество точек в треугольнике
if (cnttmp = cnttemp)and(cnttmp > cnt1)and(cnttemp > cnt2) then // проверяем, совпало ли количество точек в треугольнике и круге, и максимальное ли это число
begin
p[0] := p0; //запомнимаем максимальное число
p[1] := pnts[i];
p[2] := pnts[j];
p[3] := pnts[k];
cnt1 := cnttmp;
cnt2 := cnttemp;
Label1.Caption := IntToStr(cnttmp)+' '+IntToStr(cnttemp);//выводим количество точек в окружности и в треугольнике
r := rtmp;
end;
end;
end;
fi := 0;
Series2.AddXY(p[0].X,p[0].Y); // Выводим окружность на график
Series3.AddXY(p[1].X,p[1].Y);
Series3.AddXY(p[2].X,p[2].Y);
Series3.AddXY(p[3].X,p[3].Y);
while fi < 360 do // цикля для вывода окружности используя параметрическое уравнение окружности
begin
Series2.AddXY(r*cos(fi)+p[0].X,r*sin(fi)+p[0].Y);//уравнение окружности
fi := fi + 0.1;//увеличиваем угол на 0.1
end;
end;
function TForm1.FindCentreCircle(a, b, c: Point; var r: Extended): Point; // функция нахождения центра окружности построенной на 3х точках
var p0 : Point;
x1,x2,x3,y1,y2,y3,x0,y0,a1,a2,b1,b2,c1,c2: extended;
begin
x1 := a.X;//присваиваем полученные координаты локальным переменным функции
x2 := b.X;
x3 := c.X;
y1 := a.Y;
y2 := b.Y;
y3 := c.Y;
a1 := -2*x1 + 2*x2;
a2 := -2*x2 + 2*x3;
b1 := -2*y1 + 2*y2;
b2 := -2*y2 + 2*y3;
//с помощью геометрических уравнений находим искомый центр окружности:
c1 := (sqr(x2)-sqr(x1)) + (sqr(y2)-sqr(y1));
c2 := (sqr(x3)-sqr(x2)) + (sqr(y3)-sqr(y2));
x0 := (b1*c2-b2*c1)/(a2*b1-a1*b2);
y0 := 0;
if b1 <> 0 then
y0 := (c1-a1*x0)/b1;
if b2 <> 0 then
y0 := (c2-a2*x0)/b2;
p0.X := x0;
p0.Y := y0;
r := sqrt(sqr(a.X-p0.X)+sqr(a.Y-p0.Y));//через уравнение окружности находим радиус
result := p0;//передаем координаты центра
end;
function TForm1.SquareThreeAngle(a, b, c: Point): extended;// функция для определения площади треугольника по заданным координатам вершин треугольника
begin
result := abs((b.X-a.X)*(c.Y-a.Y)-(c.X-a.X)*(b.Y-a.Y))/2;//нахождение площади треугольника с помощью геометрического уравнения
end;
function TForm1.InTA(a, b, c, O: Point): boolean;// функция, опрделяющая расположение точки отностильно треугольника (в качестве параметров задаются 3 вершина и искомая точка
var sq,sq1,sq2,sq3 : extended;
begin // метод основан на сравнении суммы площадей 3х полученных треугольников с площадью обшего треугольника
result :=false;
sq := SquareThreeAngle(a,b,c);//находим площадь треугольников по заданным коорденатам
sq1 := SquareThreeAngle(O,b,c);
sq2 := SquareThreeAngle(a,O,c);
sq3 := SquareThreeAngle(a,b,O);
//если точка находится в треугольникке то сумма площадей треугольников = площади общего треугольника
//проверяем это
if abs(sq-(sq1+sq2+sq3)) < 0.000000001 then//если это так, то точка лежит в треугольнике
result := true;
end;
procedure TForm1.Button4Click(Sender: TObject);
var i,j,k,n : integer;
begin
n := 0;//выставляем колличество точек = 0
for i := 3 to Length(pnts)-1 do
if InTA(pnts[0],pnts[1],pnts[2],pnts[i]) then//проверяем находится ли точка внутри треугольника
inc(n);//если да то увеличиваем колличество точек в треугольнике
Label1.Caption := IntToStr(n);//выводим это колличество
end;
end. |
(
