Using CreatePolygonRgn in Delphi 11

Question

I want to use regions on a Canvas to detect the mouse moving over them, but I can't manage to get CreatePolygonRgn() working properly.

Here is a sample code:

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;

What I am doing wrong?

EDIT

The following test code works fine. But the exactly same code in my real application doesn't ! On the ImageClick event the function PtInRegion raises the exception "Range check error" for SOME of regions, NOT ALL of them (different on different runs), but paints the regions as expected when I comment out this function! For me this means that the region's bounds are right and while the mouse is inside the region, ptInRegion raises the exception. This behavior doesn't exist with the sample code and drives me crazy!

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.

(1) You must only paint in the window's `WM_PAINT` (`OnPaint`) handler. (2) If you "need" `ProcessMessages`, you are doing something wrong. For an example, see https://stackoverflow.com/a/72912274/282848. For an example of mouse interaction, see https://stackoverflow.com/questions/7223678/delphi-moving-overlapping-tshapes. Well, if you need, I can give you hundreds of more examples! :) — Andreas Rejbrand, Feb 21 '23 at 14:55
You are giving only two points! This results in a polygon with no interior. You should give an X and a Y coordinate for each point. `var p: array[0..3] of TPoint;` — Uwe Raabe, Feb 21 '23 at 14:58

Remy Lebeau · Answer 1 · 2023-02-22T16:38:19.317

CreatePolygonRgn() takes in an array of X/Y coordinates as POINT structures (TPoint in Delphi):

[in] pptl

A pointer to an array of POINT structures that define the vertices of the polygon in logical units. The polygon is presumed closed. Each vertex can be specified only once.

[in] cPoint

The number of points in the array.

However, you are giving the function an array of Integers instead, where every pair of Integers gets treated as an X/Y coordinate POINT.

As such, when you set the cPoint parameter to 2 then you are telling the function that your array has 2 X/Y coordinates (which it does, (p[0],p[1]) and (p[2],p[3])), and when you set the cPoint parameter to 4 then you are telling the function that your array has 4 X/Y coordinates (which is out of bounds for your array). Neither scenario defines a valid polygon.

The compiler is not catching this discrepancy because the Winapi.Windows unit declares the pptl parameter as simply const Points, which means it is an untyped parameter that lets you basically pass in whatever you want, so it is up to you to make sure that whatever you do pass in is actually valid for the function (which it is not, in this situation).

CreateRectRgn() works because it wants only 2 X/Y coordinates (passed in as 4 integers) for the top-left and bottom-right corners, which is exactly what you are giving it. If you want to replicate that same shape with CreatePolygonRgn(), you will have to provide the X/Y coordinates for the other 2 corners, as well.

Yes, my mistake was the number of points I passed in the function. Now it works right. Thanks — JimPapas, Feb 22 '23 at 12:22

JimPapas · Answer 2 · 2023-02-24T02:22:10.530

Eventually I ended up not using ptInRegion and writing my own pointInRegion function like this

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;

NOTE 1: A point is inside a polygon if a half-line starting from point X,Y intersects an odd number of sides. For convenience I use the vertical half-line NOTE 2: This approach excludes the perimeter points

You need to use const on the open array parameter p. Also, your last line can be written simply Result := Odd(k). — Andreas Rejbrand, Feb 24 '23 at 16:34

Using CreatePolygonRgn in Delphi 11

2 Answers2