关于鼠标拖动控件并释放

XinJW 2014-12-09 02:25:47

在一个窗体上有两个picture控件p1 p2,一个text控件Text,我想实现一个功能是鼠标点击P1并拖动（P1控件不动只是鼠标动）到P2 然后释放按键，Text记录为P1-P2，反之从P2到P1则记录P2-P1

...全文

206 13 打赏收藏转发到动态举报

写回复

用AI写文章

13 条回复

切换为时间正序

请发表友善的回复…

发表回复

一如既往哈 2014-12-11

打赏
举报

1、如果你那个控件是ctl的（私有自定义控件），可以考虑添加一个hwnd属性，如果是ocx或dll，那就算了。 2、你那个p1和p2不是同样的控件吗？ 3、可以根据bstart内容来判断。比如在p1_MouseUp事件中判断bstart内容：如果是"p2"则显示“p2-p1”，如果是“p1”就不写了；同理p2_MouseUp.....

XinJW 2014-12-11

打赏
举报

Option Explicit
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private bStart As String
Private Sub P1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bStart = "P1"
End Sub
Private Sub P1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lp As POINTAPI
    GetCursorPos lp
'    If GetClsName(WindowFromPoint(lp.X, lp.Y)) = "ThunderPictureBoxDC" Then Text1.Text = bStart & "-P2"
    Call GetClsName(WindowFromPoint(lp.X, lp.Y))
End Sub
Private Sub P2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bStart = "P2"
End Sub
Private Sub P2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lp As POINTAPI
    GetCursorPos lp
'    If GetClsName(WindowFromPoint(lp.X, lp.Y)) = "AfxFrameOrView42" Then Text1.Text = bStart & "-P1"
    Call GetClsName(WindowFromPoint(lp.X, lp.Y))
End Sub
Function GetClsName(ByVal bHwnd As Long) As String
    Dim w1 As String
    w1 = Space(255)
    GetClassName bHwnd, w1, Len(w1)
    GetClsName = Left$(w1, InStr(w1, Chr$(0)) - 1)
'    Debug.Print GetClsName
    If InStr(CStr(GetClsName), "ATL:") > 0 Then
    Text1 = GetClsName
    End If
End Function

我代码改成这样，我觉得达到我想要的效果了。可是问题是，P2点下然后松开再点P2也会有结果。我想要的是鼠标拖动过去才有结果。一点是鼠标没松开。

XinJW 2014-12-10

打赏
举报

引用 9 楼 Topc008 的回复:

弄反了，颠倒一下即可。

大侠，不行了。方便的话，我给你这两个控件，你帮我试一下吧。我Q37678173

一如既往哈 2014-12-10

打赏
举报

弄反了，颠倒一下即可。

XinJW 2014-12-10

打赏
举报

引用 10 楼 XinJW 的回复:

引用 9 楼 Topc008 的回复:
弄反了，颠倒一下即可。
大侠，不行了。方便的话，我给你这两个控件，你帮我试一下吧。我Q37678173

大侠，加我QQ聊吧。有偿请教，我着急。哈哈。。。

XinJW 2014-12-09

打赏
举报

Option Explicit Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Type POINTAPI X As Long Y As Long End Type Private bStart As String Private Sub P1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) bStart = "P1" End Sub Private Sub P1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lp As POINTAPI GetCursorPos lp If GetClsName(WindowFromPoint(lp.X, lp.Y)) = "WindowsForms10.Window.8.app.0.33c0d9d" Then Text1.Text = bStart & "-P2" End Sub Private Sub P2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) bStart = "P2" End Sub Private Sub P2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lp As POINTAPI GetCursorPos lp If GetClsName(WindowFromPoint(lp.X, lp.Y)) = "ATL:0AFA43D8" Then Text1.Text = bStart & "-P1" End Sub Function GetClsName(ByVal bHwnd As Long) As String Dim w1 As String w1 = Space(255) GetClassName bHwnd, w1, Len(w1) GetClsName = Left$(w1, InStr(w1, Chr$(0)) - 1) Debug.Print GetClsName End Function 我的P1是“WindowsForms10.Window.8.app.0.33c0d9d”，P2是“ATL:0AFA43D8”，上面这代码对码？但是不行哦。拖动没反就，但是无论任何时候点击P2都会出现“P2-P1”怎么会事儿？我主要想实现P1-P2

XinJW 2014-12-09

打赏
举报

打印出来是 WindowsForms10.Window.8.app.0.33c0d9d，可是没反应替换后。

XinJW 2014-12-09

打赏
举报

打印出来就是ThunderPictureBoxDC

一如既往哈 2014-12-09

打赏
举报

方法有多种，用getclassname吧：

Option Explicit
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private bStart As String
Private Sub P1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bStart = "P1"
End Sub
Private Sub P1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lp As POINTAPI
    GetCursorPos lp
    If GetClsName(WindowFromPoint(lp.X, lp.Y)) = "ThunderPictureBoxDC" Then Text1.Text = bStart & "-P2"
End Sub
Private Sub P2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bStart = "P2"
End Sub
Private Sub P2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lp As POINTAPI
    GetCursorPos lp
    If GetClsName(WindowFromPoint(lp.X, lp.Y)) = "ThunderPictureBoxDC" Then Text1.Text = bStart & "-P1"
End Sub
Function GetClsName(ByVal bHwnd As Long) As String
    Dim w1 As String
    w1 = Space(255)
    GetClassName bHwnd, w1, Len(w1)
    GetClsName = Left$(w1, InStr(w1, Chr$(0)) - 1)
    ''Debug.Print GetClsName
End Function

如果你不知道你那个控件的类名，把上述代码中注释掉的代码恢复，然后运行，拖动p1到p2，查看你的立即窗口中打印出来的内容，然后替换掉上述代码中的“ThunderPictureBoxDC”即可。

XinJW 2014-12-09

打赏
举报

我还真是不懂嘞，大侠要不加我QQ号教我一下呗。37678173

一如既往哈 2014-12-09

打赏
举报

那就WindowFromPoint后再用getclassname获取其类名，依据类名来判断（希望你那个控件的类名要与众不同），呵呵要不，计算鼠标位置来判断？笨法，都是笨法.......

XinJW 2014-12-09

打赏
举报

引用 1 楼 Topc008 的回复:

请参考：

Option Explicit
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private bStart As String
Private Sub P1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bStart = "P1"
End Sub
Private Sub P1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lp As POINTAPI
    GetCursorPos lp
    If WindowFromPoint(lp.X, lp.Y) = P2.hWnd Then Text1.Text = bStart & "-P2"
End Sub
Private Sub P2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bStart = "P2"
End Sub
Private Sub P2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lp As POINTAPI
    GetCursorPos lp
    If WindowFromPoint(lp.X, lp.Y) = P1.hWnd Then Text1.Text = bStart & "-P1"
End Sub

Topc008，您给的代码正是我所需要的。但是现在我面临的一个问题是，我把P1控件换成我自己的一个商业图片控件，这个控件没有hWnd属性，怎么办？

一如既往哈 2014-12-09

打赏
举报

请参考：

Option Explicit
Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private bStart As String
Private Sub P1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bStart = "P1"
End Sub
Private Sub P1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lp As POINTAPI
    GetCursorPos lp
    If WindowFromPoint(lp.X, lp.Y) = P2.hWnd Then Text1.Text = bStart & "-P2"
End Sub
Private Sub P2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    bStart = "P2"
End Sub
Private Sub P2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lp As POINTAPI
    GetCursorPos lp
    If WindowFromPoint(lp.X, lp.Y) = P1.hWnd Then Text1.Text = bStart & "-P1"
End Sub