[RESOLVED] How to Drag and Drop a control at runtime?
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
Re: How to Drag and Drop a control at runtime?
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
Code:
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
Code:
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....
Code:
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.
Re: How to Drag and Drop a control at runtime?
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
Re: How to Drag and Drop a control at runtime?
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.
Re: How to Drag and Drop a control at runtime?
Keith, couldn't get it to work until I made the change below
From:
Code:
ElseIf GetCapture() <> theCtrl.Container.hWnd Then
To:
Code:
ElseIf GetCapture() <> theCtrl.hWnd Then
Re: How to Drag and Drop a control at runtime?
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.
Re: How to Drag and Drop a control at runtime?
For the OP: Here's a simple drag control, pure VB, with both
the dragged control and the container having the same ScaleMode:
Code:
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
Re: How to Drag and Drop a control at runtime?
A simple way would be:
Code:
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
Re: How to Drag and Drop a control at runtime?
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
Re: How to Drag and Drop a control at runtime?
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.
Re: How to Drag and Drop a control at runtime?
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
'*********************************************************
Re: How to Drag and Drop a control at runtime?
Another option to try. Use Drag & Drop functionality.
Code:
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.
Re: How to Drag and Drop a control at runtime?
Quote:
Originally Posted by
camoore
...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.
Re: How to Drag and Drop a control at runtime?
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
