標準モジュール:
'□API関数Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByValnIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc AsLong, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'□SetWindowLongで使用
Private Const GWL_WNDPROC = -4
'□メッセージ
Private Const WM_CONTEXTMENU = &H7B '右クリック'□コレクション すべてウィンドウハンドルがキー
Dim colDProc As Collection
'現在サブクラス化されているコントロールの元のWindowsProcのアドレス
'■WindowProc
'■機能:メッセージを横取りする。
'■備考:この関数はコールバック関数なので定義を変えてはいけない!
Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParamAs Long) As Long
Dim DefaultProc As Long
Select Case uMsg
Case WM_CONTEXTMENU '右クリック
Exit Function
End Select
CONTINUE: '引当のWindowProcへメッセージを回す。
DefaultProc = colDProc(CStr(hWnd))
WindowProc = CallWindowProc(DefaultProc, hWnd, uMsg, wParam, lParam)
End Function
'■BeginSubClass
'■機能:サブクラス化を開始する。
Public Sub BeginSubClass(oControl As Control)Static bAlready As Boolean
Dim DefaultProc As Long
If Not bAlready Then
Set colDProc = New Collection
bAlready = True
End If'
'サブクラス化実行
DefaultProc = SetWindowLong(oControl.hWnd, GWL_WNDPROC, AddressOf WindowProc)
'元のWindowProcのアドレスを保存
colDProc.Add DefaultProc, CStr(oControl.hWnd)
End Sub
'■EndSubClass
'■機能:サブクラス化を終了します。
Public Sub EndSubClass(oControl As Control)
Dim Ret As Long
Dim DefaultProc As Long
'WindowProcのアドレスを元に戻す。
DefaultProc = colDProc(CStr(oControl.hWnd))
Ret = SetWindowLong(oControl.hWnd, GWL_WNDPROC, DefaultProc)
colDProc.Remove CStr(oControl.hWnd)
End Sub
フォーム:
Private Sub Form_Load()
Call BeginSubClass(Text1)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call EndSubClass(Text1)
End Sub
0 件のコメント:
コメントを投稿