1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
| Option Explicit
Private Type COPYDATASTRUCT
dwData As Long
cbData As Long
lpData As Long
End Type
Private Const WM_COPYDATA = &H4A
Private Const GWL_WNDPROC& = (-4&)
Private Const SET_RADIUS = 1
Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, ByVal lParam 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 SendMessageA Lib "user32" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetMem4 Lib "msvbvm60" (ByVal pSrc As Long, ByVal pDst As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
Dim pPrevWndProc As Long, fndHwnd As Long, Disable As Boolean
Public Sub Hook(hwnd As Long)
pPrevWndProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Public Sub UnHook(hwnd As Long)
Call SetWindowLong(hwnd, GWL_WNDPROC, pPrevWndProc)
End Sub
Public Function SendRadius() As Boolean
Dim CDRec As COPYDATASTRUCT, Value As Long
If fndHwnd = 0 Then EnumWindows AddressOf EnumWnd, 0
If fndHwnd Then
Value = frmMain.Radius
CDRec.dwData = SET_RADIUS
CDRec.cbData = 4
CDRec.lpData = VarPtr(Value)
Disable = True
SendMessageA fndHwnd, WM_COPYDATA, frmMain.hwnd, CDRec
Disable = False
End If
End Function
Private Function EnumWnd(ByVal hwnd As Long, ByVal lParam As Long) As Boolean
Dim Cap As String, L As Long
L = GetWindowTextLength(hwnd)
Cap = Space$(L)
GetWindowText hwnd, Cap, L + 1
If Cap = "Circle" And hwnd <> frmMain.hwnd Then fndHwnd = hwnd: Exit Function
If hwnd = 0 Then Stop
EnumWnd = True
End Function
Private Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Select Case uMsg
Case WM_COPYDATA
Dim CDRec As COPYDATASTRUCT, Value As Long
CopyMemory CDRec, ByVal lParam, LenB(CDRec)
Select Case CDRec.dwData
Case SET_RADIUS
If CDRec.cbData <> 4 Or Disable Then Exit Function
GetMem4 CDRec.lpData, VarPtr(Value)
frmMain.Radius = Value
frmMain.hsbRadius.Value = frmMain.Radius
WindowProc = True
End Select
Case Else
WindowProc = CallWindowProcA(pPrevWndProc, hwnd, uMsg, wParam, lParam)
End Select
End Function |