如何在窗体中拖动一个文本框到任意位置

[pingdesu]

在一个标准窗体中左键单击一个文本框，并能拖放到任意位置。

[pingdesu]

高手指点下啊

[worldy]

Dim xStart As Long, yStart As Long


Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    xStart = X
    yStart = Y

End Sub

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With Text1
        If Button = 1 Then
            .Move .Left + X - xStart, .Top + Y - yStart
        End If
    End With
End Sub

[贝隆]

使用SendMessage函数来发送移动消息是效果最佳的，没有停顿现象

Option Explicit

Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const WM_SYSCOMMAND = &H112&
Private Const SC_MOVE = &HF012&
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
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 Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = vbLeftButton Then
        'Ϊµ±Ç°µÄÓ¦ÓóÌÐòÊÍ·ÅÊó±ê²¶»ñ
        ReleaseCapture
        'Òƶ¯´°Ìå
        SendMessage Text1.hwnd, WM_SYSCOMMAND, SC_MOVE, 0
    End If
End Sub

[东方之珠]

不错！经过测试，上面2、3、4楼效果一样，1楼的更简明！

[贝隆]

[Quote=引用 5 楼 chenjl1031 的回复:]
不错！经过测试，上面2、3、4楼效果一样，1楼的更简明！
[/Quote]
东方兄，1楼是楼主自己呢

[oldm4n]

2楼的在我的环境下不用按按钮只要鼠标移动TextBox也跟着跑了
我的环境如下：
WIn7 Ultimate 64-bit
VB 6.0 with SP6

[Quote=引用 5 楼 chenjl1031 的回复:]

不错！经过测试，上面2、3、4楼效果一样，1楼的更简明！
[/Quote]

[东方之珠]

[Quote=引用 6 楼 veron_04 的回复:]
引用 5 楼 chenjl1031 的回复:
不错！经过测试，上面2、3、4楼效果一样，1楼的更简明！

东方兄，1楼是楼主自己呢
[/Quote]
哈哈哈...,纯属大意!
你那个也不错,API很正统,标准做法!

[oldm4n]

窗体上放一个TextBox，Name叫Text1，参看如下代码：

Option Explicit

Private mouse_old_x As Single, mouse_old_y As Single
Private flag_on_drag As Boolean

Private Sub Form_Load()
    flag_on_drag = False
    
End Sub

Private Sub Text1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (vbLeftButton = Button) Then
        mouse_old_x = X
        mouse_old_y = Y
        
        flag_on_drag = True
    End If
    
End Sub

Private Sub Text1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If True = flag_on_drag Then
        Text1.Left = Text1.Left + (X - mouse_old_x)
        Text1.Top = Text1.Top + (Y - mouse_old_y)
    End If
    
End Sub

Private Sub Text1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If (vbLeftButton = Button) Then
        flag_on_drag = False
    End If
    
End Sub

[pingdesu]

都是高人啊，我选谁的代码更好呢？汗...