Click on different part of picture to perform different event 2

[Oliver2003]

I would like to click on different parts of a picture to perform an action, such as display another from or msg box.

I have looked at using transparent rectangular labels, but the areas that need to be detected are not rectangular. So I guess I need to use the x, y coordinates and check they are within some predefined x, y values?

This is where I need some help, Any ideas or suggestions on how to achieve this would be appreciated

Thank you
Oliver

 

[strongm]

I'd have a look at the following two API calls: CreatePolygonRgn and PtInRegion

 

[Oliver2003]

Hi strongm, thank you for your reply, I've been having a look at them over the last few days.

I have set up the following basic code to create a region and check if the area inside the region has been clicked. The Polyline API has been used to show the region visually.

But some clicks inside the region are not detected (near to the edges) and clicks outside the region, again near the edges are detected as true in particular areas - is this normal or are there errors in the code? Is it possible to get more accurate detection?

Thanks again!

Module1
*********************
Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, _
ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long

Declare Function Polyline Lib "gdi32" (ByVal hdc As Long, lpPoint As _
POINTAPI, ByVal nCount As Long) As Long

Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long

Declare Function PtInRegion Lib "gdi32.dll" (ByVal hRgn As Long, ByVal x As Long, ByVal y As Long) As Long

Public Type POINTAPI
x As Long
y As Long
End Type

Form1
**********
Dim test As Long
Dim Points(1 To 4) As POINTAPI

Private Sub Command1_Click()'create and outline region
Points(1).x = 500
Points(1).y = 500
Points(2).x = 20
Points(2).y = 20
Points(3).x = 640
Points(3).y = 20
Points(4).x = 500
Points(4).y = 500
Call Polyline(Form1.hdc, Points(1), 4)
test = CreatePolygonRgn(Points(1), 4, 1)
End Sub

Private Sub Form_Click()
Dim curpos As POINTAPI
retval = GetCursorPos(curpos)' Get the current position of the mouse cursor.
isinside = PtInRegion(test, curpos.x, curpos.y) ' is the point in the region?
If isinside = 1 Then ' inside
Debug.Print "1"
End If
End Sub

 

[strongm]

I'm afraid that the function is dead accurate. Unfortunately your units (for cursorpos.X and cursorpos.Y)are not...

 

[koala15]

An alternative approach:

Create a PictureBox control and load it with an image.

In the MouseUp event for that control compare the (X,Y) of the mouse as returned in the event args to your various regions. This also has the benifit that any clicks outside your PictureBox(s) are ignored.

Cheers.

"Life is full of learning, and then there is wisdom"

 

[Hypetia]

Oliver, you code is ok but you are using wrong coordinates for hit-tesing as strongm said.

The polygon region you created resides on your form's client area. On the other hand the coordinates of the cursor position retrieved by the GetCursorPos function is the absolute cursor position from the top-left corner of the screen. Before hit-testing, you should convert your cursor position relative to the client area of the form.
The ScreenToClient API function does exactly this.

Include the following API declaration in Module1.
___
[tt]
Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long[/tt]
___

Now modify your Form_Click code as shown below.
___
[tt]
...
retval = GetCursorPos(curpos) ' Get the current position of the mouse cursor.[/tt]
[tt]ScreenToClient hwnd, curpos 'convert the cursor pos relative to form's client area.[/tt]
[tt]isinside = PtInRegion(test, curpos.x, curpos.y) ' is the point in the region?
...[/tt]
___

The ScreenToClient function converts the cursor position relative to the client area of the form as expected by the PtInRegion function.

 

[strongm]

Koala,

the original post states "the areas that need to be detected are not rectangular", which is why we are exploring different methods from rectangular picture boxes.

 

[Oliver2003]

strongm, koala15, Hypetia thank you for your comments. The modified code by Hypetia now makes it work excellent!

I was wondering what is the best way to check multiple regions on the same form/picture instead of repeating:

isinside = PtInRegion(test, curpos.x, curpos.y)
If isinside = 1 Then ' inside
Debug.Print "1"
End If

Is it possible to permanently fix the value of test returned by CreatePolygonRgn (this changes every time the program is run)

Eventually what I am looking at doing is having the regions defined during run time (i.e. setup) and then storing the coordinates (db or file)along with a name for that particular region. Then in normal use when a region has been clicked for example its name would be displayed. The problem is the value of the region changes each time the program is run.

Thank you
Oliver

 

[koala15]

strongm,

Thanks but ....

Even though the picture box itself is rectangular that does not imply that the co-ordinate areas need to be. So when a specific (x,y) is returned from the MouseUp event, it needs to be interpreted with respect to the local location, viz if the picture box shows Betty and Sue, then clicking on one may have a different outcome from the other.

"Life is full of learning, and then there is wisdom"

 

[strongm]

Yes. The point being that a picturebox in itself is not the solution.

 

[koala15]

Agreed, but as I said, the interpretation of (x,y) is a solution.

I am really not interested in the PictureBox itself. except as a vehicle to give a (x,y) co-ordinate.

It is up to the developer to make decision(s) based on a particular (x,y).

For example, if the shapes within the PictureBox were a triangle and a hexagon, it is a matter of performing some high school maths to determine if the (x,y) clicked within the PictureBox were within one or the other shape, given that they did not overlap.

"Life is full of learning, and then there is wisdom"

 

[strongm]

Sorry to be a real pain, but let's just check. Your solution is:

1. Use a picture box (or, latterly, whatever container you like) as a container for your arbitary irregular shape(s)
2. Write yourself some (unspecified) code that figures out whether X,Y is in your arbitary irregular shape(s)

whilst the original question is:

How do I figure out whether X,Y is in an arbitary irregular shape?

 

[strongm]

Oliver,

here is an example of spotting and returning a mouse down in one of several arbitary region, including identifying which of the several regions you clicked in:

[COLOR=blue]
Option Explicit

Private Points(1 To 5) As POINTAPI
Private RegionDictionary As Dictionary 'Requires that Microsoft Scripting Runtime library is added as Reference

Private Declare Function FrameRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function PtInRegion Lib "gdi32.dll" (ByVal hRgn As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Const BLACK_BRUSH = 4

Private Type POINTAPI
        X As Long
        Y As Long
End Type


Private Sub Form_Load()
    Dim lp As Long
    Dim myrgn As Long
    
    Me.ScaleMode = vbPixels ' avoids us having to muck about with converting coordinate spaces
    Me.Show
    DoEvents ' Make sure form is visible so we can see region outlines
    
    Set RegionDictionary = New Dictionary

    ' Set up 5 irregular(ish) shapes, and save them in a Dictionary
    For lp = 0 To 225 Step 55
        Points(1).X = lp
        Points(1).Y = lp
        Points(2).X = lp
        Points(2).Y = lp + 50
        Points(3).X = lp + 25
        Points(3).Y = lp + 25
        Points(4).X = lp + 50
        Points(4).Y = lp + 50
        Points(5).X = lp + 50
        Points(5).Y = lp
    
        myrgn = CreatePolygonRgn(Points(1), 5, 1)
        FrameRgn Form1.hdc, myrgn, GetStockObject(BLACK_BRUSH), 1, 1
        RegionDictionary.Add "Region " & (lp / 55) + 1, myrgn
    Next
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lp As Long
    
    ' loop through all regions to see if we get a hit
    For lp = 0 To RegionDictionary.Count - 1
        If PtInRegion(RegionDictionary.Items(lp), X, Y) Then
            MsgBox "We are in: " & RegionDictionary.Keys(lp)
        End If
    Next
End Sub
[/color]

 

[Oliver2003]

strongm, thank you for the example, that’s great!!

When using FrameRgn to draw the outline inside the region, I am drawing these over an image on the form. Is it possible to save the outline's of the regions to the image so that when the form is minimised / maximised the outlines of the regions are still there?

Thanks
Oliver

 

[strongm]

There are a number of ways. here's one that illustrates using the Paint event:

[COLOR=blue]
Option Explicit

Private Points(1 To 5) As POINTAPI
Private RegionDictionary As Dictionary 'Requires that Microsoft Scripting Runtime library is added as Reference

Private Declare Function FrameRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function PtInRegion Lib "gdi32.dll" (ByVal hRgn As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Const BLACK_BRUSH = 4

Private Type POINTAPI
        X As Long
        Y As Long
End Type


Private Sub Form_Initialize()
    Set RegionDictionary = New Dictionary
End Sub

Private Sub Form_Load()
    Dim lp As Long
    Dim myrgn As Long
    
    Me.ScaleMode = vbPixels ' avoids us having to muck about with converting coordinate spaces
    Me.Show
    DoEvents ' Make sure form is visible so we can see region outlines
    
    

    ' Set up 5 irregular(ish) shapes, and save them in a Dictionary
    For lp = 0 To 225 Step 55
        Points(1).X = lp
        Points(1).Y = lp
        Points(2).X = lp
        Points(2).Y = lp + 50
        Points(3).X = lp + 25
        Points(3).Y = lp + 25
        Points(4).X = lp + 50
        Points(4).Y = lp + 50
        Points(5).X = lp + 50
        Points(5).Y = lp
    
        myrgn = CreatePolygonRgn(Points(1), 5, 1)
        FrameRgn Form1.hdc, myrgn, GetStockObject(BLACK_BRUSH), 1, 1
        RegionDictionary.Add "Region " & (lp / 55) + 1, myrgn
    Next
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lp As Long
    
    ' loop through all regions to see if we get a hit
    For lp = 0 To RegionDictionary.Count - 1
        If PtInRegion(RegionDictionary.Items(lp), X, Y) Then
            MsgBox "We are in: " & RegionDictionary.Keys(lp)
        End If
    Next
End Sub

Private Sub Form_Paint()
    Dim lp As Long
    
    ' loop through all regions to see if we get a hit
    For lp = 0 To RegionDictionary.Count - 1
        FrameRgn Form1.hdc, RegionDictionary.Items(lp), GetStockObject(BLACK_BRUSH), 1, 1
    Next
End Sub
[/color]

 

[koala15]

strongm,

A star to you ..... I like your solution much better than mine. To determine if a point was in a polygon, I was going to draw the finite number of enclosed triangles (using the vertices of the polygon as the vertices of the triangles) and then see if the point clicked was within any of the triangles by using simple trig.

BUT .... why do that when (by using gdi32 functions) your solution is much more simple and elegant.

Cheers.

"Life is full of learning, and then there is wisdom"

 

[Oliver2003]

strongm, thanks for your help and the example.

I have been having a looking at saving the regions to an image file using the BitBlt API and came across a problem! - when using the image control you can set its Enabled property to False so that the regions are displayed in front of the image and are still active (i.e. clicking on image >> Form_MouseDown event).

As I have changed the image control to a PictureBox for use with the BitBlt API, the regions are drawn behind the picturebox. Is it possible to draw the regions over the picture box so that they are visible and active (the same as with the image control) ?

 

[strongm]

Sure. I leave it to you to spot the (not so) subtle differences from the previous version, and so figure out for yourself how to extend this to other control surfaces...

[COLOR=blue]
Option Explicit

Private Points(1 To 5) As POINTAPI
Private RegionDictionary As Dictionary 'Requires that Microsoft Scripting Runtime library is added as Reference

Private Declare Function FrameRgn Lib "gdi32" (ByVal hdc As Long, ByVal hRgn As Long, ByVal hBrush As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
Private Declare Function PtInRegion Lib "gdi32.dll" (ByVal hRgn As Long, ByVal X As Long, ByVal Y As Long) As Long

Private Const BLACK_BRUSH = 4

Private Type POINTAPI
        X As Long
        Y As Long
End Type


Private Sub Form_Initialize()
    Set RegionDictionary = New Dictionary
End Sub

Private Sub Form_Load()
    Dim lp As Long
    Dim myrgn As Long
    
    Me.ScaleMode = vbPixels ' avoids us having to muck about with converting coordinate spaces
    Picture1.ScaleMode = vbPixels
    Me.Show
    DoEvents ' Make sure form is visible so we can see region outlines
    
    

    ' Set up 5 irregular(ish) shapes, and save them in a Dictionary
    For lp = 0 To 225 Step 55
        Points(1).X = lp
        Points(1).Y = lp
        Points(2).X = lp
        Points(2).Y = lp + 50
        Points(3).X = lp + 25
        Points(3).Y = lp + 25
        Points(4).X = lp + 50
        Points(4).Y = lp + 50
        Points(5).X = lp + 50
        Points(5).Y = lp
    
        myrgn = CreatePolygonRgn(Points(1), 5, 1)
        FrameRgn Picture1.hdc, myrgn, GetStockObject(BLACK_BRUSH), 1, 1
        RegionDictionary.Add "Region " & (lp / 55) + 1, myrgn
    Next
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lp As Long
    
    ' loop through all regions to see if we get a hit
    For lp = 0 To RegionDictionary.Count - 1
        If PtInRegion(RegionDictionary.Items(lp), X, Y) Then
            MsgBox "We are in: " & RegionDictionary.Keys(lp)
        End If
    Next
End Sub

Private Sub Form_Paint()
    Dim lp As Long
    
    ' loop through all regions to see if we get a hit
    For lp = 0 To RegionDictionary.Count - 1
        FrameRgn Picture1.hdc, RegionDictionary.Items(lp), GetStockObject(BLACK_BRUSH), 1, 1
    Next
End Sub
[/color]

 

[Oliver2003]

strongm
Thank you, you’ve been really helpful

 

[strongm]

Enjoy