[RESOLVED] How to Drag and Drop a control at runtime?

[camoore]

In an application I have a small picture box (picture2) inside a larger picture box (picture1). Pic2 is a colour key to things being shown in the main Pic1.

Depending upon the nature of the current Pic1, I want the user to be able to drag and drop Pic2 to an unimportant section of Pic1 (so as not to obscure significant parts of Pic1, depending on its current content).

Is there please a simple way to implement drag-and-drop at runtime?

I solved the problem in an inelegant manner by writing a routine. I used MOUSEDOWN on the top, bottom or sides of the secondary picture box (Pic2) to prompt a 0.1 sec. timer to amend the TOP and / or LEFT properties of the seconday Picture box to move it in the indicated direction - ie. up/down/left/right.

However, this is not a true Drag-and-Drop process.

I request suggestions as to how this could better be achieved.

camoore

West Wales, UK

[LaVolpe]

Here is a modified version of a drag routine offered up by Francesco Balena himself.
Declarations first, these go at the top of your form

Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Type RECT
    Left    As Long
    Top     As Long
    Right   As Long
    Bottom  As Long
End Type
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
Private Declare Function ScreenToClient Lib "user32.dll" (ByVal hWnd As Long, ByRef lpPoint As POINTAPI) As Long
Private Declare Function GetCapture Lib "user32.dll" () As Long
Private Declare Function ReleaseCapture Lib "user32.dll" () As Long

Here is the routine, add it anywhere in your form

Private Function DragControl(theCtrl As Control) As Boolean

    ' this function borrowed from > http://www.devx.com/vb2themax/Tip/18998
    ' added tweaks include cancel dragging when Escape is pressed or another window takes focus
    
    ' returns False only if control movement was aborted
    ' always call this from the control's MouseDown event
    
    
    Dim mPt As POINTAPI                     ' current mouse position
    Dim dragOffset As POINTAPI              ' relational offset from cursor to control on the container
    Dim dragRestore As POINTAPI             ' original control position
    Dim dragClip As RECT                    ' cursor clipping boundaries
    Dim dragScaleMode As ScaleModeConstants ' control container's scalemode
    Dim dragHwnd As Long
    Dim bAborted As Boolean                 ' function return value
    
    If theCtrl Is Nothing Then Exit Function
    If GetAsyncKeyState(vbLeftButton) Then
    
        On Error Resume Next
        dragScaleMode = vbTwips                         ' not all controls have ScaleMode properties (i.e, VB's Frame control)
        dragScaleMode = theCtrl.Container.ScaleMode     ' but if it doesn't, then VB defaults to Twips
        If Err Then Err.Clear
        dragHwnd = theCtrl.hWnd
        If Err Then
             Err.Clear
             dragHwnd = theCtrl.Container.hWnd
        End If
        On Error GoTo 0
        
        GetCursorPos mPt                                ' get current mouse position in screen coords
        ' here we will be doing a few things
        ' 1. Get the position of the left/top edge of the control, in screen coords
        dragOffset.X = Me.ScaleX(theCtrl.Left, dragScaleMode, vbPixels)
        dragOffset.Y = Me.ScaleY(theCtrl.Top, dragScaleMode, vbPixels)
        ClientToScreen theCtrl.Container.hWnd, dragOffset
        ' 2. Get the position of the left/top edge of the form's client area, in screen coords
        dragRestore.X = 0&: dragRestore.Y = 0&
        ClientToScreen theCtrl.Container.hWnd, dragRestore
        ' 3. Now get the client's width/height, and create a cursor clipping region to those dimensions, in screen coords
        GetClientRect theCtrl.Container.hWnd, dragClip
        dragClip.Left = dragRestore.X
        dragClip.Top = dragRestore.Y
        dragClip.Right = dragClip.Right + dragRestore.X
        dragClip.Bottom = dragClip.Bottom + dragRestore.Y
        ' 4. Calculate from any cursor position, the relative distance the left/top edge of the control will be moved
        dragOffset.X = mPt.X - (dragOffset.X - dragRestore.X)
        dragOffset.Y = mPt.Y - (dragOffset.Y - dragRestore.Y)
        ' 5. Cache current position should user hit Escape or another window steals focus while dragging the control
        dragRestore.X = theCtrl.Left
        dragRestore.Y = theCtrl.Top
        ' 6. Prevent user from dragging control out of the container's dimensions
        ClipCursor dragClip
        
        Do  ' set a continuous loop while moving the control
            If GetAsyncKeyState(vbLeftButton) = 0 Then
                Exit Do ' left button no longer down
            ElseIf GetAsyncKeyState(vbKeyEscape) <> 0 Then
                ReleaseCapture  ' user hit escape, release the mouse capture
                bAborted = True
                Exit Do
            ElseIf GetCapture() <> draghWnd Then
                bAborted = True ' some other window has stolen focus, we're done
                Exit Do
            Else    ' well, we can continue, move the control
                GetCursorPos mPt
                theCtrl.Move Me.ScaleX(mPt.X - dragOffset.X, vbPixels, dragScaleMode), Me.ScaleY(mPt.Y - dragOffset.Y, vbPixels, dragScaleMode)
            End If
            DoEvents
        Loop
        ClipCursor ByVal 0& ' exiting loop, ensure we remove the cursor clipping region
        If bAborted = True Then theCtrl.Move dragRestore.X, dragRestore.Y
    Else
        bAborted = True
    End If
    DragControl = Not bAborted
    
End Function

Here's how you call it....

Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' The function checks for LeftButton vs right/middle
    DragControl Picture2
End Sub

Note the original source is referenced in the routine. The routine and declarations can be moved to a module so it can be used by all forms in your project, assuming you also made the routine Public vs private.

Edited: The original posted code was customized for windowless controls that do not have Hwnds. The above is modified to handle both windowed & windowless controls.

[camoore]

Thank you LaVolpe. That looks to be a pretty complicated set of code which will take a bit of studying to understand. However I am pleased that it WAS thus complicated since it means that I haven't missed something incredible simple and straightforward!

The code for my pseudo drag&drop routine is a lot simpler, but as stated it is not a true drag&drop function although it achieves more or less the same result.

I will make a further post when I have had an opportinity to test that code.

Thanks again

camoore

Wales, UK

[LaVolpe]

There is much simpler code to drag a control around the form, some of the simplest are only a few lines of code. But if you want something that is more generic and/or has more options or is more precise, you usually find yourself writing a bit more.

[VBClassicRocks]

Keith, couldn't get it to work until I made the change below

From:

           ElseIf GetCapture() <> theCtrl.Container.hWnd Then

To:

            ElseIf GetCapture() <> theCtrl.hWnd Then

[LaVolpe]

Ugh. My bad. I should have caught that myself. The version I posted is for a dragging a windowless control (i.e., image, label, windowless-usercontrol, etc). Windowless controls can't get capture, their containers do. Windowed controls on the other hand obviously do get capture.

Thanx. I'll post a quick update to the routine so it is truly generic. -- Done, posted code patched.

[VBClassicRocks]

For the OP: Here's a simple drag control, pure VB, with both
the dragged control and the container having the same ScaleMode:

Option Explicit
Private OffsetX As Single  ' offsets into the dragged control
Private OffsetY As Single
Private Dragging As Boolean
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 OffsetX = X   'get the offsets
 OffsetY = Y
 Dragging = True  ' & signal dragging
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 If Dragging Then
  Picture1.Left = Picture1.Left + X - OffsetX
  Picture1.Top = Picture1.Top + Y - OffsetY
  Refresh
 End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
 Dragging = False
End Sub

[some1uk03]

A simple way would be:

Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
ReleaseCapture
SendMessage Picture2.hWnd, &H112, &HF012&, 0
End Sub

[camoore]

This a quick reply to some1uk03. Thanks for what looks to be a very simple and easy-to-use piece of code. I wrote a quick program and it seems to work fine except :

1. If I try to make it work with a label, I get an immediate error at label mousedown ("compile error. Method or data member not found")

2. It happily drags and drops a command button and a text box to anywhere on the screen, but having the routine in the program appears to inhibit the CLICK functions of those two controls. Thus the command button ceases to work as such.

Do you have any thoughts about this? Reading the thread, it may be to do with a windowed or windowless control? However your routine does exactly what I need at the moment (viz. drag and drop a picture box around the inside of another). I do not yet know if it inhibits the picture box's click event - but do not need this anyway at present.

Thanks also to vbclassicrocks and lavolpe. I will try out their code when I get home tonight.

camoore

Wales, UK

[some1uk03]

Yes, the one I posted only works for controls with a .hWnd property. The label is a lightweight control and it does not have a .hWnd property.

A workaround is to either use the code LaVolpe posted above, or an easier way would be to add the Label inside a picturebox ? or rather use pixtureboxes as labels and PRINT inside them via the DrawText API.

[camoore]

I understand that certain types of controls, such as labels, can not be dragged and dropped by the routine kindly suggested by some1uk03. So long as one knows this as a limitation, it can easily be lived with. Use a Text box or something else instead.

The remaining problem was that the implementation of the routine upon a control seemed to destroy/inhibit that control's "click" function. For example, a Command button would happily be drag/dropped by the routine, but would not respond at all to a mouse click.

My simple solution to this is shown in the code below. All this requires is a form and a single standard command button (command 1) to run.

I have added to the Mousedown event "If Shift and 2 then " as a condition.

Thus if the CONTROL key is held down and the mouse is then used to drag/drop it works perfectly as some1uk03 proposed. But if the CONTROL key is not held down, the Command Button (in this instance) functions normally. In my test program, its function is just to change its Caption, so you know something has happened.

It seems no hardship just to hold down the CONTROL key while effecting a drop/drag, and this simple addition appears to eliminate the main problem with that routine which I found viz. the inhibition of the click event of the control concerned.

Therefore my problem does seem to have been solved, vmt. However I will not mark the thread as resolved until I have tried the other solutions suggested and have had the chance of commenting upon them to the contributors.

camoore

Wales, UK

code follows :-

'*********************************************************

Private Declare Function ReleaseCapture Lib "user32" () As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

'*********************************************************

Private Sub Command1_Click()

If Command1.Caption = "Command1" Then

Command1.Caption = "Click 1"

GoTo Line100

End If


If Command1.Caption = "Click 2" Then

Command1.Caption = "Click 1"

GoTo Line100

End If


If Command1.Caption = "Click 1" Then

Command1.Caption = "Click 2"

End If


GoTo Line100


Line100:

End Sub

'*********************************************************

Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

If Shift And 2 Then 'ie. CTRL key is held down, then allow drag&drop
'of this control. If not, ignore

ReleaseCapture

SendMessage Command1.hWnd, &H112, &HF012&, 0

End If

End Sub

'*********************************************************

[brucevde]

Another option to try. Use Drag & Drop functionality.

Private Sub Label1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbRightButton Then
        Label1.Drag vbBeginDrag
    End If
End Sub

All controls have a DragDrop event which fires when the mouse button is released and the control being dragged is over top it.

[LaVolpe]

...The remaining problem was that the implementation of the routine upon a control seemed to destroy/inhibit that control's "click" function. For example, a Command button would happily be drag/dropped by the routine, but would not respond at all to a mouse click...

To get around the problem you mentioned, the generally accepted practice is to wait until the mouse travels a few pixels while the button is held, before activating the drag. For example, cache the X,Y coords when the mouse is first in down position, then in the mousemove event, see if the X or Y has moved at least 3 pixels from the cached coords. If so, start drag. If not, ignore. Without this check, it is possible to accidentally starting a drag by double clicking on the control, as double clicking often involves the mouse moving a pixel.

The 3 pixel mark is a rule of thumb, the "correct" measurement probably should be checked/set calling GetSystemMetrics API passing the SM_CXDRAG and SM_CYDRAG constants.

Edited: In short, if you want to use that method, place the commands in the MouseMove event, not the mousedown event.

[camoore]

Thank you brucevde for your code.

In order to work as drag&drop it also needs a separate Form_DragDrop sub. containing the line "Source.Move X,Y". I then got this to work moving a control around a Form, but could not make it work for a control within a picture box. The routine assigned the X-Y co-ordinates of the item clicked in the Picture Box to Form co-ordinates. Another small problem is that when the mouse is released, the Control is placed with its top left corner at the cursor position, not where you have re-positioned the Control outline. Thus it only works the way I wish if the user clicks and drags the exact top left of the original control.

LaVolpe's solution is the most elegant, but the coding is rather complex (for me at least!).

The VBCLASSICROCKS idea works, but as stated only if everything has the same scalemode.

Therefore I have found the some1uk03 suggestion the best for my present need, but modified as described above in thread so that it only works when the Control key is held down. This stops it interfering with the function of a Command key _Click event completely and also helps to avoid inadvertant Drag/Drops. The fact that it does not work with a light control such as a label is no hardship given that one knows of this. One can use a text box instead, or as suggested a picture box as a container.

What seemed at first sight to be a very simple requirement, fundamental to the way in which Windows interacts with the user, has turned out to be quite a complicated and interesting topic for me. One never ceases to learn, thanks to the willing contributions from Forum members.

I will now mark this thread as resolved, with many thanks.

camoore

Wales, UK