Const TH32CS_SNAPHEAPLIST = &H1
Const TH32CS_SNAPPROCESS = &H2
Const TH32CS_SNAPTHREAD = &H4
Const TH32CS_SNAPMODULE = &H8
Const TH32CS_SNAPALL = (TH32CS_SNAPHEAPLIST Or TH32CS_SNAPPROCESS Or TH32CS_SNAPTHREAD Or TH32CS_SNAPMODULE)
Const TH32CS_INHERIT = &H80000000
Const MAX_PATH As Integer = 260
Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szExeFile As String * MAX_PATH
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal lFlags As Long, ByVal lProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapShot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Sub ExitProcess Lib "kernel32" (ByVal uExitCode As Long)
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Function exitproc(ByVal exefile As String) As Boolean
exitproc = False
Dim hSnapShot As Long, uProcess As PROCESSENTRY32
hSnapShot = CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0&)
uProcess.dwSize = Len(uProcess)
r = Process32First(hSnapShot, uProcess)
Do While r
If Left$(uProcess.szExeFile, IIf(InStr(1, uProcess.szExeFile, Chr$(0)) > 0, InStr(1, uProcess.szExeFile, Chr$(0)) - 1, 0)) = exefile Then
exitproc = True
Exit Do
End If
r = Process32Next(hSnapShot, uProcess)
Loop
End Function
Option Explicit
Const LWA_COLORKEY = &H1
Const LWA_ALPHA = &H2
Const GWL_EXSTYLE = (-20)
Const WS_EX_LAYERED = &H80000
Const WS_EX_TRANSPARENT As Long = &H20&
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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 Integer, ByVal lParam As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim pos As POINTAPI
Private Sub Form1_DblClick()
Move Screen.Width / 2 - 240, Screen.Height / 2 - 240, 480, 480
End Sub
Private Sub Form_Load()
Form2.Show
Form4.Show
Dim Ret As Long
Ret = GetWindowLong(Me.hwnd, GWL_EXSTYLE)
Ret = Ret Or WS_EX_LAYERED Or WS_EX_TRANSPARENT
SetWindowLong Me.hwnd, GWL_EXSTYLE, Ret
SetLayeredWindowAttributes Me.hwnd, 0, 255, LWA_ALPHA
Form1.Enabled = False
Timer1.Enabled = True
Timer3.Enabled = True
Const LENGTH = 8& '長度
Const THICK_NESS = 0&
BorderStyle = 0: Caption = "十字準星": App.TaskVisible = False
BackColor = vbWhite: ForeColor = vbRed: AutoRedraw = True: ScaleMode = vbPixels
Form1_DblClick
Line ((LENGTH - THICK_NESS) \ 2, 0)-((LENGTH - THICK_NESS) \ 2 + THICK_NESS, LENGTH), , BF
Line (0, (LENGTH - THICK_NESS) \ 2)-(LENGTH, (LENGTH - THICK_NESS) \ 2 + THICK_NESS), , BF
SetWindowPos hwnd, -1, 0, 0, 0, 0, &H20 Or &H2 Or &H1
SetWindowLong hwnd, (-20), GetWindowLong(hwnd, (-20)) Or &H80000
SetLayeredWindowAttributes hwnd, vbWhite, 0, &H1
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then Unload Me
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then ReleaseCapture: SendMessage hwnd, &HA1, 2, 0
End Sub
Private Sub Timer1_Timer()
If GetAsyncKeyState(vbKeyUp) Then
Form1.Top = Form1.Top - 18
End If
If GetAsyncKeyState(vbKeyLeft) Then
Form1.Left = Form1.Left - 18
End If
If GetAsyncKeyState(vbKeyDown) Then
Form1.Top = Form1.Top + 18
End If
If GetAsyncKeyState(vbKeyRight) Then
Form1.Left = Form1.Left + 18
End If
If GetAsyncKeyState(vbKeyF9) Then
If Form1.Visible = False Then
Form1.Visible = True
Else
Form1.Visible = False
End If
End If
If GetAsyncKeyState(vbKeyF10) Then
If Timer3.Enabled = False Then
Timer3.Enabled = True
Else
Timer3.Enabled = False
End If
End If
If GetAsyncKeyState(vbKeyF12) Then
If Form4.Visible = False Then
Form4.Visible = True
Else
Form4.Visible = False
End If
End If
End Sub
Private Sub Timer3_Timer()
GetCursorPos pos
Label1.Caption = pos.X & "," & pos.Y
Form1.Top = pos.Y * Screen.TwipsPerPixelY - 65
Form1.Left = pos.X * Screen.TwipsPerPixelY - 60
End Sub
上面是別人的VB模塊原始碼
修改成只要打開軟體自動顯示十字準星并鎖定
上下左右鍵調整
用熱鍵重啟就是重新在當前滑鼠位置顯示。
uj5u.com熱心網友回復：
你的代碼并不完整，我也不清楚你的另外幾個表單能做什么。我只說一下，按你的需求“有改動”的地方就是了。
⑴ Form1中增加一個模塊級變數 Private lAutoFlag As Long
⑵ 在程序Private Sub Form_Load()的結尾處（就是緊挨End Sub前）加上以下代碼：
lAutoFlag = -1
Call Timer3_Timer
lAutoFlag = 0
⑶ 在Timer1的事件程序中，處理F10的代碼修改：
'If GetAsyncKeyState(vbKeyF10) Then
' If Timer3.Enabled = False Then
' Timer3.Enabled = True
' Else
' Timer3.Enabled = False
' End If
'End If
If GetAsyncKeyState(vbKeyF10) Then
lAutoFlag = Not lAutoFlag
End If
⑷ 控制元件Timer3的事件程序改為這樣：
Private Sub Timer3_Timer()
GetCursorPos pos
Label1.Caption = pos.X & "," & pos.Y
If (lAutoFlag) Then
Top = pos.Y * Screen.TwipsPerPixelY - 60
Left = pos.X * Screen.TwipsPerPixelY - 60
End If
End Sub
另外說一下的就是，你的“熱鍵”并不是真正的熱鍵（真正的熱鍵需要用到“HOOK”處理），
這樣的代碼在，按下F10和F12進行“開關控制”不是很好掌握的：
按下到放開的持續時間必須小于 Timer1的Interval 值（超過了就可能引起多次狀態切換）；
Timer1的 Interval 屬性不能設定得大了（10到50比較合適），太大了可能按下后迅速放開沒被回應。
如果你是Copy別人的代碼自己建立工程，你要注意設定好Form1中Timer1和Timer3的初始屬性：
Timer1的 Interval 建議設定成20，不要大于50
Timer3的 Interval建議為50到100，不要超過200
還有就是，Form1_DblClick() 這個程序應該是沒有實際用處的（因為已經“沒有條件觸發”了），
你可以用程序中的那句代碼，直接代替 Form_Load()中的程序呼叫，并洗掉掉這個程序（如果沒有另外的呼叫）。
并且 Move( )之后的表單可能太小，Label1的內容都顯示不完，你可以把那兩個480改成大點的值。
Label1的 Left和Top屬性，最好都是120 。
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/102513.html
標籤：VB基礎類