📄 msub.bas
字号:
Attribute VB_Name = "mSub"
Option Explicit
Private Const WM_NCDESTROY = &H82
Private Const GWL_WNDPROC = (-4)
Private Const OLDWNDPROC = "OldWndProc"
Private Declare Function GetProp Lib "user32" Alias "GetPropA" (ByVal _
hWnd As Long, ByVal lpString As String) As Long
Private Declare Function SetProp Lib "user32" Alias "SetPropA" (ByVal _
hWnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function RemoveProp Lib "user32" Alias "RemovePropA" (ByVal _
hWnd As Long, ByVal lpString As String) 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 CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
'Public Function SubClass(hWnd As Long) As Boolean
' Dim lpfnOld As Long
' Dim fSuccess As Boolean
'
' If (GetProp(hWnd, OLDWNDPROC) = 0) Then
' lpfnOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
' If lpfnOld Then
' fSuccess = SetProp(hWnd, OLDWNDPROC, lpfnOld)
' End If
' End If
'
' If fSuccess Then
' SubClass = True
' Else
' If lpfnOld Then Call UnSubClass(hWnd)
' MsgBox "Unable to successfully subclass &H" & Hex(hWnd), vbCritical
' End If
'End Function
'Public Function UnSubClass(hWnd As Long) As Boolean
' Dim lpfnOld As Long
'
' lpfnOld = GetProp(hWnd, OLDWNDPROC)
' If lpfnOld Then
' If RemoveProp(hWnd, OLDWNDPROC) Then
' UnSubClass = SetWindowLong(hWnd, GWL_WNDPROC, lpfnOld)
' End If
' End If
'End Function
'Public Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As _
' Long, ByVal lParam As Long) As Long
' Select Case uMsg
' Case WM_SHNOTIFY '处理系统消息通告函数
' Call Form1.NotificationReceipt(wParam, lParam)
' Case WM_NCDESTROY
' Call UnSubClass(hWnd)
' MsgBox "Unubclassed &H" & Hex(hWnd), vbCritical, "WndProc Error"
' End Select
'
' WndProc = CallWindowProc(GetProp(hWnd, OLDWNDPROC), hWnd, uMsg, wParam, lParam)
'End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -