ab.com コミュニティ

DeleteObject(hBmp)

投稿してすぐ問題に気づきました。

使用例のMainWnd_Destroy()に

[code]
DeleteObject(hBmp)
[/code]

が必要ですよね。

Class TOUMEI
Private
	hMainDC As HDC
	hMainBmp As HBITMAP
	hBlackDC As HDC
	hBlackBmp As HBITMAP
	info As BITMAP
	flg As Byte




Public

	Sub ~TOUMEI()
		DeleteData()
	EndSub

	Function CreateTSPARENT(hDC As HDC,bmp As HBITMAP,bkColor As DWord) As Long
		If flg=1 then DeleteData()

		hMainDC=CreateCompatibleDC(hDC)

		If hMainDC=0 then CreateTSPARENT=0:ExitFunction
		hBlackDC=CreateCompatibleDC(hDC)
		hMainBmp=bmp
		SelectObject(hMainDC,hMainBmp)
		GetObject(hMainBmp,Len(info),info)
		hBlackBmp=CreateBitmap(info.bmWidth,info.bmHeight,1,1,0)
		SelectObject(hBlackDC,hBlackBmp)
		SetBkColor(hMainDC,bkColor)
		CreateTSPARENT=BitBlt(hBlackDC,0,0,info.bmWidth,info.bmHeight,hMainDC,0,0,SRCCOPY)

		If CreateTSPARENT=1 then flg=1

	EndFunction
	
	Sub DeleteData()
		DeleteDC(hMainDC)
		DeleteDC(hBlackDC)
		DeleteObject(hMainBmp)
		DeleteObject(hBlackBmp)
		flg=0
	EndSub

	Function PrintData(hDC As HDC,x As Long,y As Long)(w As Long,h As Long,moto_x As Long,moto_y As Long,moto_w As Long,moto_h As Long) As Long
		Dim radi As Double,er[1] As Long,old[1] As Long
		If flg=1 then
			radi=info.bmWidth/info.bmHeight
			If w=0 then w=info.bmWidth
			If h=0 then h=info.bmHeight
			If w=-1 then w=h*radi
			If h=-1 then h=w/radi
			If moto_w=0 then moto_w=info.bmWidth
			If moto_h=0 then moto_h=info.bmHeight
			old[0]=SetStretchBltMode(hBlackDC,COLORONCOLOR)
			old[1]=SetStretchBltMode(hMainDC,COLORONCOLOR)
			er[0]=StretchBlt(hDC,x,y,w,h,hBlackDC,moto_x,moto_y,moto_w,moto_h,SRCAND)
			er[1]=StretchBlt(hDC,x,y,w,h,hMainDC,moto_x,moto_y,moto_w,moto_h,SRCPAINT)
			SetStretchBltMode(hBlackDC,old[0])
			SetStretchBltMode(hMainDC,old[1])

			If er[0] and er[1]=TRUE then PrintData=TRUE

		EndIf

	EndFunction

End Class

' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
Dim buf As TOUMEI,hBmp As HBITMAP
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数

Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
	' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。

	' イベントプロシージャの呼び出しを行います。
	MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

Sub MainWnd_Destroy()
	mugen_tsuika_DestroyObjects()
	PostQuitMessage(0)
End Sub

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
	Dim hDC As HDC
	hDC=GetDC(hMainWnd)
	hBmp=LoadImage(NULL,"char.bmp",IMAGE_BITMAP,40,40,LR_LOADFROMFILE)
	buf.CreateTSPARENT(hDC,hBmp,0)
	ReleaseDC(hMainWnd,hDC)
End Sub

Sub MainWnd_Paint(hDC As HDC)
	buf.PrintData(hDC,20,50,60,30)
End Sub

#include<WSLib7_EasyPics.sbp>
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
Dim buf As TOUMEI
Dim bp As WsEasyPics
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数

Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
	' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。

	' イベントプロシージャの呼び出しを行います。
	MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

Sub MainWnd_Destroy()
	mugen_tsuika_DestroyObjects()
	PostQuitMessage(0)
End Sub

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
	Dim hDC As HDC
	hDC=GetDC(hMainWnd)
	bp.BloadPics("char.bmp")
	buf.CreateTSPARENT(hDC,bp.GetHandleBmp(),0)
	ReleaseDC(hMainWnd,hDC)
End Sub

Sub MainWnd_Paint(hDC As HDC)
	buf.PrintData(hDC,20,50,60,30)
End Sub

透過処理が面倒なのでクラスにまとめてみました。

私自身、最近になって画像を表示させることができたくらいの初心者ですので、間違っている箇所があるかもしれません。（一応動作はしました。）

間違えている点、追加する点があればご指摘ください。

[hide]
[code]

Class TOUMEI
Private
hMainDC As HDC
hMainBmp As HBITMAP
hBlackDC As HDC
hBlackBmp As HBITMAP
info As BITMAP
flg As Byte




Public

Sub ~TOUMEI()
DeleteData()
EndSub

Function CreateTSPARENT(hDC As HDC,bmp As HBITMAP,bkColor As DWord) As Long
If flg=1 then DeleteData()

hMainDC=CreateCompatibleDC(hDC)

If hMainDC=0 then CreateTSPARENT=0:ExitFunction
hBlackDC=CreateCompatibleDC(hDC)
hMainBmp=bmp
SelectObject(hMainDC,hMainBmp)
GetObject(hMainBmp,Len(info),info)
hBlackBmp=CreateBitmap(info.bmWidth,info.bmHeight,1,1,0)
SelectObject(hBlackDC,hBlackBmp)
SetBkColor(hMainDC,bkColor)
CreateTSPARENT=BitBlt(hBlackDC,0,0,info.bmWidth,info.bmHeight,hMainDC,0,0,SRCCOPY)

If CreateTSPARENT=1 then flg=1

EndFunction

Sub DeleteData()
DeleteDC(hMainDC)
DeleteDC(hBlackDC)
DeleteObject(hMainBmp)
DeleteObject(hBlackBmp)
flg=0
EndSub

Function PrintData(hDC As HDC,x As Long,y As Long)(w As Long,h As Long,moto_x As Long,moto_y As Long,moto_w As Long,moto_h As Long) As Long
Dim radi As Double,er[1] As Long,old[1] As Long
If flg=1 then
radi=info.bmWidth/info.bmHeight
If w=0 then w=info.bmWidth
If h=0 then h=info.bmHeight
If w=-1 then w=h*radi
If h=-1 then h=w/radi
If moto_w=0 then moto_w=info.bmWidth
If moto_h=0 then moto_h=info.bmHeight
old[0]=SetStretchBltMode(hBlackDC,COLORONCOLOR)
old[1]=SetStretchBltMode(hMainDC,COLORONCOLOR)
er[0]=StretchBlt(hDC,x,y,w,h,hBlackDC,moto_x,moto_y,moto_w,moto_h,SRCAND)
er[1]=StretchBlt(hDC,x,y,w,h,hMainDC,moto_x,moto_y,moto_w,moto_h,SRCPAINT)
SetStretchBltMode(hBlackDC,old[0])
SetStretchBltMode(hMainDC,old[1])

If er[0] and er[1]=TRUE then PrintData=TRUE

EndIf

EndFunction

End Class

[/code][/hide]


コンストラクタなし
●CreateTSPARENT
画像を透過して保持
hDC 貼り付け先(予定)のデバイスコンテキスト
bmp 元の画像
bkColor 透明化する色(RGB(○,△,□)などで指定)

●DeleteData
保持しているデータを破棄

●PrintData
保持しているデータを貼り付け
hDC 貼り付け先のデバイスコンテキスト
x 貼り付け位置(X座標)
y 貼り付け位置(Y座標)
----以下省略可----
w 貼り付け幅
h 貼り付け高さ
moto_x 元の画像読み込み開始位置(X座標)
moto_y 元の画像読み込み開始位置(Y座標)
moto_w 元の画像読み込み幅
moto_h 元の画像読み込み高さ

w,h,moto_w,moto_hは0でデフォルト
wは-1で元画像の比率でhに合わせる
hは-1で元画像の比率でwに合わせる

省略箇所は0指定と同じ

CreateTSPARENTのbmpには淡幻星様作成のWsEasyPicsクラスから取得したビットマップハンドルを格納しても動作することを確認しました。（その場合はWsEasyPicsではなく、当クラスのPrintBmpを使ってください。）

使用例↓
[hide][code]
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
Dim buf As TOUMEI,hBmp As HBITMAP
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数

Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。

' イベントプロシージャの呼び出しを行います。
MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

Sub MainWnd_Destroy()
mugen_tsuika_DestroyObjects()
PostQuitMessage(0)
End Sub

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
Dim hDC As HDC
hDC=GetDC(hMainWnd)
hBmp=LoadImage(NULL,"char.bmp",IMAGE_BITMAP,40,40,LR_LOADFROMFILE)
buf.CreateTSPARENT(hDC,hBmp,0)
ReleaseDC(hMainWnd,hDC)
End Sub

Sub MainWnd_Paint(hDC As HDC)
buf.PrintData(hDC,20,50,60,30)
End Sub
[/code][/hide]

WsEasyPicsを使わせていただく場合は
[hide][code]

#include<WSLib7_EasyPics.sbp>
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
Dim buf As TOUMEI
Dim bp As WsEasyPics
'-----------------------------------------------------------------------------
' ウィンドウメッセージを処理するためのコールバック関数

Function MainWndProc(hWnd As HWND, dwMsg As DWord, wParam As WPARAM, lParam As LPARAM) As DWord
' TODO: この位置にウィンドウメッセージを処理するためのコードを記述します。

' イベントプロシージャの呼び出しを行います。
MainWndProc=EventCall_MainWnd(hWnd,dwMsg,wParam,lParam)
End Function
'-----------------------------------------------------------------------------
' ここから下は、イベントプロシージャを記述するための領域になります。

Sub MainWnd_Destroy()
mugen_tsuika_DestroyObjects()
PostQuitMessage(0)
End Sub

Sub MainWnd_Create(ByRef CreateStruct As CREATESTRUCT)
Dim hDC As HDC
hDC=GetDC(hMainWnd)
bp.BloadPics("char.bmp")
buf.CreateTSPARENT(hDC,bp.GetHandleBmp(),0)
ReleaseDC(hMainWnd,hDC)
End Sub

Sub MainWnd_Paint(hDC As HDC)
buf.PrintData(hDC,20,50,60,30)
End Sub

[/code][/hide]