How to determine cursor position in an image

[Oseitutuakrasi]

I am using the MouseMove function (and other related functions) to move a picture of one image control onto another image control. The image/picture can be placed on a number of image controls so I have to detect which control the user has dropped the control on. I am using the MouseMove and the MouseDown functions of the source image (NOT the target) . Unfortunately, I cannot determine which control has received the image. I have tried using the X, Y parameters of the MouseDown to determine if it is within the boundaries of the target image (X > image1.left, Y > image1.Top etc), but the problem is that the Left/Top properties of the control are relative to the userform , whereas the X, Y are relative to the control. Also the units are different (Points v Twips). A workaround will be to let the user click the control again after she has dropped it, but that will be confusing since it is not natural.

I will appreciate any help.

Thanks

 

[Dan_W]

I could be wrong, but I don't think you get twips on VBA UserForms - you definitely get them on VB6 Forms, but I thought everything on the VBA UF was points. In any case, you could use a mouse Win32 API to return the cursor's X and Y coordinates relative to the UserForm (in pixels) and then calculate that and etc etc etc.

But if the goal is to detect which control the user has dropped the dragged control onto, you could probably just skip all of that, and test to see whether the one shape has 'collided' with the other. Here, you would use the approach you have used above, but adjust it to take into account the Height and Width of the dragged control. So:

If DraggedControl.Left >= Image1.Left And DraggedControl.Left <= Image1.Left + Image1.Width Then
    If DraggedControl.Top >= Image1.Top And DraggedControl.Top <= Image1.Top + Image1.Height Then

... for example... This would test if the top left hand side of the dragged control 'lands' on the Image1 control. You would need to test each of the corner I suppose, but I'm really just guessing that this is how you're drag/dropping it... Would that work?

 

[Oseitutuakrasi]

I could be wrong, but I don't think you get twips on VBA UserForms - you definitely get them on VB6 Forms, but I thought everything on the VBA UF was points. In any case, you could use a mouse Win32 API to return the cursor's X and Y coordinates relative to the UserForm (in pixels) and then calculate that and etc etc etc.

But if the goal is to detect which control the user has dropped the dragged control onto, you could probably just skip all of that, and test to see whether the one shape has 'collided' with the other. Here, you would use the approach you have used above, but adjust it to take into account the Height and Width of the dragged control. So:

If DraggedControl.Left >= Image1.Left And DraggedControl.Left <= Image1.Left + Image1.Width Then
    If DraggedControl.Top >= Image1.Top And DraggedControl.Top <= Image1.Top + Image1.Height Then

... for example... This would test if the top left hand side of the dragged control 'lands' on the Image1 control. You would need to test each of the corner I suppose, but I'm really just guessing that this is how you're drag/dropping it... Would that work?

Thanks Dan for your time. They say the sweetness of the pudding is in the eating so I will try your suggestion. If you don't hear from me again about this then it means it worked.
Have a nice day.

PS: All documentation suggest that the Left/Right/Top etc. properties of VBA objects use points, but X and Y are in twips. I will investigate further. It doesn't make sense to me though that it should be that. Very confusing!

Samuel.

 

[Jaafar Tribak]

I am using the MouseMove function (and other related functions) to move a picture of one image control onto another image control.

If you just want to mouse-drag controls around from one image control to another then why not use the BeforeDragOver & BeforeDropOrPaste events.

If you want to apply this functionality to various\all image controls on the userform , the best thing is to do it via a class module.

The following solution does the following:

A- Pressing the CTRL key while dragging the mouse will copy the image.
B- Pressing the SHIFT key while dragging the mouse will move the image.
C- Pressing the ALT key while dragging the mouse will swap the images.

See Workbook Demo:
DragImages.xlsm



1- Class Module code (Class named CImageMover):

Option Explicit

Private WithEvents imEvents As MSForms.Image
Private oForm As MSForms.UserForm


' _____________________________________ CLASS METHODS _____________________________________________

Public Property Set ParentForm(ByVal vNewValue As MSForms.UserForm)
    Dim imHolder As MSForms.Image
    Set oForm = vNewValue
    On Error Resume Next
        Set imHolder = oForm.Controls("imgHolder")
    On Error GoTo 0
    If imHolder Is Nothing Then
        Set imHolder = oForm.Add("Forms.image.1", "imgHolder", False)
        With imHolder
            .Width = 0&
            .Height = 0&
            .Top = -500&
            .Left = -500&
        End With
    End If
End Property

Public Property Set Image(ByVal vNewValue As MSForms.Image)
    Set imEvents = vNewValue
End Property


' _____________________________________ EVENTS _____________________________________________

Private Sub imEvents_MouseDown( _
    ByVal Button As Integer, _
    ByVal Shift As Integer, _
    ByVal X As Single, _
    ByVal Y As Single _
)
    Dim MyDataObject As MSForms.DataObject, imgHolder As MSForms.Image
 
    If Not imEvents.Picture Is Nothing Then
        If Button = 1& Then
            Set MyDataObject = New MSForms.DataObject
            On Error Resume Next
                Set imgHolder = oForm.Controls("imgHolder")
            On Error GoTo 0
            If Not imgHolder Is Nothing Then
                Set imgHolder = oForm.Controls("imgHolder")
                Set imgHolder.Picture = imEvents.Picture
                imgHolder.Tag = imEvents.Name
            End If
            Call MyDataObject.StartDrag
        End If
    End If
End Sub

Private Sub imEvents_BeforeDragOver( _
    ByVal Cancel As MSForms.ReturnBoolean, _
    ByVal Data As MSForms.DataObject, _
    ByVal X As Single, _
    ByVal Y As Single, _
    ByVal DragState As MSForms.fmDragState, _
    ByVal Effect As MSForms.ReturnEffect, _
    ByVal Shift As Integer _
)
    Cancel = True
End Sub

Private Sub imEvents_BeforeDropOrPaste( _
    ByVal Cancel As MSForms.ReturnBoolean, _
    ByVal Action As MSForms.fmAction, _
    ByVal Data As MSForms.DataObject, _
    ByVal X As Single, _
    ByVal Y As Single, _
    ByVal Effect As MSForms.ReturnEffect, _
    ByVal MaskKeys As Integer _
) 
    Dim imgHolder As MSForms.Image
 
    On Error Resume Next
        Set imgHolder = oForm.Controls("imgHolder")
    On Error GoTo 0
    With oForm
        If Not imgHolder Is Nothing Then
            .DesignMode = fmModeOn
            Select Case MaskKeys And 7&
                Case Is = 1&  'Move Image (press SHIFT Key)
                    .Controls(imgHolder.Tag).Picture = Nothing
                    Set imEvents.Picture = imgHolder.Picture
                Case Is = 2&  'Copy Image (press CTRL Key)
                    Set imEvents.Picture = imgHolder.Picture
                Case Is = 4& 'Swap Images (press ALT Key)
                    .Controls(imgHolder.Tag).Picture = imEvents.Picture
                    Set imEvents.Picture = imgHolder.Picture
            End Select
            .DesignMode = fmModeOff
            .Repaint
        End If
    End With
End Sub

2- UserForm Module:

Option Explicit

Private oImages  As Collection

Private Sub UserForm_Initialize()
    Dim oCImage As CImageMover, oImage As MSForms.Control
    Set oImages = New Collection
    For Each oImage In Me.Controls
        If TypeOf oImage Is MSForms.Image Then
            Set oCImage = New CImageMover
            Set oCImage.ParentForm = Me
            Set oCImage.Image = oImage
            oImages.Add oCImage
        End If
    Next oImage
End Sub

 

[Oseitutuakrasi]

Thanks Jaafar. This looks like a heavy load for me but I will try to understand it and incorporate into my code. By the way what is the DragImage.xlsm you have attached? I tried to open it but it took me to some website for a registration. Wish I could know more.
Anyway, thanks for your time.

Regards,
Samuel

 

[Jaafar Tribak]

By the way what is the DragImage.xlsm you have attached? I tried to open it but it took me to some website for a registration. Wish I could know more.
Anyway, thanks for your time.

DragImage.xlsm is just a demo file I uploaded for you on the Box.com file sharing website for you to see how the code works .... Just click on the page download button located at the top right of the page and the file should be saved to your computer ... AFAIK, you don't need to register in oder to download a file .

 

[Oseitutuakrasi]

DragImage.xlsm is just a demo file I uploaded for you on the Box.com file sharing website for you to see how the code works .... Just click on the page download button located at the top right of the page and the file should be saved to your computer ... AFAIK, you don't need to register in oder to download a file .

Thanks so much. Cheers
Sam

 

[Jaafar Tribak]

Thanks so much. Cheers
Sam

You are welcome.

So, did it work for you in the end ?