Detecting if click is in a region or not

Knowlton

Here is code to add a titlebutton to the caption nd then check that the mouse is clicking on the button and then executing the code...

unit Capbtn;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Buttons;

type
  TForm1 = class(TForm)
    procedure FormResize(Sender: TObject);
    private

    TitleButton : TRect;
    procedure DrawTitleButton;
    {Paint-related messages}
    procedure WMSetText(var Msg : TWMSetText); message WM_SETTEXT;
    procedure WMNCPaint(var Msg : TWMNCPaint); message WM_NCPAINT;
    procedure WMNCActivate(var Msg : TWMNCActivate); message WM_NCACTIVATE;
    {Mouse down-related messages}
    procedure WMNCHitTest(var Msg : TWMNCHitTest); message WM_NCHITTEST;
    procedure WMNCLButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
    function GetVerInfo : DWORD;
  end;

var
  Form1: TForm;

const
  htTitleBtn = htSizeLast + 1;

implementation
{$R *.DFM}

procedure TForm1.DrawTitleButton;
var
  bmap : TBitmap; {Bitmap to be drawn - 16 X 16 : 16 Colors}
  XFrame,  {X and Y size of Sizeable area of Frame}
  YFrame,
  XTtlBit, {X and Y size of Bitmaps in caption}
  YTtlBit  : Integer;
begin
  {Get size of form frame and bitmaps in title bar}
  XFrame  := GetSystemMetrics(SM_CXFRAME);
  YFrame  := GetSystemMetrics(SM_CYFRAME);
  XTtlBit := GetSystemMetrics(SM_CXSIZE);
  YTtlBit := GetSystemMetrics(SM_CYSIZE);

  {$IFNDEF WIN32}
    TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),
                          YFrame - 1,
                          XTtlBit + 2,
                          YTtlBit + 2);

  {$ELSE}     {Delphi 2.0 positioning}
    if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
      TitleButton := Bounds(Width - (3 * XTtlBit) - ((XTtlBit div 2) - 2),
                            YFrame - 1,
                            XTtlBit + 2,
                            YTtlBit + 2)
    else
      TitleButton := Bounds(Width - XFrame - 4*XTtlBit + 2,
                           XFrame + 2,
                           XTtlBit + 2,
                           YTtlBit + 2);
  {$ENDIF}


  Canvas.Handle := GetWindowDC(Self.Handle); {Get Device context for drawing}
  try
    {Draw a button face on the TRect}
    DrawButtonFace(Canvas, TitleButton, 1, bsAutoDetect, False, False, False);
    bmap := TBitmap.Create;
    bmap.LoadFromFile('F:\Graphics\buttons\alarm.bmp');
    with TitleButton do
      {$IFNDEF WIN32}
        Canvas.Draw(Left +1 , Top, bmap);
      {$ELSE}
        if (GetVerInfo = VER_PLATFORM_WIN32_NT) then
          Canvas.Draw(Left + 2, Top + 2, bmap)
        else
          Canvas.StretchDraw(TitleButton, bmap);
      {$ENDIF}

  finally
    ReleaseDC(Self.Handle, Canvas.Handle);
    bmap.Free;
    Canvas.Handle := 0;
  end;
end;

{Paint triggering events}
procedure TForm1.WMNCActivate(var Msg : TWMNCActivate);
begin
  Inherited;
  DrawTitleButton;
end;


{Painting events}
procedure TForm1.WMNCPaint(var Msg : TWMNCPaint);
begin
  Inherited;
  DrawTitleButton;
end;

procedure TForm1.WMSetText(var Msg : TWMSetText);
begin
  Inherited;
  DrawTitleButton;
end;

{Mouse-related procedures}
procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);
begin
  Inherited;
  {Check to see if the mouse was clicked in the area of the button}
  with Msg do
    if PtInRect(TitleButton, Point(XPos - Left, YPos - Top)) then
      Result := htTitleBtn;
end;

procedure TForm1.WMNCLButtonDown(var Msg : TWMNCLButtonDown);
begin
  inherited;
  if (Msg.HitTest = htTitleBtn) then
    ShowMessage('You pressed the new button');
end;

function TForm1.GetVerInfo : DWORD;
var
 verInfo : TOSVERSIONINFO;
begin
  verInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
  if GetVersionEx(verInfo) then
    Result := verInfo.dwPlatformID;
    {Returns:
      VER_PLATFORM_WIN32s             Win32s on Windows 3.1
      VER_PLATFORM_WIN32_WINDOWS        Win32 on Windows 95
      VER_PLATFORM_WIN32_NT           Windows NT }
end;

procedure TForm1.FormResize(Sender: TObject);
begin
  Perform(WM_NCACTIVATE, Word(Active), 0);
end;

end.

you will see the main piece of code you require is under the procedure TForm1.WMNCHitTest(var Msg : TWMNCHitTest);

Later
BoRiS

Hi Boris,

why so complex? There is an easier way, but i've now weekend, monday i will place a bit code as comment if the answer not accepted by knowIten

meikl

The detection must work with a region of N sides...meaning...a square, hexagon, octagon, or how ever many sides are defining the region.

The polygon will always be closed:

__   __   __
\  \ /    \ /  /
 \__ /\__ /

How would I determin if I've clicked inside the W?

Travel from the click point to a point known to be outside the polygon and count the number of times a side of the polygon is crossed. If it's odd, click point is inside; even = inside.

See MS KB Q121960 for a C++ implementation of an algorithm from "Algorithms" by Sedgewick.

D'oh! Typo:

"even = OUTSIDE"

Okay, let's do this.  

Make a small demo for me in Delphi 3 that allows the user to:

1)  Draw a polygon as you enter x,y coordinates for each line endpoint.  The last set of coordinates would close the polygon...first and last coords will be identical.
2)  Allow you to click inside the polygon and tell you if you're inside / outside.

I'll increase the points to 100 for the first working demo with source code included.

Send it to:  knowltonfamily@yahoo.com

Use a region to make this really easy! Like this: (all coordinates are device coordinates)

uses
  Windows, etc

const
  MaxPoints = 100;

type
 POINT = record
    x, y : Longint;
 end;

 PointArray = Array[1..MaxPoints] of Point;

Function MakeTheRegion(Points : PointArray;
                                       NumPoints : Integer):THandle;

begin
  Result := CreatePolygonRgn(Point, NumPoints, Alternate);
end;

// in your main code...

var
  ThePoints : PointArray;
  TheRgn : Thandle;

begin
//Fill in the point array
  for I := 1 to NPoints do
    begin
       ThePoints[i].x := TheXValue;
       ThePoints[i].y := TheYValue;
    end;
  TheRgn := MakeTheRegion(ThePoints, NPoints);
  if TheRgn = 0 then
   ;  // Something went wrong - display a message
.


 // Did they click in the region?
  if ptinregion(TheRgn, x, y) then
    ; // Do what you need to here...

.



end;

Cheers,

Raymond.

Raymond is correct as he always is :))

btw- Ryamnond, ya sleeping on the E-E?? :)

Cheers,
Viktor

Not sleeping Viktor... Answering Q's!

Cheers,

Raymond.

rwilson's code looks functional....but I'm requesting a demo with source code, please.  Please read the specs carefully.

Send the source code to:

knowltonfamily@yahoo.com

This means that go GET THE POINTS you will have to e-mail me the source code.

Maybe I should repost this question and be a little clearer on exactly what I want.

Thank you.

Tom

Tom, what he gave you is almost what you need to create the demo... YOu just need to add a thing or two,..

btw- Raymond, do you have an occupation??

Regards,
Viktor Ivanov

Viktornet:

If rwilson can supply the code, then how much more work is it to zip up the source code and send it to me?

Tom

I don't have a demo app - this was typed in off the top of my head. It is deliberately incomplete in terms of where to get the actual values from as this will depend on your code. I appreciate your desire for a complete demo, though this should really just be a cut and paste job into your own code.

To be honest there is nothing more to add to it - the demo would just be a wrapper that you would throw away to use the code in my answer.

Viktor: I am a software engineer (see my profile...)

Raymond.

Here's a really simple PtinPoly function. It only works on convex polys however:

type
  PPtArray = ^TPtArray;
  TPtArray = array[0..0] of TPoint;

const
  Poly: array[0..8] of TPoint =
  ((x:0;y:60),(x:20;y:20),(x:60;y:0),(x:100;y:20),
   (x:120;y:60),(x:100;y:100),(x:60;y:120),(x:20;y:100),
   (x:0;y:60));

function ptinpoly( prgrtVertice: PPtArray; cVertices: Integer; ptTest: TPoint ): Boolean;
var
  x, y, nx, ny, iIndex: Integer;
begin
  Result := True;
  for iIndex := 0 to cVertices - 1 do
  begin
    nx := prgrtVertice^[ ( iIndex + 1 ) mod cVertices ].y - prgrtVertice[ iIndex ].y;
    ny := prgrtVertice[ iIndex ].x - prgrtVertice[ ( iIndex + 1 ) mod cVertices ].x;
    x := ptTest.x - prgrtVertice^[ iIndex ].x;
    y := ptTest.y - prgrtVertice^[ iIndex ].y;
    if ( ( x * nx ) + ( y * ny ) > 0 ) then
      Result := False;
  end;
end;

procedure TForm1.FormPaint(Sender: TObject);
begin
  Canvas.Polygon( Poly );
end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  if ptinpoly( @Poly, 8, Point( x, y ) ) then
    Canvas.Brush.Color :=clRed
  else
    Canvas.Brush.Color :=clBtnFace;
  Canvas.Polygon( Poly );
end;

/// John

Hi again,
Here's a much better function. It works on any single polygon.
If the polygons are very large, you should use float values instead:

function ptinpoly( prgrtVertice: PPtArray; cVertices: Integer; ptTest: TPoint ): Boolean;
var
  c, i, j: Integer;
begin
  Result := False;
  j := cVertices - 1;
  for i := 0 to cVertices - 1 do
  begin
    if ( ( ( ( prgrtVertice^[ i ].y <= ptTest.y ) and ( ptTest.y < prgrtVertice^[ j ].y ) ) or
    ( ( prgrtVertice^[ j ].y <= ptTest.y ) and ( ptTest.y < prgrtVertice^[i].y ) ) ) and
    ( ptTest.x < ( prgrtVertice^[ j ].x - prgrtVertice^[ i ].x ) * ( ptTest.y - prgrtVertice^[ i ].y ) div
    ( prgrtVertice^[ j ].y - prgrtVertice^[ i ].y ) + prgrtVertice^[ i ].x ) ) then
      Result := not Result;
    j := i;
  end
end;

The code is ported from "comp.graphics.algorithms Frequently Asked Questions", subject 2.03: How do I find if a point lies within a polygon?

/// John

Here's a very simple way to create a poly from a rect, just to supplement:

function RectToPoly( ARect: TRect ): PPtArray;
type
  PPt4Array = ^TPt4Array;
  TPt4Array = array[0..3] of TPoint;
begin
  GetMem( Result, 4 * SizeOf( TPoint ) );
  PPt4Array( Result )^[ 0 ] := ARect.TopLeft;
  PPt4Array( Result )^[ 1 ] := Point( ARect.Right, ARect.Top );
  PPt4Array( Result )^[ 2 ] := ARect.BottomRight;
  PPt4Array( Result )^[ 3 ] := Point( ARect.Left, ARect.Bottom );
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RectPoly := RectToPoly( Rect( 100, 100, 300, 200 ) );
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeMem( RectPoly );
end;

/// John

rwilson:

Whatever you say.  :)

Please resubmit your answer so I can give you your points.

Thank you for your help, even if it didn't *quite* come the way I needed it.

Tom