ab.com コミュニティ

コード: 全て選択

Function CallWndProc(code As DWord, wParam As DWord, lParam As *CWPSTRUCT) As DWord
    Dim f   As Byte
    Dim bc As DWord
    Dim tc As DWord

    If code=HC_ACTION Then
       Select Case lParam->uMsg
          Case WM_CTLCOLORSTATIC
             If lParam->lParam=STATIC1 Then f=1: tc=&HFF: bc=&HFFFF
        End Select
    End If

    If f Then
        SetBkMode(lParam->wParam, OPAQUE)
        SetBkColor(lParam->wParam, bc)
        SetTextColor(lParam->wParam, tc)
        CallWndProc=hbST		'背景用枠ブラシ
        CallNextHookEx(hSTHook, code, wParam, lParam)
     Else
        '次のフックを呼び出す
        CallWndProc=CallNextHookEx(hSTHook, code, wParam, lParam)
     End If
End Function

コード: 全て選択

#include "dll.idx"

'-------------------------------------------------------------------
' メモ - このファイルには、DLLの構成要素を記述します。
'        （例：関数定義、グローバル変数、定数定義など）
'
'        エクスポートが必要な関数には、"Export" 修飾子を指定します。
'        （例：Function Export FuncName() As Long）
'-------------------------------------------------------------------

'下のNUM_SUBCLASS_WNDを変更すると同時にサブクラス化できるウィンドウ数を変更できる
Const NUM_SUBCLASS_WND=16
Const SUBCLASS_SET=1234567890 As WPARAM
Const SUBCLASS_UNSET=987654321 As WPARAM
Type SUBCLASSSTRUCT
	hWnd	As HWND
	hHook	As HANDLE
	pProc	As VoidPtr
	bFlag	As BOOL
End Type
Dim hInst	As HINSTANCE
Dim scs(NUM_SUBCLASS_WND-1) As SUBCLASSSTRUCT


Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA"(idHook As Long,lpfn As VoidPtr,hMod As HINSTANCE,dwThreadId As DWord) As HANDLE
Declare Function CallNextHookEx Lib "user32"(hhk As HANDLE,nCode As Long,wParam As WPARAM,lParam As LPARAM) As LRESULT
Declare Function UnhookWindowsHookEx Lib "user32"(hhk As HANDLE) As BOOL
Declare Function ReplyMessage Lib "user32"(lResult As LRESULT) As BOOL
Const WH_CALLWNDPROC=4
Const HC_ACTION		=0
Type CWPSTRUCT
	lParam	As LPARAM
	wParam	As WPARAM
	message	As DWord
	hWnd	As HWND
End Type

Function Export DllMain(hinstDLL As HINSTANCE, fdwReason As DWord, lpvReserved As VoidPtr) As Long
	'DLLエントリポイント
	Select Case fdwReason
		Case DLL_PROCESS_ATTACH
			'DLLがプロセス空間にロードされた時に実行されます。
			_System_StartupProgram()
			hInst=hinstDLL
			Dim i As Long
			For i=0 To NUM_SUBCLASS_WND-1
				scs(0).hWnd=0
			Next
			DllMain=1
	End Select
End Function

Function Export SetSubClass(hWnd As HWND,pProc As VoidPtr) As Long
	SetSubClass=-1
	Dim i As Long
	i=0
	Do
		If scs(i).hWnd=0 Then Goto *SetSubClassNext
		i++
	Loop While i<NUM_SUBCLASS_WND-1
	Exit Function
*SetSubClassNext
	scs(i).bFlag=0
	scs(i).hWnd=hWnd
	Dim ThreadID As DWord
	ThreadID=GetWindowThreadProcessId(scs(i).hWnd,NULL)
	scs(i).hHook=SetWindowsHookEx(WH_CALLWNDPROC,AddressOf(CallWndProc),hInst,ThreadID)
	If scs(i).hHook=0 Then Exit Function
	scs(i).pProc=SendMessage(scs(i).hWnd,WM_NULL,SUBCLASS_SET,AddressOf(SubClassProc) As LPARAM) As VoidPtr
	SetSubClass=i
End Function

Function Export EndSubClass(ID As Long) As Long
	EndSubClass=-1
	If ID<0 or ID>NUM_SUBCLASS_WND-1 Then Exit Function
	If scs(ID).hWnd=0 Then Exit Function
	scs(ID).bFlag=0
	SendMessage(scs(ID).hWnd,WM_NULL,SUBCLASS_UNSET,VarPtr(scs(ID)) As LPARAM)
	scs(ID).hWnd=0
	UnhookWindowsHookEx(scs(ID).hHook)
	EndSubClass=1
End Function

Function CallWndProc(code As DWord,wParam As DWord,lParam As *CWPSTRUCT) As DWord
	If code=HC_ACTION Then
		Dim p As VoidPtr
		p=CallSubClass(lParam)
	End If
	CallWndProc=CallNextHookEx(p,code,wParam,lParam As LPARAM)
End Function

Function CallSubClass(pcwp As *CWPSTRUCT) As VoidPtr
	Dim i As Long
	For i=0 To NUM_SUBCLASS_WND-1
		If scs(i).hWnd=pcwp->hWnd Then Exit For
	Next
	If scs(i).bFlag=0 Then
		If pcwp->message=WM_NULL Then
			If pcwp->wParam=SUBCLASS_SET Then
				scs(i).bFlag=1
				scs(i).pProc=SetWindowLong(pcwp->hWnd,GWL_WNDPROC,pcwp->lParam) As VoidPtr
			End If
		End If
	End If
	CallSubClass=scs(i).pProc
End Function

Function SubClassProc(hwnd As HWND,message As DWord,wParam As WPARAM,lParam As LPARAM) As LRESULT
	Dim i As Long
	For i=0 To NUM_SUBCLASS_WND-1
		If scs(i).hWnd=hwnd Then Exit For
	Next
	If message=WM_NULL Then
		If wParam=SUBCLASS_UNSET Then
			SetWindowLong(hwnd,GWL_WNDPROC,scs(i).pProc As LPARAM)
			Exit Function
		End If
	ElseIf message=WM_DESTROY Then
		EndSubClass(i)
	End If
	SubClassProc=CallWindowProc(scs(i).pProc,hwnd,message,wParam,lParam)
	If message=WM_CTLCOLORSTATIC Then
		SetTextColor(wParam As HDC,&HFF)
	End If
End Function

コード: 全て選択

Declare Function SetSubClass Lib "dll"(hWnd As HWND,pProc As VoidPtr) As Long
Declare Function EndSubClass Lib "dll"(hWnd As HWND) As Long
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
	hTarget=FindWindow("NORMAL0","Test")
	subid=SetSubClass(hTarget,0)
End Sub

Sub MainWnd_QueryClose(ByRef cancel As Integer)
	EndSubClass(subid)
End Sub

コード: 全て選択

#include "dll.idx"

'-------------------------------------------------------------------
' メモ - このファイルには、DLLの構成要素を記述します。
'        （例：関数定義、グローバル変数、定数定義など）
'
'        エクスポートが必要な関数には、"Export" 修飾子を指定します。
'        （例：Function Export FuncName() As Long）
'-------------------------------------------------------------------

'下のNUM_SUBCLASS_WNDを変更すると同時にサブクラス化できるウィンドウ数を変更できる
Const SUBCLASS_SET=1234567890 As WPARAM
Const SUBCLASS_UNSET=987654321 As WPARAM
Dim hInst	As HINSTANCE
Dim hTarget	As HWND
Dim hHook	As HANDLE
Dim pProc	As VoidPtr
Dim bFlag	As BOOL


Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA"(idHook As Long,lpfn As VoidPtr,hMod As HINSTANCE,dwThreadId As DWord) As HANDLE
Declare Function CallNextHookEx Lib "user32"(hhk As HANDLE,nCode As Long,wParam As WPARAM,lParam As LPARAM) As LRESULT
Declare Function UnhookWindowsHookEx Lib "user32"(hhk As HANDLE) As BOOL
Declare Function ReplyMessage Lib "user32"(lResult As LRESULT) As BOOL
Const WH_CALLWNDPROC=4
Const HC_ACTION		=0
Type CWPSTRUCT
	lParam	As LPARAM
	wParam	As WPARAM
	message	As DWord
	hWnd	As HWND
End Type
Const Static1=1000
Const Static2=1001
Const Static3=1002
Const Static4=1003
Const Static5=1004

Function Export DllMain(hinstDLL As HINSTANCE, fdwReason As DWord, lpvReserved As VoidPtr) As Long
	'DLLエントリポイント
	Select Case fdwReason
		Case DLL_PROCESS_ATTACH
			'DLLがプロセス空間にロードされた時に実行されます。
			_System_StartupProgram()
			hInst=hinstDLL
			hTarget=0
			DllMain=1
	End Select
End Function

Function Export SetSubClass(hWnd As HWND) As Long
	SetSubClass=0
	If hTarget Then Exit Function
	bFlag=0
	hTarget=hWnd
	Dim ThreadID As DWord
	ThreadID=GetWindowThreadProcessId(hTarget,NULL)
	hHook=SetWindowsHookEx(WH_CALLWNDPROC,AddressOf(CallWndProc),hInst,ThreadID)
	If hHook=0 Then Exit Function
	pProc=SendMessage(hTarget,WM_NULL,SUBCLASS_SET,AddressOf(SubClassProc) As LPARAM) As VoidPtr
	SetSubClass=1
End Function

Function Export EndSubClass() As Long
	EndSubClass=0
	If hTarget=0 Then Exit Function
	bFlag=0
	SendMessage(hTarget,WM_NULL,SUBCLASS_UNSET,pProc As LPARAM)
	hTarget=0
	UnhookWindowsHookEx(hHook)
	EndSubClass=1
End Function

Function CallWndProc(code As DWord,wParam As DWord,lParam As *CWPSTRUCT) As DWord
	If code=HC_ACTION Then
		If bFlag=0 Then
			If lParam->message=WM_NULL Then
				If lParam->wParam=SUBCLASS_SET Then
					bFlag=1
					pProc=SetWindowLong(lParam->hWnd,GWL_WNDPROC,lParam->lParam) As VoidPtr
					ReplyMessage(pProc As LRESULT)
				End If
			End If
		End If
	End If
	CallWndProc=CallNextHookEx(pProc,code,wParam,lParam As LPARAM)
End Function

Function 					(hWnd As HWND,message As DWord,wParam As WPARAM,lParam As LPARAM) As LRESULT
	Select Case message
		Case WM_CTLCOLORSTATIC
			SubClassProc=CallWindowProc(pProc,hWnd,message,wParam,lParam)
			'ここに色変更の処理を追加
			Select Case GetWindowLong(lParam As HWND,GWL_ID)
				Case Static1'これはID
					SetTextColor(wParam As HDC,&H000000FF)
					'SubClassProcにブラシハンドルを指定すると背景色も変更できます
				Case Static2
					SetTextColor(wParam As HDC,&H0000FF00)
				Case Static3
					SetTextColor(wParam As HDC,&H00FF0000)
				Case Static4
					SetTextColor(wParam As HDC,&H0000FFFF)
				Case Static5
					SetTextColor(wParam As HDC,&H00FFFF00)
			End Select
			'こんな感じで
			Exit Function
		Case WM_NULL
			If wParam=SUBCLASS_UNSET Then
				SetWindowLong(hWnd,GWL_WNDPROC,pProc)
				Exit Function
			End If
		Case WM_DESTROY
			EndSubClass()
	End Select
	SubClassProc=CallWindowProc(pProc,hWnd,message,wParam,lParam)
End Function

コード: 全て選択

Declare Function SetSubClass Lib "dll"(hWnd As HWND) As Long
Declare Function EndSubClass Lib "dll"() As Long
Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
	hTarget=FindWindow("NORMAL0","Test")
	SetSubClass(hTarget)
End Sub

Sub MainWnd_QueryClose(ByRef cancel As Integer)
	EndSubClass()
End Sub