如何确定某点是否在一不规则区域内?(100分)

  • 主题发起人 主题发起人 espite
  • 开始时间 开始时间
E

espite

Unregistered / Unconfirmed
GUEST, unregistred user!
待求某一不规则区域内对应于各点坐标的函数的平均值,
我想先确定一点是否在该不规则区域内,然后对其进行
处理。不知道有没有更好的办法,如果得这样做,如何
确定某点是否在该不规则区域内?
 
我有现成的算法, 在家里, 待晚上贴到这
 
先用CreatePolygonRgn生成不规则区域,
再使用 PtInRegion,可查Win32 API
 
hi espite,

提供一个函数判断点在多边形中:

function PointInFence(p: TPoint; Fence: Array of TPoint): boolean;
var p1: TPoint; ar: longint; i: integer;
begin
ar := 0;
for i:=0 to high(Fence) do
begin
p1 := Fence;
Ar:=(p1.x*p.y)-(p1.y*p.x)+ar;
end;
Result:= Ar > 0;
end;

其中 Fence 由一系列的点组成, 并按着顺时针方向排列(可能是逆时针, 时间长了
记不清了, 试一试就知道了); 如果令 Fence 的起点与终点重合, 则函数中的 Ar
值为多边形面积的 2 倍
 
能否请huizhang对此加以解释,谢谢。
 
(p1.x*p.y)-(p1.y*p.x)+(p2.x*p.y)-(p2.y*p.x), 可以用来判断点在直线的某一侧
 
呵呵, 这是两个矢量的叉积公式的坐标表示法:
两个矢量的叉积是这样定义的:
平移, 使两个矢量的起点重合
叉积的结果是一个矢量, 其方向为从第一个矢量向第二个矢量
按照右手螺旋所确定的方向
其大小等于两个矢量的两边以及每个矢量起点分别平移到另一
个矢量的终点之后所围成的平行四边形的面积

 
还是用API函数,一个好的算法是不可能用到乘法的。
 
delphi fan2:
好的算法不用乘法用什么? 难道是除法???
API 函数并不是万能的, 此问题是非常典型的图形运算问题, 没有廉价的API可用;
你所说的API无非是指 Region, 但是region是用来作不规则窗体用的; 如果程序
中有很多多边形, 每次都转换成窗体, 用后再释放, 那才是浪费系统资源呢.
 
I agree with huizhang!
而且大家也不能把API看得很神秘, 它也是必须用一定的算法才
能得到结果的, 这里huizhang的算法绝对是最简单的
 
I agree with huizhang!
而且大家也不能把API看得很神秘, 它也是必须用一定的算法才
能得到结果的, 这里huizhang的算法绝对是最简单的(至少就我所
知, 见笑了, :)
 
I agree with huizhang!
而且大家也不能把API看得很神秘, 它也是必须用一定的算法才
能得到结果的, 这里huizhang的算法绝对是最简单的(至少就我所
知, 见笑了, :)
 
可是huizhang的函数好像不大对头耶.
反例如下:
有三角形(1,1),(2,2),(3,1),用PointInFence执行对点(4,4)后:

Ar = 1*4- 1*4 + 2*4 - 2*4 + 3*4 - 1*4 >0.
但很明显(4,4)不在三角形内.

是不是我理解有问题?望赐教!
 
多人接受答案了。
 
我对huizhang的函数进行了测试,结果无论是顺时针
还是逆时针都不对。不知是否程序有问题,或者是算
法用错了。程序如下:
unit Test;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs,ExtCtrls, Menus;

type
TForm1 = class(TForm)
Panel1: TPanel;
MainMenu1: TMainMenu;
File1: TMenuItem;
Test1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
Image1: TImage;
procedure Test1Click(Sender: TObject);
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Exit1Click(Sender: TObject);
procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
function PointInFence(p: TPoint; Fence: Array of TPoint): boolean;
var
Form1: TForm1;

implementation

var
PtNos:Integer;
MyPtArray:Array[0..15] of TPoint;
{$R *.DFM}

procedure TForm1.Test1Click(Sender: TObject);
begin
PtNos:=0;
Form1.Refresh;
Panel1.Caption:='LeftButton=Define points RightButton=Finished Esc=Exit';
Image1.OnMouseDown:=Form1.Panel1MouseDown;

end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
IF Button=mbLeft then
begin
MyPtArray[PtNos].x:=x;
MyPtArray[PtNos].y:=y;
if PtNos=0 then
Form1.Canvas.MoveTo(x,y);
if PtNos>High(MyPtArray) then
ShowMessage('The largest number of points '+InttoStr(High(MyPtArray))+' is surpassed!')
else
begin
Form1.Canvas.LineTo(x,y);
PtNos:=PtNos+1;
end;
end
else if Button=mbRight then
begin
if PtNos>0 then
begin
Form1.Canvas.MoveTo(MyPtArray[PtNos-1].x,MyPtArray[PtNos-1].y);
Form1.Canvas.LineTo(MyPtArray[0].x,MyPtArray[0].y);
Form1.Image1.OnMouseMove:=Form1.Panel1MouseMove;
end
else
MessageDlg('You must define wild area firstly!',mtconfirmation,[mbOK],0);
end;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;

function PointInFence(p: TPoint; Fence: Array of TPoint): boolean;
var
p1: TPoint;
ar: longint;
i: integer;
begin
ar := 0;
for i:=0 to PtNos-1 do
begin
p1 := Fence;
Ar:=(p1.x*p.y)-(p1.y*p.x)+ar;
end;
Result:= Ar > 0;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
InFlag:Boolean;
MiddlePt:TPoint;
begin
Inflag:=PointInFence(Point(x,y),MyPtArray);
Panel1.Caption:='('+InttoStr(x)+','+InttoStr(y)+')';
if Inflag then
Panel1.Caption:=Panel1.Caption+'In the fence'
else
Panel1.Caption:=Panel1.Caption+'Out of fence';
end;

end.
 
我对huizhang的函数进行了测试,结果无论是顺时针
还是逆时针都不对。不知是否程序有问题,或者是算
法用错了。请指教。程序如下:
unit Test;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics,
Controls, Forms, Dialogs,ExtCtrls, Menus;

type
TForm1 = class(TForm)
Panel1: TPanel;
MainMenu1: TMainMenu;
File1: TMenuItem;
Test1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
Help1: TMenuItem;
About1: TMenuItem;
Image1: TImage;
procedure Test1Click(Sender: TObject);
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Exit1Click(Sender: TObject);
procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
function PointInFence(p: TPoint; Fence: Array of TPoint): boolean;
var
Form1: TForm1;

implementation

var
PtNos:Integer;
MyPtArray:Array[0..15] of TPoint;
{$R *.DFM}

procedure TForm1.Test1Click(Sender: TObject);
begin
PtNos:=0;
Form1.Refresh;
Panel1.Caption:='LeftButton=Define points RightButton=Finished Esc=Exit';
Image1.OnMouseDown:=Form1.Panel1MouseDown;

end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
IF Button=mbLeft then
begin
MyPtArray[PtNos].x:=x;
MyPtArray[PtNos].y:=y;
if PtNos=0 then
Form1.Canvas.MoveTo(x,y);
if PtNos>High(MyPtArray) then
ShowMessage('The largest number of points '+InttoStr(High(MyPtArray))+' is surpassed!')
else
begin
Form1.Canvas.LineTo(x,y);
PtNos:=PtNos+1;
end;
end
else if Button=mbRight then
begin
if PtNos>0 then
begin
Form1.Canvas.MoveTo(MyPtArray[PtNos-1].x,MyPtArray[PtNos-1].y);
Form1.Canvas.LineTo(MyPtArray[0].x,MyPtArray[0].y);
Form1.Image1.OnMouseMove:=Form1.Panel1MouseMove;
end
else
MessageDlg('You must define wild area firstly!',mtconfirmation,[mbOK],0);
end;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;

function PointInFence(p: TPoint; Fence: Array of TPoint): boolean;
var
p1: TPoint;
ar: longint;
i: integer;
begin
ar := 0;
for i:=0 to PtNos-1 do
begin
p1 := Fence;
Ar:=(p1.x*p.y)-(p1.y*p.x)+ar;
end;
Result:= Ar > 0;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
InFlag:Boolean;
MiddlePt:TPoint;
begin
Inflag:=PointInFence(Point(x,y),MyPtArray);
Panel1.Caption:='('+InttoStr(x)+','+InttoStr(y)+')';
if Inflag then
Panel1.Caption:=Panel1.Caption+'In the fence'
else
Panel1.Caption:=Panel1.Caption+'Out of fence';
end;

end.
 
我对huizhang的函数进行了测试,结果无论是顺时针
还是逆时针都不对。不知是否程序有问题,或者是算
法用错了。请指教。程序如下:
unit Test;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, Menus;

type
TForm1 = class(TForm)
Panel1: TPanel;
MainMenu1: TMainMenu;
File1: TMenuItem;
Test1: TMenuItem;
N1: TMenuItem;
Exit1: TMenuItem;
procedure Test1Click(Sender: TObject);
procedure Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure Exit1Click(Sender: TObject);
procedure Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
function PointInFence(p: TPoint; Fence: Array of TPoint): boolean;
var
Form1: TForm1;

implementation

var
PtNos:Integer;
MyPtArray:Array[0..15] of TPoint;
{$R *.DFM}

procedure TForm1.Test1Click(Sender: TObject);
begin
PtNos:=0;
Form1.Refresh;
Panel1.Caption:='LeftButton=Define points RightButton=Finished';
Form1.OnMouseDown:=Form1.Panel1MouseDown;
end;

procedure TForm1.Panel1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
IF Button=mbLeft then
begin
MyPtArray[PtNos].x:=x;
MyPtArray[PtNos].y:=y;
if PtNos=0 then
Form1.Canvas.MoveTo(x,y);
if PtNos>High(MyPtArray) then
ShowMessage('The largest number of points '+InttoStr(High(MyPtArray))+' is surpassed!')
else
begin
Form1.Canvas.LineTo(x,y);
PtNos:=PtNos+1;
end;
end
else if Button=mbRight then
begin
if PtNos>0 then
begin
Form1.Canvas.MoveTo(MyPtArray[PtNos-1].x,MyPtArray[PtNos-1].y);
Form1.Canvas.LineTo(MyPtArray[0].x,MyPtArray[0].y);
Form1.OnMouseMove:=Form1.Panel1MouseMove;
end
else
MessageDlg('You must define wild area firstly!',mtconfirmation,[mbOK],0);
end;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
Close;
end;

function PointInFence(p: TPoint; Fence: Array of TPoint): boolean;
var
p1: TPoint;
ar: longint;
i: integer;
begin
ar := 0;
for i:=0 to PtNos-1 do
begin
p1 := Fence;
Ar:=(p1.x*p.y)-(p1.y*p.x)+ar;
end;
Result:= Ar > 0;
end;

procedure TForm1.Panel1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var
InFlag:Boolean;
begin
Inflag:=PointInFence(Point(x,y),MyPtArray);
Panel1.Caption:='('+InttoStr(x)+','+InttoStr(y)+')';
if Inflag then
Panel1.Caption:=Panel1.Caption+'In the fence'
else
Panel1.Caption:=Panel1.Caption+'Out of fence';
end;

end.
 
实在对不起, 那个算法确实有问题, 缺少一点判断。
现在给你另外一个算法,叫做“跳栅栏算法”。其原理如下:

假设有一个栅栏,你从现在所站地点沿着一个方向跑过去,遇到栅栏时就跳过去,记住你跳了几次。如果次数是单数,则你在栅栏内;如果是双数,则你在栅栏外。以下算法是向东跑过去的实现方法。该算法虽然用了一点除法,但是由于排除了不相关的栅栏,故速度也很快。此外它的优点是与多边形的排列方向无关。

function TForm1.PointInFence(p: TPoint; Fence: Array of TPoint): boolean;
var
p1: TPoint;
ar: integer;
i, j: integer;
begin
ar:=0;
for i:=0 to PtNos-1 do
begin
if i=PtNos-1 then j:=0 else j:=i+1;
//如果在所站点的水平方向上有栅栏存在
if ((((p.y>=Fence.y) and (p.y<fence[j].y)) or
((p.y>=fence[j].y) and (p.y<fence.y))) and
//且栅栏在我的右方
(p.x<(fence[j].x-fence.x)*(p.y-fence.y)/(fence[j].y-fence.y)+fence.x)) then
ar := Ar+1;
end;
result:= (Ar and $1) > 0;
end;
 
假设有一个栅栏,你从现在所站地点沿着一个方向跑过去,遇到栅栏时就跳过去,记
住你跳了几次。如果次数是单数,则你在栅栏内;如果是双数,则你在栅栏外。以下
算法是向东跑过去的实现方法。该算法虽然用了一点除法,但是由于排除了不相关的
栅栏,故速度也很快。此外它的优点是与多边形的排列方向无关。

function TForm1.PointInFence(p: TPoint; Fence: Array of TPoint): boolean;
var
p1: TPoint;
ar: integer;
i, j: integer;
begin
ar:=0;
for i:=0 to PtNos-1 do
begin
if i=PtNos-1 then j:=0 else j:=i+1;
//如果在所站点的水平方向上有栅栏存在
if ((((p.y>=Fence.y) and (p.y<fence[j].y)) or
((p.y>=fence[j].y) and (p.y<fence.y))) and
//且栅栏在我的右方
(p.x<(fence[j].x-fence.x)*(p.y-fence.y)/
(fence[j].y-fence.y)+fence.x)) then
ar := Ar+1;
end;
result:= (Ar and $1) > 0;
end;
 
如果这个区域是圆型、或是其他非直线的图形呢?
 
后退
顶部