在程序运行中通过鼠标移动标签.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 + -
显示快捷键?