Класс- Option Explicit
- Private Declare Function CreateWindowExW Lib "user32" (ByVal dwExStyle As Long, ByVal lpClassName As Long, _
- ByVal lpWindowName As Long, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, _
- ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, _
- ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
- Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
- Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
- Private Const GWL_WNDPROC As Long = -4
- Private Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
- Private Const WS_EX_WINDOWEDGE As Long = &H100&
- Private Const WS_EX_CLIENTEDGE As Long = &H200&
- Private Const WS_EX_OVERLAPPEDWINDOW As Long = (WS_EX_WINDOWEDGE Or WS_EX_CLIENTEDGE)
- Private Const WS_VISIBLE As Long = &H10000000
- Private Const WS_CHILD As Long = &H40000000
- Private Const ES_AUTOHSCROLL As Long = &H80&
- Private Const ES_NOHIDESEL As Long = &H100&
- Private Declare Function MoveWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
- Const AsmMain As String = "558BEC83C4FC8D45FC50FF7514FF7510FF750CFF75086800000000B800000000FFD08B45FCC9C21000"
- Private ASMArr() As Byte
- Private editproc As Long
- Private editwnd As Long
-
- Public Function EditWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
- Debug.Print uMsg
- Select Case uMsg
- End Select
- EditWindowProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
- End Function
-
-
- Private Sub StartSubclass(ByRef ASM() As Byte, ByVal hwnd As Long, ByRef OldWndProc As Long, Optional ByVal ProcNumber As Long)
- Dim lng As Long, tPtr As Long
- lng = Len(AsmMain) \ 2&
-
- ReDim ASM(0 To lng - 1)
-
- For lng = 0 To lng - 1
- ASM(lng) = val("&H" & Mid$(AsmMain, (lng) * 2& + 1, 2&))
- Next
-
- Call CopyMemory(tPtr, ByVal ObjPtr(Me), 4&)
- Call CopyMemory(lng, ByVal tPtr + &H1C + (4& * ProcNumber), 4&)
-
- Call CopyMemory(ASM(23), ObjPtr(Me), 4&)
- Call CopyMemory(ASM(28), lng, 4&)
-
- OldWndProc = SetWindowLong(hwnd, &HFFFC, VarPtr(ASM(0)))
- End Sub
-
- Private Sub StopSubclass(ByVal hwnd As Long, ByVal OldWndProc As Long)
- Call SetWindowLong(hwnd, &HFFFC, OldWndProc)
- End Sub
-
-
- Private Sub Class_Initialize()
- editwnd = CreateWindowExW(WS_EX_OVERLAPPEDWINDOW, ByVal StrPtr("EDIT"), _
- ByVal StrPtr(""), WS_VISIBLE Or WS_CHILD Or ES_AUTOHSCROLL Or ES_NOHIDESEL, _
- 0, 0, Form1.ScaleWidth, 20, Form1.hwnd, 0, App.hInstance, ByVal 0&)
- Call StartSubclass(ASMArr, editwnd, editproc)
- End Sub
-
- Private Sub Class_Terminate()
- If editproc Then
- Call StopSubclass(editwnd, editproc)
- editproc = 0
- End If
- DestroyWindow editwnd
- End Sub
UserControl (сабклассинг врубается по UserControl_Click, ибо в UserControl_Initialize крашится ide, когда я нахожусь в дизайн-тайм, а узнать в той же процедуре design это тайм или run нельзя, потому что объект Ambient еще не создан или типа того)
- Option Explicit
- Private Declare Function CreateWindowExW Lib "user32" (ByVal dwExStyle As Long, ByVal lpClassName As Long, _
- ByVal lpWindowName As Long, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, _
- ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, _
- ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
- Private Declare Function DestroyWindow Lib "user32.dll" (ByVal hwnd As Long) As Long
- Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
- Private Const GWL_WNDPROC As Long = -4
- Private Declare Function DefWindowProc Lib "user32.dll" Alias "DefWindowProcA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
- Private Const WS_EX_WINDOWEDGE As Long = &H100&
- Private Const WS_EX_CLIENTEDGE As Long = &H200&
- Private Const WS_EX_OVERLAPPEDWINDOW As Long = (WS_EX_WINDOWEDGE Or WS_EX_CLIENTEDGE)
- Private Const WS_VISIBLE As Long = &H10000000
- Private Const WS_CHILD As Long = &H40000000
- Private Const ES_AUTOHSCROLL As Long = &H80&
- Private Const ES_NOHIDESEL As Long = &H100&
- Private Declare Function MoveWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
- Const AsmMain As String = "558BEC83C4FC8D45FC50FF7514FF7510FF750CFF75086800000000B800000000FFD08B45FCC9C21000"
- Private ASMArr() As Byte
- Private editproc As Long
- Private editwnd As Long
-
- Public Function EditWindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
- Select Case uMsg
- End Select
- EditWindowProc = DefWindowProc(hwnd, uMsg, wParam, lParam)
- End Function
-
- Private Sub UserControl_Click()
- Call StartSubclass(ASMArr, editwnd, editproc)
- End Sub
-
- Private Sub UserControl_Initialize()
-
- editwnd = CreateWindowExW(WS_EX_OVERLAPPEDWINDOW, ByVal StrPtr("EDIT"), _
- ByVal StrPtr(""), WS_VISIBLE Or WS_CHILD Or ES_AUTOHSCROLL Or ES_NOHIDESEL, _
- 0, 0, ScaleWidth, ScaleHeight, hwnd, 0, App.hInstance, ByVal 0&)
- End Sub
-
- Private Sub UserControl_InitProperties()
- End Sub
-
- Private Sub UserControl_Resize()
- MoveWindow editwnd, 10, 0, ScaleWidth, ScaleHeight, 1
- End Sub
-
- Private Sub UserControl_Terminate()
- If editproc Then
- Call StopSubclass(editwnd, editproc)
- editproc = 0
- End If
- DestroyWindow editwnd
- End Sub
-
- Private Sub StartSubclass(ByRef ASM() As Byte, ByVal hwnd As Long, ByRef OldWndProc As Long, Optional ByVal ProcNumber As Long)
- Dim lng As Long, tPtr As Long
- lng = Len(AsmMain) \ 2&
-
- ReDim ASM(0 To lng - 1)
-
- For lng = 0 To lng - 1
- ASM(lng) = val("&H" & Mid$(AsmMain, (lng) * 2& + 1, 2&))
- Next
-
- Call CopyMemory(tPtr, ByVal ObjPtr(Me), 4&)
- Call CopyMemory(lng, ByVal tPtr + &H1C + (4& * ProcNumber), 4&)
-
- Call CopyMemory(ASM(23), ObjPtr(Me), 4&)
- Call CopyMemory(ASM(28), lng, 4&)
-
- OldWndProc = SetWindowLong(hwnd, &HFFFC, VarPtr(ASM(0)))
- End Sub
-
- Private Sub StopSubclass(ByVal hwnd As Long, ByVal OldWndProc As Long)
- Call SetWindowLong(hwnd, &HFFFC, OldWndProc)
- End Sub
Ответить
|