ab.com コミュニティ

konisiさん、イグトランスさん、淡幻星さん
ご丁寧にありがとうございました。

konisiさんのコード、イグトランスさんのコードでそれぞれコンパイルし、現在のところ問題なく動作しております。
次は淡幻星さんのコードに修正を行い試してみたいと思います。

皆様のお陰で、どうにか完成に近づきました。
↓
http://homepage3.nifty.com/ae85fcmxs/02-info-reversi.html
（バージョン２です）

また、不明点が出てくると思います。その際は宜しくお願いいたします。

	Sub GetPixelBits( hBmp As HBITMAP )
		Dim hDC As HDC
		Dim hMemDC As HDC
		Dim hMemDC2 As HDC
		Dim hBmp2 As HBITMAP
		Dim w As Long
		Dim h As Long
		Dim n As Long


		'前回のスレッドの終了を待つ。
		If( hSecondThread<>NULL )Then
			If( WAIT_TIMEOUT=WaitForSingleObject(hSecondThread, 0) )Then '念のためスレッド動作中かを確認。
				n = 0
				While FALSE=TerminateThread( hSecondThread, 1 )
					'3回までリトライする。
					If n<3 Then
						n++
					Else
						MessageBox(hTargetWnd, "前回のピクセル情報の取得スレッドの停止（破棄）に失敗。", "エラー", MB_OK Or MB_ICONSTOP)
						Exit While
					End If
				Wend
			End If
			CloseHandle( hSecondThread )
			hSecondThread = NULL
		EndIf

		If nCpuSleepLevel<0 THen
			'負の値が設定されたときは、ピクセル情報の取得を行わない。
			Exit Function
		End If

		'スレッド用にビットマップを複製。hBmp→hBmp2
		/*
			「1つのビットマップオブジェクトを同時に複数の
			　デバイスコンテキストで選択することはできない．」
			http://ls-al.jp/blog/archives/2006/03/post_288.html
		*/
		w = GetWidth()
		h = GetHeight()
		hDC = GetDC( hTargetWnd )
		hMemDC = CreateCompatibleDC( hDC )
		hMemDC2 = CreateCompatibleDC( hDC )
			hBmp2 = CreateCompatibleBitmap( hDC, w, h )
			If( NULL=SelectObject( hMemDC, hBmp ) )Then
				'結合に失敗。
				MessageBox(hTargetWnd, "ピクセル情報の取得に失敗。与えられたHBITMAPが新規DCに結合できない。", "エラー", MB_OK Or MB_ICONSTOP)
				/* そのまま抜けるか、一応最後まで走らせるか･･･。迷うところ。ピクセル有無の無限待機関数の存在を考慮。
				DeleteDC( hMemDC )
				DeleteDC( hMemDC2 )
				ReleaseDC( hTargetWnd ,hDC )
				ExitSub
				*/
			End If
			SelectObject( hMemDC2, hBmp2 )
			BitBlt( hMemDC2, 0, 0, w, h, hMemDC, 0, 0, SRCCOPY )
		DeleteDC( hMemDC )
		DeleteDC( hMemDC2 )
		ReleaseDC( hTargetWnd ,hDC )

		'複製したビットマップからピクセル情報を得る＠別スレッドGetPixelBitsA()を作成。
		'※複製したビットマップhBmp2はスレッド側で終了時に破棄される。
		SetAnyThreadParam( hBmp2 As DWord )
		hSecondThread = CreateThread( ByVal NULL, NULL, AddressOf(WsEasyBmp_Static_GetPixelBitsA), VarPtr(This), NULL, VarPtr(tID) )
	EndSub

konisi さんの修正案で、すでに解決しているように思われますが、
名前が出てましたので、簡単ですがコメントさせていだきます。

> ＃この改造をしても大丈夫かどうかは淡幻星さんに聞くのが一番手っ取り早そうだと思う次第
（コード設計上は）大丈夫なはず、です。

当方でも今現在はエラーは再現していないのですが、
クラス定義の
Sub GetPixelBits( hBmp As HBITMAP )
の部分を以下のように置き換えてください。
# 以前は似たようなエラーが起きてました。でも投稿した時点で修正しきったはずなんですが。。。
[hide=置き換えコード][code]
Sub GetPixelBits( hBmp As HBITMAP )
Dim hDC As HDC
Dim hMemDC As HDC
Dim hMemDC2 As HDC
Dim hBmp2 As HBITMAP
Dim w As Long
Dim h As Long
Dim n As Long


'前回のスレッドの終了を待つ。
If( hSecondThread<>NULL )Then
If( WAIT_TIMEOUT=WaitForSingleObject(hSecondThread, 0) )Then '念のためスレッド動作中かを確認。
n = 0
While FALSE=TerminateThread( hSecondThread, 1 )
'3回までリトライする。
If n<3 Then
n++
Else
MessageBox(hTargetWnd, "前回のピクセル情報の取得スレッドの停止（破棄）に失敗。", "エラー", MB_OK Or MB_ICONSTOP)
Exit While
End If
Wend
End If
CloseHandle( hSecondThread )
hSecondThread = NULL
EndIf

If nCpuSleepLevel<0 THen
'負の値が設定されたときは、ピクセル情報の取得を行わない。
Exit Function
End If

'スレッド用にビットマップを複製。hBmp→hBmp2
/*
「1つのビットマップオブジェクトを同時に複数の
　デバイスコンテキストで選択することはできない．」
http://ls-al.jp/blog/archives/2006/03/post_288.html
*/
w = GetWidth()
h = GetHeight()
hDC = GetDC( hTargetWnd )
hMemDC = CreateCompatibleDC( hDC )
hMemDC2 = CreateCompatibleDC( hDC )
hBmp2 = CreateCompatibleBitmap( hDC, w, h )
If( NULL=SelectObject( hMemDC, hBmp ) )Then
'結合に失敗。
MessageBox(hTargetWnd, "ピクセル情報の取得に失敗。与えられたHBITMAPが新規DCに結合できない。", "エラー", MB_OK Or MB_ICONSTOP)
/* そのまま抜けるか、一応最後まで走らせるか･･･。迷うところ。ピクセル有無の無限待機関数の存在を考慮。
DeleteDC( hMemDC )
DeleteDC( hMemDC2 )
ReleaseDC( hTargetWnd ,hDC )
ExitSub
*/
End If
SelectObject( hMemDC2, hBmp2 )
BitBlt( hMemDC2, 0, 0, w, h, hMemDC, 0, 0, SRCCOPY )
DeleteDC( hMemDC )
DeleteDC( hMemDC2 )
ReleaseDC( hTargetWnd ,hDC )

'複製したビットマップからピクセル情報を得る＠別スレッドGetPixelBitsA()を作成。
'※複製したビットマップhBmp2はスレッド側で終了時に破棄される。
SetAnyThreadParam( hBmp2 As DWord )
hSecondThread = CreateThread( ByVal NULL, NULL, AddressOf(WsEasyBmp_Static_GetPixelBitsA), VarPtr(This), NULL, VarPtr(tID) )
EndSub[/code][/hide]

その上で、画像読み込みなどの前に
SetCpuSleepLevel（ -1 ）
を実行して置いてください（一つのオブジェクトにつき、一回の実行でOK）。
例：
Dim objPic WsEasyBmp
objPic.SetCpuSleepLevel（ -1 ）
これで、画像のピクセル取得自体（今回のエラー発生箇所）を実行しなくなります。
# ピクセル取得を利用しない場合に限りますが。。。

ここでのWaitForSingleObjectは、DoからLoopまでの全部をこれ1行に置き換えられます。結果的に変数tstも要らなくなるはずです。そういう意味で短くなると書いたわけです。

ほんと、ヘルプに関してはわかりづらいとは思います。どうしたらいいだろうとは思うんですけどね……。

style=style And Not WS_THICKFRAME

style=style And Not (WS_THICKFRAME Or WS_MINIMIZEBOX)

style=style Or (定数)

style=style And Not (定数)

'半透明ウインドウ
#prompt
'定義
Declare Function SetLayeredWindowAttributes Lib "user32" (hwnd As HWND,crKey As DWord,bAlpha As Byte,dwFlags As DWord) As Long
Const WS_EX_LAYERED = &H80000

'半透明ウインドウになるように設定
Dim styleEx As DWord
styleEx=GetWindowLong(_PromptSys_hWnd,GWL_EXSTYLE)
styleEx=styleEx Or WS_EX_LAYERED
SetWindowLong(_PromptSys_hWnd,GWL_EXSTYLE,styleEx)

'透過率を設定(0～255　数字が小さいとよく透ける　ここでは200)
SetLayeredWindowAttributes(_PromptSys_hWnd,0,200,2)

SetWindowLongの近くで[code]style=style And Not WS_THICKFRAME[/code]としているのを[code]style=style And Not (WS_THICKFRAME Or WS_MINIMIZEBOX)[/code]に変更すると、最小化ボタンは無効になります。

[hide=雑記]そのほかの多彩な設定については、ヘルプのCreateWindowExの「ウィンドウスタイル定数」の「※標準ウィンドウスタイル」の所にある表の値を用いて、
機能をOnにするなら[code]style=style Or (定数)[/code]とし、Offにするなら[code]style=style And Not (定数)[/code]としてください。[hide=おまけ][code]'半透明ウインドウ
#prompt
'定義
Declare Function SetLayeredWindowAttributes Lib "user32" (hwnd As HWND,crKey As DWord,bAlpha As Byte,dwFlags As DWord) As Long
Const WS_EX_LAYERED = &H80000

'半透明ウインドウになるように設定
Dim styleEx As DWord
styleEx=GetWindowLong(_PromptSys_hWnd,GWL_EXSTYLE)
styleEx=styleEx Or WS_EX_LAYERED
SetWindowLong(_PromptSys_hWnd,GWL_EXSTYLE,styleEx)

'透過率を設定(0～255　数字が小さいとよく透ける　ここでは200)
SetLayeredWindowAttributes(_PromptSys_hWnd,0,200,2)[/code][/hide][/hide]

イグトランスさん、ありがとうございます。

TerminateThread(hSecondThread,1) の箇所を
WaitForSingleObject(hSecondThread, INFINITE)に
置き換えればよろしいのでしょうか？

また、
ウィンドゥの最小化ボタンの無効化が可能だと嬉しいのですがいかがでしょうか？

質問の連続で申しわけありません。ヘルプを見てはいるのですが中々困難です。
サンプルプログラムが乗っていてくれると助かるのですが・・・

よろしくお願いいたします。

[quote]スレッドの終了待ちはWaitForSingleObject(hSecondThread, INFINITE)のほうが短いコードで、
しかも無駄にCPUを使わないので、他のタスクに対して優しいです。[/quote]なるほど。
「シグナル状態」の意味を誤解して、対象スレッド内でSleepを使った時に関数を抜けてしまうと思ってたもので（ｒｙ

＃寝ぼけ頭で適当に書くものでは無いなと反省

スレッドの終了待ちはWaitForSingleObject(hSecondThread, INFINITE)のほうが短いコードで、
しかも無駄にCPUを使わないので、他のタスクに対して優しいです。

SetWindowPosは、SetWindowLongの後に実行しないと意味がないと思います。
そうすれば、最小化→元に戻すをする必要がない気がするのですがどうでしょうか。

konisiさん

早速、試してみました。ありがとうございました。
完成しましたら、ご報告させていただきます。

#prompt
Dim style As DWord
SetWindowPos(_PromptSys_hWnd,0,0,0,0,0,SWP_FRAMECHANGED Or SWP_NOSIZE Or SWP_NOMOVE)
style=GetWindowLong(_PromptSys_hWnd,GWL_STYLE)
style=style And Not WS_THICKFRAME
SetWindowLong(_PromptSys_hWnd,GWL_STYLE,style)

ShowWindow(_PromptSys_hWnd,SW_SHOWMINNOACTIVE)
ShowWindow(_PromptSys_hWnd,SW_SHOWNOACTIVATE)

N88BASICプロンプトのウインドウハンドルは_PromptSys_hWndに入っているので、
[code]#prompt
Dim style As DWord
SetWindowPos(_PromptSys_hWnd,0,0,0,0,0,SWP_FRAMECHANGED Or SWP_NOSIZE Or SWP_NOMOVE)
style=GetWindowLong(_PromptSys_hWnd,GWL_STYLE)
style=style And Not WS_THICKFRAME
SetWindowLong(_PromptSys_hWnd,GWL_STYLE,style)[/code]でだいたいいけると思います

システムボタンの描画位置がバグるので、これを実行した後一旦最小化→元のサイズに戻すをするほうがいいと思います。[code]ShowWindow(_PromptSys_hWnd,SW_SHOWMINNOACTIVE)
ShowWindow(_PromptSys_hWnd,SW_SHOWNOACTIVATE)[/code]

konisiさん、ホント何度もありがとうございます。

早速、修正し無事コンパイル出来ました！
今のところ、正常に動作していそうですが、なにしろ再現性が低いために色々な機種で様子を見てみたいと思います。
（前バージョンでは確かに不具合があった機種でも、今回のモノでは問題なく動作しているので大丈夫だと思います）
会社のパソコンでも（コッソリ）確かめてみます。会社のパソコンは必ずこの現象がでるので確認はし易いのです。

おかげさまで、オセロソフトがどうにかカタチになりそうです。（まだN88モードなのが残念ですが・・・）
完成したら、konisiさんに是非見てもらいたいです。
（大したソフトではありませんが）

すみません。あつかましいとは思いますが、もう一つ質問です。（別スレッドの方がよろしいかもしれませんが）
出来ればN88モードのウィンドゥサイズが固定に出来れば良いなぁと考えておりますが可能なのでしょうか？

Dim tst As DWord 
Do 
    GetExitCodeThread(hSecondThread,tst) 
    If tst=STILL_ACTIVE then 
        Sleep(10) 
    Else 
        Exit Do 
    End If 
Loop

Dim tst As DWord 
Do 
    GetExitCodeThread(hSecondThread,ByVal VarPtr(tst)) 
    If tst=STILL_ACTIVE then 
        Sleep(10) 
    Else 
        Exit Do 
    End If 
Loop

すみません、ヘルプに騙されました[quote]Win32API: GetExitCodeThread
指定したスレッドが終了しているかどうかを確認します。


--------------------------------------------------------------------------------
定義
Declare Function GetExitCodeThread Lib "kernel32" _
(hThread As HANDLE, _
ByRef lpExitCode As DWord) As Long
hThread
調査するスレッドのハンドルを指定します。
lpExitCode
DWord型変数の[b]ポインタを[/b]指定します。この変数にスレッド終了状況が格納されます。スレッドが実行されているときは STILL_ACTIVE が、終了しているときは終了コードが格納されます。[/quote]となってるのでついVarPtrと書いてしまったのですが、
よく見るとByRefで定義されてるので[code]Dim tst As DWord
Do
GetExitCodeThread(hSecondThread,tst)
If tst=STILL_ACTIVE then
Sleep(10)
Else
Exit Do
End If
Loop[/code]にする必要があります。

[hide=＃追記][code]Dim tst As DWord
Do
GetExitCodeThread(hSecondThread,ByVal VarPtr(tst))
If tst=STILL_ACTIVE then
Sleep(10)
Else
Exit Do
End If
Loop[/code]の方が正しい気はしますが。[/hide]

konisiさん、何度もすみません。ありがとうございます。

まずはご指摘の箇所の変更をしてみました。・・・が
コンパイル時に　「　"VarPtr(tst)" 無効な識別子です　」となってしまいます。

何か事前に定義が必要なのでしょうか？

TerminateThread(hSecondThread,1)

Dim tst As DWord
Do
    GetExitCodeThread(hSecondThread,VarPtr(tst))
    If tst=STILL_ACTIVE then
        Sleep(10)
    Else
        Exit Do
    End If
Loop

何度か実行しましたが、同じ状況は確認できませんでした。
コードを追ったら原因らしいものは見つかったのですが

・原因らしきもの
Bload関数を外から呼び出すと、既にビットマップを読み込んでいた場合はそれを破棄するためにWsDeleteEasyBmp関数を呼び出す
WsDeleteEasyBmp関数が呼び出されると、第二スレッド(WsEasyBmp_Static_GetPixelBitsA関数)が実行中なら強制終了する
WsEasyBmp_Static_GetPixelBitsA関数内部ではGetPixelBitsA関数を呼び出している
GetPixelBitsA関数内部でローカル変数に対してGetDCを使ってる（つまり関数内でReleaseDCをする必要がある）
途中で止まるともちろんメモリリークを起こす

・突貫工事のような解決案（こちらではそもそもバグが発見されてないので上手く動くか不明）
全ての[code]TerminateThread(hSecondThread,1)[/code]を[code]Dim tst As DWord
Do
GetExitCodeThread(hSecondThread,VarPtr(tst))
If tst=STILL_ACTIVE then
Sleep(10)
Else
Exit Do
End If
Loop[/code]に変換する(スレッドを強制終了させずに、待機する)

＃この改造をしても大丈夫かどうかは淡幻星さんに聞くのが一番手っ取り早そうだと思う次第

[AB4]ビットマップを簡単に扱うクラス
http://www.activebasic.com/forum/viewtopic.php?t=672

を利用させていただきN88BASICモードで作成してみました。
まずは出来たようですが、OSがXPである場合（断定は出来ませんが）

(1)「ピクセル情報の取得に失敗。与えられたHBITMAPが新規DCに結合できない」と表示され、本来のウィンドゥ外（デスクトップや他のウィンドゥ等に）にBMP表示をしてしまう。
("半角/全角"キーを押したときにその現象になった時もありましたが、必ずしもそうとは言えず”いつ”発生するかは不明です。IEを起動した直後にもこの事象がありました）

(2)上記の様にエラーは表示されませんが、正常にBMPファイルが表示されない場合がある。

現在Windows2000では上記問題は発生しておりません。
XPでも複数のマシンでやってみましたが、頻繁に発生するマシンと、稀に発生するマシンがあります（？）

常駐ソフトが多いほど（？）この現象が発生するように思えます
しかし断定はできません。
推測ですが、多くの処理を行なっている最中に発生していそうな気がします。

また、使用方法が間違っているのかもしれません。

以下にソース及びBMPファイルを置いておきました。
http://homepage3.nifty.com/ae85fcmxs/reversi/bmp-sample.lzh

「ピクセル情報の取得に失敗。与えられたHBITMAPが新規DCに結合できない」エラーのＯＫ後の画面はこちらです
http://homepage3.nifty.com/ae85fcmxs/reversi/bmp-err.png

解決方法等、ご教授いただけないでしょうか？
よろしくお願いいたします。