｢DLL側からコントロールの色変更｣について

メッセージ

ノッチ

> ①(test.exe)を実行した後②を実行、色が変化しないので①のウィンドウにカーソルを置く
> 又は､アクティブにすると①がエラーに成り強制終了します。

これを読む限りサブクラス化には成功しているけどウィンドウメッセージが
①に送られたタイミングで強制終了しているようです。
サブクラスのウィンドウプロシージャでエラーしているか、
SetWindowLong(GWL_WNDPROC)が変なアドレスになっていて、メッセージを処理
できずに終了しているようです。
こちらの環境ではきれいに色が変化するので的確にこれが原因とはいえないですが、

SetSubClassの前後で
msgbox 0,Str$(GetWindowLong(hTarget,GWL_WNDPROC)
を入れてみて対象のウィンドウがサブクラス化されているか、

DLLのSubClassProcの
SubClassProc=CallWindowProc(～～～)
以外をコメントアウトしても強制終了するか、

①のウィンドウにメッセージが送られないようにしながら、
②を起動、①にマウスを持っていったり画面更新をさせずに②を終了
させて①をアクティブにしても強制終了するか。

このあたりを調べて頂けませんでしょうか？

※ちなみにABでDim宣言した変数は内部的にFillMemoryで0に初期化されていました

ＫＩＣＯ

ノッチ様、ありがとう御座います。

SetSubClassの前後で
msgbox 0,Str$(GetWindowLong(hTarget,GWL_WNDPROC))
を入れてみて対象のウィンドウがサブクラス化されているか、

戻り値：0 サブクラス化されていないです。

DLLのSubClassProcの
SubClassProc=CallWindowProc(～～～)
以外をコメントアウトしても強制終了するか、
Function SubClassProc(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)
Exit Function '追加
'ここに色変更の処理を追加

強制終了します。

Case WM_NULL
If wParam=SUBCLASS_UNSET Then
SetWindowLong(hWnd,GWL_WNDPROC,pProc)

｢"SetWindowLong"の第3パラメータが、VoidPtrからLongに強制変換されています。｣と
警告が出ますが気にしなくても良いですか？

宜しくお願いします。

ノッチ

SetSubClassの前後で
msgbox 0,Str$(GetWindowLong(hTarget,GWL_WNDPROC))
を入れてみて対象のウィンドウがサブクラス化されているか、
戻り値：0 サブクラス化されていないです。

ここ重要です。
恐らくSetSubClassをする前は何らかの数値がでたと思いますが、
SetSubClassの後で戻り値が0ということはサブクラス化失敗ではなく
(GetWindowLongが失敗の可能性もありますが)
一応サブクラス化に成功はしているが、サブクラスに指定したアドレスが
間違っている。ということだと思います。

考えられる原因は
1) SetSubClass内のAddressOf(SubClassProc)でアドレスの獲得に失敗している
2) CallWndProc内のSetWindowLongが失敗している
でしょうか。
msgbox 0,Str$(GetWindowLong(hTarget,GWL_WNDPROC))
の戻り値が0になっているということはSetWindowLong自体は成功しているよう
なので多分1)が原因のような気がします。

ですので、今度はCallWndProc内の

コード: 全て選択

pProc=SetWindowLong(lParam->hWnd,GWL_WNDPROC,lParam->lParam) As VoidPtr
ReplyMessage(pProc As LRESULT)

の間に
msgbox 0,Str$(pProc),"戻り値(元のアドレス)"
msgbox 0,Str$(lParam->lParam),"設定したアドレス"
を入れてみてください。
最初のメッセージボックスはなんらかの数値、2つ目は"0"になるのではないかと
思います。

>

Case WM_NULL
> If wParam=SUBCLASS_UNSET Then
> SetWindowLong(hWnd,GWL_WNDPROC,pProc)

> ｢"SetWindowLong"の第3パラメータが、VoidPtrからLongに強制変換されています。｣と
> 警告が出ますが気にしなくても良いですか？

SetWindowLongの第3パラメータはLong型でDeclare宣言されているので
SetWindowLong(hWnd,GWL_WNDPROC,pProc As Long)
と第3パラメータはLong型だと明示的に表現することで警告はでなくなります。

ノッチ

SetSubClassの前後で
msgbox 0,Str$(GetWindowLong(hTarget,GWL_WNDPROC))
を入れてみて対象のウィンドウがサブクラス化されているか、
戻り値：0 サブクラス化されていないです。

ここ重要です。
恐らくSetSubClassをする前は何らかの数値がでたと思いますが、
SetSubClassの後で戻り値が0ということはサブクラス化失敗ではなく
(GetWindowLongが失敗の可能性もありますが)
一応サブクラス化に成功はしているが、サブクラスに指定したアドレスが
間違っている。ということだと思います。

考えられる原因は
1) SetSubClass内のAddressOf(SubClassProc)でアドレスの獲得に失敗している
2) CallWndProc内のSetWindowLongが失敗している
でしょうか。
msgbox 0,Str$(GetWindowLong(hTarget,GWL_WNDPROC))
の戻り値が0になっているということはSetWindowLong自体は成功しているよう
なので多分1)が原因のような気がします。

ですので、今度はCallWndProc内の

コード: 全て選択

pProc=SetWindowLong(lParam->hWnd,GWL_WNDPROC,lParam->lParam) As VoidPtr
ReplyMessage(pProc As LRESULT)

の間に
msgbox 0,Str$(pProc),"戻り値(元のアドレス)"
msgbox 0,Str$(lParam->lParam),"設定したアドレス"
を入れてみてください。
最初のメッセージボックスはなんらかの数値、2つ目は"0"になるのではないかと
思います。

>

Case WM_NULL
> If wParam=SUBCLASS_UNSET Then
> SetWindowLong(hWnd,GWL_WNDPROC,pProc)

> ｢"SetWindowLong"の第3パラメータが、VoidPtrからLongに強制変換されています。｣と
> 警告が出ますが気にしなくても良いですか？

SetWindowLongの第3パラメータはLong型でDeclare宣言されているので
SetWindowLong(hWnd,GWL_WNDPROC,pProc As Long)
と第3パラメータはLong型だと明示的に表現することで警告はでなくなります。

横入り失礼ですが，エラーになった関数の直後にGetLastErrorを呼び出してどうなっているか調べてみたらどうでしょうか？

ＫＩＣＯ

pProc=SetWindowLong(lParam->hWnd,GWL_WNDPROC,lParam->lParam) As VoidPtr
ReplyMessage(pProc As LRESULT)
の間に
msgbox 0,Str$(pProc),"戻り値(元のアドレス)"
msgbox 0,Str$(lParam->lParam),"設定したアドレス"
を入れてみてください。
最初のメッセージボックスはなんらかの数値、2つ目は"0"になるのではないかと
思います。

pProc=SetWindowLong(lParam->hWnd,GWL_WNDPROC,lParam->lParam) As VoidPtr
msgbox 0,Str$(pProc),"戻り値(元のアドレス)"
msgbox 0,Str$(lParam->lParam),"設定したアドレス"
ReplyMessage(pProc As LRESULT)

両方共､"アドレス値"が入っています。
GetWindowLong(hTarget,GWL_WNDPROC)の戻り値だけは､0です。

宜しくお願いします。

ＫＩＣＯ

イグトランス様、ありがとう御座います。

エラーになった関数の直後にGetLastErrorを呼び出してどうなっているか調べてみたらどうでしょうか？

強制終了するので、何処かがエラーしていると思ったのですが、
GetLastError()で調べても戻り値は0で､どこがエラーなのか解らない状態です。

ノッチ

>

pProc=SetWindowLong(lParam->hWnd,GWL_WNDPROC,lParam->lParam) As VoidPtr
> msgbox 0,Str$(pProc),"戻り値(元のアドレス)"
> msgbox 0,Str$(lParam->lParam),"設定したアドレス"
> ReplyMessage(pProc As LRESULT)
>

両方共､"アドレス値"が入っています。
> GetWindowLong(hTarget,GWL_WNDPROC)の戻り値だけは､0です。

GetWindowLongが失敗するのであれば、その直後にGetLastError()を呼び出して
見てください。
もしかしたらhTargetがうまく取得できてないかもしれません。
msgbox 0,Str$(hTarget)
をGetWindowLongの直前くらいにいれるとどうですか？

ＫＩＣＯ

GetWindowLongが失敗するのであれば、その直後にGetLastError()を呼び出して
見てください。
もしかしたらhTargetがうまく取得できてないかもしれません。

Function Export SetSubClass(hWnd As HWND) As Long
　　　　　・
　　　　　・
　　　　　・
If hHook=0 Then Exit Function
pProc=SendMessage(hTarget,WM_NULL,SUBCLASS_SET,AddressOf(SubClassProc) As LPARAM) As VoidPtr
SetSubClass=1
GetWindowLong(hTarget,GWL_WNDPROC)
msgbox 0,Str$(GetLastError()),"GetLastError"
End Function

戻り値は、"５"でした。

宜しくお願いします。

ノッチ

戻り値は、"５"でした。

5はアクセスができない時に出ます。

差し支えなければmsn宛に空メールでも送ってもらえないですか？
こちらで作成したプログラムを送付しますので。

ＫＩＣＯ

ノッチ様、ありがとう御座います。

差し支えなければmsn宛に空メールでも送ってもらえないですか？
こちらで作成したプログラムを送付しますので。

その前に、二回目に頂いたコードですが、これで正常に動作するか試して頂けますか？

環境：XP Home SP 2
　　　AB Ver4.24.00

DLLのコード [ここをクリックすると内容が表示されます]

#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
'msgbox 0,Str$(AddressOf(SubClassProc) As Double),"SubClassProc"
'msgbox 0,Str$(pProc As Long)
GetWindowLong(hTarget,GWL_WNDPROC)
msgbox 0,Str$(GetLastError()),"GetLastError"
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 Long)
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
msgbox 0,Str$(GetWindowLong(hTarget,GWL_WNDPROC)),"GetWindowLong"
msgbox 0,Str$(pProc As Double),"戻り値(元のアドレス)"
msgbox 0,Str$(lParam->lParam),"設定したアドレス"
ReplyMessage(pProc As LRESULT)
End If
End If
End If
End If
CallWndProc=CallNextHookEx(pProc,code,wParam,lParam As LPARAM)
End Function

Function SubClassProc(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 As Long)
Exit Function
End If
Case WM_DESTROY
EndSubClass()
End Select
SubClassProc=CallWindowProc(pProc,hWnd,message,wParam,lParam)
End Function

宜しくお願いします。

ノッチ

> その前に、二回目に頂いたコードですが、これで正常に動作するか試して頂けますか？
>
> 環境：XP Home SP 2
> 　　　AB Ver4.24.00
>

DLLのコード [ここをクリックすると内容が表示されます]

#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
> 'msgbox 0,Str$(AddressOf(SubClassProc) As Double),"SubClassProc"
> 'msgbox 0,Str$(pProc As Long)
> GetWindowLong(hTarget,GWL_WNDPROC)
> msgbox 0,Str$(GetLastError()),"GetLastError"
> 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 Long)
> 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
> msgbox 0,Str$(GetWindowLong(hTarget,GWL_WNDPROC)),"GetWindowLong"
> msgbox 0,Str$(pProc As Double),"戻り値(元のアドレス)"
> msgbox 0,Str$(lParam->lParam),"設定したアドレス"
> ReplyMessage(pProc As LRESULT)
> End If
> End If
> End If
> End If
> CallWndProc=CallNextHookEx(pProc,code,wParam,lParam As LPARAM)
> End Function
>
> Function SubClassProc(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 As Long)
> Exit Function
> End If
> Case WM_DESTROY
> EndSubClass()
> End Select
> SubClassProc=CallWindowProc(pProc,hWnd,message,wParam,lParam)
> End Function

こちらの環境では
GetWindowLongの戻り値が0、
GetLastErrorの戻り値が5、
とはなりましたが、正常にサブクラス化されて文字色が変更されました。
AB 4.24.00 WindowsXP Home SP2

で、メールはなくてOKです。
http://www.filebank.co.jp/guest/myanoh/
こちらにアクセスしてファイルをダウンロードして下さい。
ゲストフォルダログインという画面になるので
ファイルバンクID：myanoh
フォルダ名：absubclass
パスワード：1234
でゲストフォルダにログインできます。
開いた画面で、環境設定をクリックしてブラウザモードに変更したら
ダウンロードでファイルを落とすことができます。
dll.zipの中に
Dllフォルダ：DLLのプロジェクト
testフォルダ：DLLのSetSubClassを呼び出すプロジェクト
コピー～ testフォルダ：サブクラス用にStaticを配置したプロジェクト
がありますので、まず「コピー～ test」内のtest.exeを実行して
「test」プロジェクトでデバッグ実行なりコンパイルして実行をして下さい。
こちらの環境では正常動作するので、これでもエラーになるようですと
PCの違いによる問題かもしれません。(ないとは思いますが)

ＫＩＣＯ

ノッチ様、ありがとう御座います。

"dll.zip"頂きました。

こちらの環境では正常動作するので、これでもエラーになるようですと
PCの違いによる問題かもしれません。(ないとは思いますが)

依然として状態は、変わりません？

宜しくお願いします。

ノッチ

> 依然として状態は、変わりません？

変わりませんか。
ちなみに他の方で試された方はいませんか？
同じもので動作が違うのであれば原因がわかりません。

7 · #30 投稿記事 by 7 » 2006年4月18日(火) 13:16

> ちなみに他の方で試された方はいませんか？
> 同じもので動作が違うのであれば原因がわかりません。
Windows XP Home SP2ですけど、「コピー～ test」を実行した後に、「test」を起動すると「コピー～ test」が落ちます。(不安定になる？)
というか、起動するたびに動きが違います。起動した途端に落ちる時もあるし、起動してイケたか！？と思うと落ちたり、フリーズしかける時もあるし(最終的には落ちます)。

コード: 全て選択

pProc=SetWindowLong(lParam->hWnd,GWL_WNDPROC,lParam->lParam) As VoidPtr

コード: 全て選択

ReplyMessage(pProc As LRESULT)

この二つのコードが怪しいと思います。

SetSubClass()関数の中のGetWindowLong(hTarget,GWL_WNDPROC)の戻り値も、CallWndProc()関数の中のGetWindowLong(hTarget,GWL_WNDPROC)の戻り値も 0 なので、SetWindowLong()関数が上手くいってないんじゃないんでしょうか。

ab.com コミュニティ