ab.com コミュニティ

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

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

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



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

コンストラクタなし
●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を使ってください。）

使用例↓

[ここをクリックすると内容が表示されます]

コード: 全て選択


' 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

WsEasyPicsを使わせていただく場合は

[ここをクリックすると内容が表示されます]

コード: 全て選択



#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

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

使用例のMainWnd_Destroy()に

コード: 全て選択


DeleteObject(hBmp)

が必要ですよね。

ab.com コミュニティ

画像透明化クラス

画像透明化クラス

問題発見