[RESOLVED] Drag and drop question

[GARY MICHAEL]

Hello,


I set a frame's DragMode property to automatic and then wrote the following code into the Form_DragDrop event.

Code:
Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
Source.Top = Y
Source.Left = X
End Sub

[/code]

The frame's outline would move, but the frame snapped back to where it was. What can I do?

[some1uk03]

are you trying to move an object? or drag n drop it somewhere?

[GARY MICHAEL]

I want to move a frame to anywhere on the screen.

[RhinoBull]

The following quick sample should get you started:

Option Explicit

Dim offsetX As Single
Dim offsetY As Single

Private Sub Form_DragDrop(Source As Control, X As Single, Y As Single)
    Frame1.Drag vbEndDrag
    Frame1.Move X - offsetX, Y - offsetY
End Sub

Private Sub Frame1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    offsetX = X
    offsetY = Y
    Frame1.Drag vbBeginDrag
End Sub

[some1uk03]

Use:

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


And then in the Mouse_Down event of the Frame:

ReleaseCapture
SendMessage Frame1.hWnd, &H112, &HF012&, 0

[GARY MICHAEL]

I've still got the same problem. The outline moves but snaps back into place.

[sessi4ml]

Check out link below..."Drag & Drop Game

[GARY MICHAEL]

Thanks.

Not quite what I need. I need it to stay where I drop it and not snap into another spot.

[RhinoBull]

I've still got the same problem. The outline moves but snaps back into place.

New cursor location must be outside of original boundaries so form's DragDrop event is triggered.
Otherwise of course it will as you say "snap back".

[some1uk03]

Use My code.. It doesn't Snap BACK.

[RhinoBull]

Exactly! Someone overlooked it maybe because it's not posted with the CODE tags...
Anyway, all credits go to some1uk03:

Option Explicit

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 Frame1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReleaseCapture
    SendMessage Frame1.hWnd, &H112, &HF012&, 0
End Sub

[GARY MICHAEL]

Some1UK03,

I did try your code and had the same problem, then I loaded a new form and only used your code and it worked.

Could there be something here that interferes with your code?

Option Explicit
Option Compare Text

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 Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const EM_LINEFROMCHAR = &HC9

Private Const EM_GETLINECOUNT = &HBA

Private Const EM_LINESCROLL = &HB6

Private Const EM_GETFIRSTVISIBLELINE = &HCE

Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hWnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)

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

End Sub

[some1uk03]

Have you changed your Drag&Drop properties back to normal? Might be interfering.

[GARY MICHAEL]

That was it. I never would have figured that out. Thak you everyone. You guys are good.