delphi 判断点在多边形内
2020-05-31 14:37
1926 查看
钉钉、微博极速扩容黑科技，点击观看阿里云弹性计算年度发布会！>>>
1 unit MainFM;
2
3 interface
4
5 uses
6 Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
7 Vcl.Controls, Vcl.Forms, Vcl.Dialogs,utils_dvalue, utils_DValue_JSON, math;
8
9 type
10 PPos = ^TPos;
11 TPos = record
12 x: double;
13 y: double;
14 end;
15 TForm1 = class(TForm)
16 procedure FormCreate(Sender: TObject);
17 procedure FormDestroy(Sender: TObject);
18 private
19 { Private declarations }
20 FInfo: TDValue;
21 min_x, min_y, max_x, max_y: Double;
22 function in_line(p, a, b: TPos):boolean;
23 function in_scope(x, y: double):boolean;
24 function js_scope(x, y: double):boolean;
25 function get_angle(a, p, b: TPos): Double;
26 function angle_scope(x, y: double):Boolean;
27 public
28 { Public declarations }
29 end;
30
31 var
32 Form1: TForm1;
33
34 implementation
35
36 {$R *.dfm}
37
38 const
39 AREA_JS = '[{"x":25.050192,"y":102.685862},{"x":25.048684,"y":102.679662},{"x":25.046881,"y":102.6795},{"x":25.046794,"y":102.679432},{"x":25.045442,"y":102.679317},{"x":25.045053,"y":102.679703},' +
40 '{"x":25.044956,"y":102.680877},{"x":25.044077,"y":102.680803},{"x":25.04405,"y":102.68082},{"x":25.043932,"y":102.680812},{"x":25.042992,"y":102.681473},{"x":25.042543,"y":102.680512},' +
41 '{"x":25.040577,"y":102.680628},{"x":25.040201,"y":102.680619},{"x":25.040199,"y":102.680616},{"x":25.038735,"y":102.680584},{"x":25.038131,"y":102.679581},{"x":25.036289,"y":102.68087},' +
42 '{"x":25.035543,"y":102.680316},{"x":25.032567,"y":102.682154},{"x":25.030944,"y":102.679494},{"x":25.030683,"y":102.679922},{"x":25.02918,"y":102.678526},{"x":25.020929,"y":102.691384},' +
43 '{"x":25.018434,"y":102.695194},{"x":25.018199,"y":102.695462},{"x":25.018154,"y":102.695623},{"x":25.014317,"y":102.701847},{"x":25.014257,"y":102.701777},{"x":25.014214,"y":102.701799},' +
44 '{"x":25.014193,"y":102.701833},{"x":25.013665,"y":102.703895},{"x":25.0135,"y":102.708667},{"x":25.013731,"y":102.711444},{"x":25.013688,"y":102.711598},{"x":25.014635,"y":102.728022},' +
45 '{"x":25.017457,"y":102.727245},{"x":25.017227,"y":102.727632},{"x":25.017398,"y":102.730491},{"x":25.017994,"y":102.731972},{"x":25.019514,"y":102.734679},{"x":25.019822,"y":102.736062},' +
46 '{"x":25.021592,"y":102.734747},{"x":25.022972,"y":102.736725},{"x":25.024394,"y":102.739288},{"x":25.025337,"y":102.739351},{"x":25.02553,"y":102.741181},{"x":25.027447,"y":102.741482},' +
47 '{"x":25.027511,"y":102.740923},{"x":25.027796,"y":102.741078},{"x":25.029644,"y":102.737365},{"x":25.032853,"y":102.737421},{"x":25.032824,"y":102.743083},{"x":25.034417,"y":102.743137},' +
48 '{"x":25.035607,"y":102.743816},{"x":25.036682,"y":102.741746},{"x":25.038471,"y":102.743515},{"x":25.040554,"y":102.744645},{"x":25.041723,"y":102.744501},{"x":25.042272,"y":102.743377},' +
49 '{"x":25.041406,"y":102.741458},{"x":25.041972,"y":102.740368},{"x":25.043552,"y":102.739007},{"x":25.044843,"y":102.737357},{"x":25.045317,"y":102.737367},{"x":25.045394,"y":102.737643},' +
50 '{"x":25.046456,"y":102.737673},{"x":25.046487,"y":102.736363},{"x":25.047268,"y":102.736121},{"x":25.048442,"y":102.736882},{"x":25.049793,"y":102.735303},{"x":25.049454,"y":102.734985},' +
51 '{"x":25.049949,"y":102.734738},{"x":25.050208,"y":102.73392},{"x":25.049452,"y":102.732817},{"x":25.050428,"y":102.731672},{"x":25.051611,"y":102.730455},{"x":25.052832,"y":102.731477},' +
52 '{"x":25.053183,"y":102.730854},{"x":25.055187,"y":102.728466},{"x":25.055845,"y":102.729135},{"x":25.057024,"y":102.727607},{"x":25.057807,"y":102.726003},{"x":25.059392,"y":102.720135},' +
53 '{"x":25.059951,"y":102.72017},{"x":25.062027,"y":102.721034},{"x":25.062385,"y":102.72006},{"x":25.063003,"y":102.720215},{"x":25.063863,"y":102.717103},{"x":25.062979,"y":102.716844},' +
54 '{"x":25.063065,"y":102.715942},{"x":25.062657,"y":102.715496},{"x":25.062696,"y":102.715054},{"x":25.062367,"y":102.714957},{"x":25.062725,"y":102.713192},{"x":25.061683,"y":102.713097},' +
55 '{"x":25.061665,"y":102.712598},{"x":25.060553,"y":102.712448},{"x":25.060689,"y":102.710459},{"x":25.061079,"y":102.708519},{"x":25.061649,"y":102.707398},{"x":25.06164,"y":102.706604},' +
56 '{"x":25.060134,"y":102.706413},{"x":25.060187,"y":102.704655},{"x":25.06047,"y":102.704099},{"x":25.060271,"y":102.702606},{"x":25.061233,"y":102.702174},{"x":25.062926,"y":102.702057},' +
57 '{"x":25.063063,"y":102.700747},{"x":25.062848,"y":102.698117},{"x":25.062557,"y":102.698149},{"x":25.062526,"y":102.697755},{"x":25.062375,"y":102.697764},{"x":25.062467,"y":102.697104},' +
58 '{"x":25.062128,"y":102.696998},{"x":25.062086,"y":102.696072},{"x":25.060061,"y":102.696191},{"x":25.05891,"y":102.695299},{"x":25.058661,"y":102.6945
1ffa
85},{"x":25.058814,"y":102.693901},' +
59 '{"x":25.059055,"y":102.69348},{"x":25.059847,"y":102.692906},{"x":25.05932,"y":102.691352},{"x":25.059009,"y":102.69107},{"x":25.058361,"y":102.691324},{"x":25.058288,"y":102.692227},' +
60 '{"x":25.058544,"y":102.69323},{"x":25.057257,"y":102.693822},{"x":25.055803,"y":102.694269},{"x":25.053974,"y":102.6905},{"x":25.053752,"y":102.690326},{"x":25.053012,"y":102.690614},' +
61 '{"x":25.052192,"y":102.690245},{"x":25.052909,"y":102.687701},{"x":25.052385,"y":102.685977},{"x":25.051531,"y":102.686171},{"x":25.051377,"y":102.686717},{"x":25.050672,"y":102.686137},' +
62 '{"x":25.050192,"y":102.685862}]';
63
64 procedure TForm1.FormCreate(Sender: TObject);
65 var
66 i: Integer;
67 x, y: double;
68 begin
69 FInfo := TDValue.Create(vntArray);
70 JSONParser(AREA_JS, FInfo);
71 //计算最大最小值
72 min_x := FInfo.Items[0].ForceByName('x').AsFloat;
73 min_y := FInfo.Items[0].ForceByName('y').AsFloat;
74 max_x := min_x; max_y := min_y;
75 for i := 1 to FInfo.Count - 1 do
76 begin
77 x := FInfo.Items[i].ForceByName('x').AsFloat;
78 y := FInfo.Items[i].ForceByName('y').AsFloat;
79 if min_x > x then min_x := x;
80 if min_y > y then min_y := y;
81 if max_x < x then max_x := x;
82 if max_y < y then max_y := y;
83 end;
84 x := 25.035571963033; y := 102.71040295303;
85 x := 25.06574; y := 102.69685;
86 x := 25.032819; y:= 102.744553;
87 if in_scope(x,y) then showmessage('在区域内')
88 else showmessage('不在区域内');
89 end;
90
91 procedure TForm1.FormDestroy(Sender: TObject);
92 begin
93 FInfo.Free;
94 end;
95
96 function TForm1.in_line(p, a, b: TPos):Boolean;
97 var
98 minx,miny,maxx, maxy, a1, a2, tmp: double;
99 begin
100 minx := a.x; if minx > b.x then minx := b.x;
101 miny := a.y; if miny > b.y then miny := b.y;
102 maxx := a.x; if maxx < b.x then maxx := b.x;
103 maxy := a.y; if maxy < b.y then maxy := b.y;
104 if (p.x >= minx) and (p.y >= miny) and (p.x <= maxx) and (p.y <= maxy) then
105 begin
106 a1 := (a.x - p.x)*(b.y - p.y);
107 a2 := (b.x - p.x)*(a.y - p.y);
108 tmp := a1 - a2;
109 if tmp < 0 then tmp := a2 - a1;
110 Result := tmp < 0.0001;
111 end else begin
112 Result := false;
113 end;
114 end;
115
116 function TForm1.get_angle(a, p, b: TPos): Double;
117 var
118 pa, pb, ab, apb: Double;
119 begin
120 pa := (a.x - p.x)*(a.x - p.x) + (a.y - p.y)* (a.y - p.y);
121 pb := (b.x - p.x)*(b.x - p.x) + (b.y - p.y)* (b.y - p.y);
122 ab := (b.x - a.x)*(b.x - a.x) + (b.y - a.y)* (b.y - a.y);
123
124 apb := pa + pb - ab;
125
126 pa := sqrt(pa);
127 pb := sqrt(pb);
128 apb := apb / (2 * pa * pb);
129 REsult := ArcCos(apb);
130 end;
131
132 function TForm1.angle_scope(x, y: double):Boolean;
133 var
134 i,k: Integer;
135 d1, d2: TDValue;
136 p, p1, p2: TPos;
137 angle: double;
138 begin
139 k := 1000;
140 p.x := x * k;
141 p.y := y * k;
142 for i :
ff2
= 0 to FInfo.Count - 1 do
143 begin
144 d1 := FInfo.Items[i];
145 d2 := FInfo.Items[(i + 1) mod FInfo.Count];
146 p1.x := d1.ForceByName('x').AsFloat * k;
147 p1.y := d1.ForceByName('y').AsFloat * k;
148 p2.x := d2.ForceByName('x').AsFloat * k;
149 p2.y := d2.ForceByName('y').AsFloat * k;
150 if in_line(p, p1, p2) then
151 begin
152 Result := True;
153 exit;
154 end;
155 angle := angle + get_angle(p1, p, p2);
156 end;
157 angle := angle - PI * 2;
158 if angle < 0 then angle := -1 * angle;
159 Result := angle < 0.0001;
160 end;
161
162 function TForm1.in_scope(x, y: double):boolean;
163 var
164 i,cross: Integer;
165 d1, d2: TDValue;
166 p, p1, p2: TPos;
167 y1, y2, tmp, tmpx: double;
168 begin
169 cross := 0;
170 p.x := x;
171 p.y :=<
ff8
span style="color: #000000;"> y;
172 for i := 0 to FInfo.Count - 1 do
173 begin
174 d1 := FInfo.Items[i];
175 d2 := FInfo.Items[(i + 1) mod FInfo.Count];
176 p1.x := d1.ForceByName('x').AsFloat; p1.y := d1.ForceByName('y').AsFloat;
177 p2.x := d2.ForceByName('x').AsFloat; p2.y := d2.ForceByName('y').AsFloat;
178
179 if in_line(p, p1, p2) then
180 begin
181 cross := 1;
182 break;
183 end;
184 if p1.y = p2.y then continue;
185 y1 := p1.y;
186 y2 := p2.y;
187 if y1 > y2 then
188 begin
189 y1 := p2.y;
190 y2 := p1.y;
191 end;
192 if p.y < y1 then continue;
193 if p.y > y2 then continue;
194
195 tmpx := (p.y - p1.y) * (p2.x - p1.x) / (p2.y - p1.y) + p1.x;
196 (*
197 tmp := p.x - tmpx;
198 if tmp < 0 then tmp := tmpx - p.x;
199 if tmp < 0.0001 then
200 begin
201 cross := 1;
202 break;
203 end;
204 tmp := p1.y - p.y;
205 if tmp < 0 then tmp := p.y - p1.y;
206 if tmp < 0.0001 then
207 begin
208 if( (min_y = p1.y) or (max_y = p1.y) ) and (p.x< p1.x ) then
209 begin
210 cross := 0;
211 break;
212 end;
213 continue;
214 end;
215 *)
216 if(tmpx > p.x) then cross := cross + 1;
217 end; // end of for
218 Result := (cross mod 2) = 1
219 end;
220
221 function TForm1.js_scope(x, y: double):boolean;
222 var
223 i,j: Integer;
224 d1,d2: TDValue;
225 xi,yi,xj,yj: Single;
226 begin
227 Result := False;
228 j := FInfo.Count - 1;
229 for i := 0 to FInfo.Count - 1 do
230 begin
231 d1 := FInfo.Items[i];
232 d2 := FInfo.Items[j];
233 j := i;
234 xi := d1.ForceByName('x').AsFloat;
235 yi := d1.ForceByName('y').AsFloat;
236 xj := d2.ForceByName('x').AsFloat;
237 yj := d2.ForceByName('y').AsFloat;
238 if( (yi > y) <> (yj > y) ) and ( x < ((xj - xi) * (y - yi) / (yj - yi) + xi) ) then
239 Result := not Result;
240 end;
241 end;
242
243 end.
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 
相关文章推荐
- 判断点是否在一个任意多边形内几种方法
- 判断一个点是否在多边形内部 [2] 射线法实现
- 判断点是否任意多边形内的2种方法
- 在delphi根据TshiftState值来判断用户按下Ctrl,shift,alt等键的方法
- inno setup判断是Windows系统版本（其实还是Delphi代码，还能检查域控制器和家庭版）
- [Delphi]如何通过进程句柄判断该进程是否已退出？
- Delphi中判断操作系统是否是Windows7
- 判断点是否在多边形内(C语言)
- poj 1584 A Round Peg in a Ground Hole 多边形凸性判断，点与多边形位置关系，圆与多边形位置关系
- 判断点在多边形内外的简单算法
- DELPHI判断是否联网
- 判断点是否在多边形内
- hdu1756判断点是否在多边形内部
- 判断多边形的核是否存在 poj3130&&poj3335
- Delphi开发技巧：字符串的相关判断
- 判断点是否在多边形内部
- openlayers 多边形重叠判断平移
- SGU 124 射线法 判断点与多边形位置关系
- 新发现判断一个点在多边形的最高效率算法 推荐******
- Delphi判断某个类是否实现了某个接口