谁能帮我修改一下模块源码 十字准星

Question

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 LongFunction 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 FunctionOption ExplicitConst 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 LongPrivate Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As IntegerPrivate Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim pos As POINTAPIPrivate Sub Form1_DblClick()
Move Screen.Width / 2 - 240, Screen.Height / 2 - 240, 480, 480
End SubPrivate 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 SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then Unload Me
End SubPrivate 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 IfIf GetAsyncKeyState(vbKeyF10) Then
If Timer3.Enabled = False Then
Timer3.Enabled = True
Else
Timer3.Enabled = False
End If
End IfIf GetAsyncKeyState(vbKeyF12) Then
If Form4.Visible = False Then
Form4.Visible = True
Else
Form4.Visible = False
End If
End If
End SubPrivate Sub Timer3_Timer()
GetCursorPos pos
Label1.Caption = pos.X & "," & pos.Y
Form1.Top = pos.Y * Screen.TwipsPerPixelY - 65
Form1.Left = pos.X * Screen.TwipsPerPixelY - 60End Sub上面是别人的VB模块源码
修改成只要打开软件自动显示十字准星并锁定
上下左右键调整
用热键重启就是重新在当前鼠标位置显示。

Answer 1

你的代码并不完整，我也不清楚你的另外几个窗体能做什么。
我只说一下，按你的需求“有改动”的地方就是了。
⑴　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 。