在程序运行中通过鼠标移动标签.txt

来自「以电子书的形式收集了VB一些常见问题解决方法,可以很方便的查找自己需要解决的问题」· 文本 代码 · 共 51 行

TXT
51
字号
以 下 是 一 个 例 子 
    module1: 
    Option Explicit 
    Public Const GWL_WNDPROC = (-4) 
    Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long 
    Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long 
    Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long 
    Public proc As Long 
    Public bMove As Boolean 
    Public Const WM_MOUSEMOVE = &H200 
    Public Const WM_LBUTTONDOWN = &H201 
    Public Const WM_LBUTTONUP = &H202 
    Public xPos As Long, ypos As Long 
     
    Public Function NewProc(ByVal hw As Long, ByVal uMsg As _ 
    Long, ByVal wParam As Long, ByVal lParam As Long) As _ 
    Long 
     Dim txPos As Long, tyPos As Long 
     
     If uMsg = WM_LBUTTONDOWN Then 
     txPos = lParam And 65535 
     tyPos = lParam / 65536 
     If txPos >= Form1.Label1.Left And txPos <= Form1.Label1.Left + Form1.Label1.Width _ 
     And tyPos >= Form1.Label1.Top And tyPos <= Form1.Label1.Top + Form1.Label1.Height Then 
     bMove = True 
     xPos = txPos 
     ypos = tyPos 
     End If 
     ElseIf uMsg = WM_LBUTTONUP Then 
     bMove = False 
     ElseIf uMsg = WM_MOUSEMOVE And bMove Then 
     txPos = lParam And 65535 
     tyPos = lParam / 65536 
     Form1.Label1.Left = Form1.Label1.Left + txPos - xPos 
     Form1.Label1.Top = Form1.Label1.Top + tyPos - ypos 
     Form1.Caption = txPos & ":" & tyPos 
     xPos = txPos 
     ypos = tyPos 
     End If 
     
     NewProc = CallWindowProc(proc, hw, uMsg, wParam, lParam) 
     
    End Function 
    Form1:(请 放 一 个 label) 
    Option Explicit 
    Private Sub Form_Load() 
     proc = GetWindowLong(Me.hwnd, GWL_WNDPROC) 
     SetWindowLong Me.hwnd, GWL_WNDPROC, AddressOf NewProc 
    End Sub 
    如 有 更 好 的 方 法 请 告 知 。 
<END>

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?