在 Delphi 11 中使用 CreatePolygonRgn

Question

我想使用

Canvas

上的区域来检测鼠标在它们上方移动，但我无法让

CreatePolygonRgn()

正常工作。

这里是示例代码：

var
  regs : array of HRGN;

procedure TForm8.Button1Click(Sender: TObject);
var
  n : integer;
  p : array[0..3] of integer;
begin
  SetLength(regs, 10);
  for n := 1 to Length(regs) do try
    p[0] := n*50-20;
    p[1] := n*50+20;
    p[2] := n*50+20;
    p[3] := n*50-20;
    regs[n-1] := CreatePolygonRgn(p[0], 2 {neither with 4}, 1); // seems not working as expected
    // regs[n-1] := CreateRectRgn(p[0], p[1], p[2], p[3]); // this works

    FillRgn(image.Canvas.Handle, regs[n-1], image.Canvas.Brush.Handle); // doesn't draw anything             
  except
    ShowMessage('error creating region');
  end;
  Application.ProcessMessages;
end;

procedure TForm8.ImageMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
  if (ssCtrl in Shift) then begin
    for var i : integer := 0 to Length(regs)-1 do
      if PtInRegion(regs[i], X, Y) then begin // works only with CreateRectRgn 
        ShowMessage('region ' + IntToStr(i));
        break;
      end;
  end;
end;

我做错了什么？

编辑

以下测试代码工作正常。但是我的真实应用程序中的完全相同的代码却没有！ 在 ImageClick 事件上，函数 PtInRegion 为某些区域引发异常“范围检查错误”，而不是所有区域（不同运行时不同），但当我注释掉此函数时按预期绘制区域！对我来说，这意味着该区域的边界是正确的，而当鼠标在该区域内时，ptInRegion 会引发异常。这种行为在示例代码中不存在，让我发疯！

unit Unit8;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls;

type
  TForm8 = class(TForm)
    Image: TImage;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure ImageClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form8: TForm8;

implementation

{$R *.dfm}

var regs : array of HRGN;

procedure TForm8.Button1Click(Sender: TObject);
var n : integer;
 var p : array[0..3] of TPoint;
begin
    for n := 0 to length(regs)-1 do
    if regs[n] > 0 then
    DeleteObject(regs[n]); // delete existing regions
    setLength(regs,10);
    n := 0;
    for n := 0 to 9 do try
        p[0].X := 50*n-20;
        p[0].Y := 50*n+20;

        p[1].X := 50*n-20;
        p[1].Y := 50*n-20;

        p[2].X := 50*n+20;
        p[2].Y := 50*n-20;

        p[3].X := 50*n+20;
        p[3].Y := 50*n+20;

        regs[n] := CreateRectRgn(p[0].X,p[0].Y,p[2].X,p[2].Y);
        //regs[n] := CreatePolygonRgn(p[0],4,WINDING);
        image.Canvas.Brush.Color := clYellow;
        PaintRgn (image.canvas.Handle,regs[n]);
        image.Canvas.Brush.Color := clBlue;
        FrameRgn(image.canvas.Handle,regs[n],image.Canvas.Brush.Handle,1,1);
        except
            showmessage('error');
        end;
    image.Invalidate;
end;

procedure TForm8.ImageClick(Sender: TObject);
begin
var p : TPoint := image.ScreenToClient(mouse.cursorPos);
    for var i : integer := 0 to length(regs)-1 do
    if PtInRegion(regs[i],p.X,p.Y) then begin
        image.Canvas.Brush.color := clGreen;
        paintRgn(image.canvas.Handle,regs[i]);
        image.Canvas.Brush.color := clRed;
   FrameRgn(image.canvas.Handle,regs[i],image.Canvas.Brush.Handle,1,1);
        image.Canvas.Brush.color := clYellow;
        image.Canvas.TextOut(p.x,p.y,intToStr(i));
        break;
    end;
end;

end.

Answer 1

CreatePolygonRgn()

将 X/Y 坐标数组作为

POINT

结构（Delphi 中的

TPoint

）：

[in] pptl

指向

POINT

结构数组的指针，它以逻辑单位定义多边形的顶点。假定多边形是封闭的。每个顶点只能指定一次。

[in] cPoint

数组中points的数量。

但是，您为函数提供了一个

Integer

s 数组，其中每对

Integer

s 都被视为 X/Y 坐标

POINT

.

因此，当您将

cPoint

参数设置为 2 时，您就是在告诉函数您的数组具有 2 个 X/Y 坐标（确实如此，

(p[0],p[1])

和

(p[2],p[3])

），并且当您设置

cPoint 

参数为 4 然后你告诉函数你的数组有 4 个 X/Y 坐标（这超出了你的数组的范围）。这两种情况都没有定义有效的多边形。

编译器没有捕捉到这种差异，因为

Winapi.Windows

单元将

pptl

参数声明为简单的

const Points

，这意味着它是一个无类型参数，基本上可以让你传入任何你想要的参数，所以这取决于你确保你传入的任何内容都对函数有效（在这种情况下它不是）。

CreateRectRgn()

之所以有效，是因为它只需要 2 个 X/Y 坐标（作为 4 个整数传递）用于左上角和右下角，这正是您所提供的。如果您想使用

CreatePolygonRgn()

复制相同的形状，您还必须提供其他 2 个角的 X/Y 坐标。

Answer 2

最终我没有使用 ptInRegion 而是像这样编写自己的 pointInRegion 函数

function pointInRegion(p : array of TPoint; x,y : integer) : boolean;
var i,j,k : integer;
    slope : extended;
begin
    k := 0;
    for i := 0 to length(p)-1 do begin
        j := (i + 1) mod length(p);
        if ((p[i].Y < y) AND (p[j].Y < y))
        OR ((p[i].X < x) AND (p[j].X < x))
        OR ((p[i].X > x) AND (p[j].X > x))
        then // do nothing as no intersection exists
        else 
        if p[j].X <> p[i].X then begin // if they aren't parallels
            slope := (p[j].Y - p[i].Y) / (p[j].X - p[i].X);
            if slope*(x-p[i].X)+p[i].Y > y // and there is a valid intersection 
            then inc(k);
        end;
    end;
    result := k mod 2 = 1; // if intersects are odd then the point is in region
end;

注意 1：如果从点 X、Y 开始的半线与奇数条边相交，则点在多边形内部。为方便起见，我使用垂直半线 注 2：此方法不包括周边点