Active Basic 画像の透過処理

質問

AB4.23.00を使っています。

簡単なゲームを作ろうと思って作成を進めているのですが、
画像を透過する処理でつまずいてしまいました。

Sub ShowPictures()
/*ピクチャを描写する*/
Dim n As Long
Dim hDC As HDC
Dim hMyMaskDC As HDC '自機マスク用
Dim hMyMaskBmp As HBITMAP '自機マスク用
Dim hMyTempDC As DWord
Dim hMyTempBmp As DWord

hDC=GetDC(hMainWnd)

'背景
BitBlt(hMemDC,0,0,640,480,hBackDC,0,0,SRCCOPY)

'敵画像
For n=0 to 100 Step 1
BitBlt(hMemDC,ex[n],ey[n],30,30,hEneDC[n],0,0,SRCCOPY)
Next
'自機描写
hMyMaskDC=CreateCompatibleDC(hDC)
hMyMaskBmp=CreateBitmap(40,50,1,1,0)
SelectObject(hMyMaskDC,hMyMaskBmp)
BitBlt(hMyMaskDC,0,0,x,y,hMyDC,0,0,SRCCOPY)

hMyTempDC=CreateCompatibleDC(hDC)
hMyTempBmp=CreateCompatibleBitmap(hDC,40,50)
SelectObject(hMyTempDC,hMyTempBmp)

BitBlt(hMyTempDC,0,0,x,y,hMyMaskDC,0,0,NOTSRCCOPY)
'BitBlt(hMyTempDC,0,0,x,y,hMyDC,x,y,SRCAND)

'キャラクタ画像をOR転送
BitBlt(hMemDC,0,0,x,y,hMyTempDC,0,0,SRCPAINT)

'マスク画像をAND転送
BitBlt(hMemDC,0,0,x,y,hMyMaskDC,0,0,SRCAND)

'マスク用画像をメモリから解放
DeleteDC(hMyMaskDC)
DeleteObject(hMyMaskBmp)

'キャラクタの一時画像をメモリから解放
DeleteDC(hMyTempDC)
DeleteObject(hMyTempBmp)

InvalidateRect(hMainWnd,ByVal 0,FALSE)

DeleteObject(hMyMaskBmp)
DeleteDC(hMyMaskDC)
End Sub

描写処理のルーチンです。
これを実行すると、黒い塊になってしまいます。
どのように書けば、ちゃんと表示できるようになるのでしょうか。
すみませんが、ご教授をお願いします。

回答No.4

redfox63 · ベストアンサー

これらを使うのであれば

Dim hTempDC as HDC, hTempImg as HBITMAP

hTempDC = CreateCompatibleDC( hDC )
hTempImg = CreateCompatibleBitmap( hDC, 40, 50 );
SelectObject( hTempDC, hTempImg )

' 自機部分のみ白にする
BitBlt( hTempDC, 0, 0, 40, 50, hMyMask, 0, 0, NOTSRCCOPY )
' カラー画像を重ねて 背景が黒の画像を作る
BitBlt( hTempDC, 0, 0, 40, 50, hMyDC, 0, 0, SRCAND )

' バッファ画面に自機画像の黒抜きを描画
BitBlt(hMemDC,x,y,40,50,hMyMaskDC,0,0,SRCAND)
' バッファ画面に自機画像を描画
BitBlt(hMemDC,x,y,40,50,hMyTempDC,0,0,SRCPAINT)

---- 参考
　　' そのままAND描画
　　BitBlt( hMemDC, 0, 56, 40, 50, hMyMaskDC, 0, 0, SRCAND )
　　' 自機白抜き画像
　　BitBlt( hTempDC, 0, 0, 40, 50, hMyMaskDC, 0, 0, NOTSRCCOPY )
　　BitBlt( hMemDC, 56, 56, 40, 50, hTempDC, 0, 0, SRCCOPY )
　　' 黒背景自機カラー画像
　　BitBlt( hTemp, 0, 0, 40, 50, hImgDC1, 0, 0, SRCAND )
　　BitBlt( hMemDC, 112, 56, 40, 50, hTemp, 0, 0, SRCCOPY )
　　' 背景合成画像
　　BitBlt( hMemDC, 168, 56, 40, 50, hMono, 0, 0, SRCAND )
　　BitBlt( hMemDC, 168, 56, 40, 50, hTemp, 0, 0, SRCPAINT )

お礼

理解できました！！
本当にありがとうございました

回答No.3

redfox63

普通マスク.bmpが 自機のマスク画像なら
普通マスク.bmpは白黒ビットマップで自機の部分が黒抜きの画像にしましょうね

hMyMaskBmp = LoadImage(0,"普通マスク.bmp",IMAGE_BITMAP,0,0,LR_DEFAULTSIZE or LR_LOADFROMFILE)
SelectObject(hMyMaskDC,hMyMaskBmp)
' この転送は行ってはいけません
' これを行ってしまうとLoadImageとSelectObjectで設置した
' Bitmapを破壊します
' BitBlt(hMyMaskDC,0,0,x,y,hMyDC,0,0,SRCCOPY)

お礼

ご回答ありがとうございます。
どうあがいても、透過されません。

普通画像：http://www.holygate.sakura.ne.jp/Data/futu.bmp
マスク画像：http://www.holygate.sakura.ne.jp/Data/futumask.bmp

この画像を使っています。

コード

Sub ShowPictures()
/*ピクチャを描写する*/
Dim n As Long
Dim hDC As HDC
Dim hMyMaskDC As HDC '自機マスク用
Dim hMyMaskBmp As HBITMAP '自機マスク用
Dim hMyTempDC As HDC
Dim hMyTempBmp As HBITMAP

hDC=GetDC(hMainWnd)

'背景
BitBlt(hMemDC,0,0,640,480,hBackDC,0,0,SRCCOPY)

'敵画像
For n=0 to 100 Step 1
BitBlt(hMemDC,ex[n],ey[n],30,30,hEneDC[n],0,0,SRCCOPY)
Next

'自機描写
hMyMaskDC=CreateCompatibleDC(hDC)

hMyMaskBmp = LoadImage(0,Dir+"\構成ファイル\pic\普通マスク.bmp",IMAGE_BITMAP,0,0,LR_DEFAULTSIZE or LR_LOADFROMFILE)
SelectObject(hMyMaskDC,hMyMaskBmp)

hMyTempDC=CreateCompatibleDC(hDC)

hMyTempBmp = LoadImage(0,Dir+"\構成ファイル\pic\普通.bmp",IMAGE_BITMAP,0,0,LR_DEFAULTSIZE or LR_LOADFROMFILE)
SelectObject(hMyTempDC,hMyTempBmp)

BitBlt(hMemDC,x,y,40,50,hMyMaskDC,0,0,SRCAND)
BitBlt(hMemDC,x,y,40,50,hMyTempDC,0,0,SRCPAINT)

'キャラクタの一時画像をメモリから解放
DeleteDC(hMyTempDC)
DeleteObject(hMyTempBmp)

' BitBlt(hMemDC,x,y,40,50,hMyDC,0,0,SRCCOPY)

DeleteObject(hMyMaskBmp)
DeleteDC(hMyMaskDC)

InvalidateRect(hMainWnd,ByVal 0,FALSE)
End Sub

これは、透過できないものなのでしょうか・・・

回答No.2

redfox63

記憶違いかもしれませんが ...

確かカラーのキャラクター画像を並べたものを使っていたと思います
これをhCharTipsDCに選択してあるはずです

モノクロのマスク用ビットマップを選択したDCに
カラーのキャラクタ画像を選択したDCからBitBlt転送をお示しの方法で行うと
色のついている部分はマスク用の黒、元の黒の部分が白になると思います

この出来上がったマスクを使って
キャラクター用のDCに対して
マスクの反転をコピー ... つまりキャラクタ部分のみ黒抜きする
キャラクタを元画像からAND転送 ... 黒抜きの中を描画
これで『キャラクタとその周りが黒』といった画像が出来る

今度は画面更新用のDCに対して
マスク画像をAND転送 ... 背景の中にキャラクタ部分だけ黒抜き
キャラ画像のOR転送 ... 背景の黒抜きの中にキャラ画像を描画
といった手順をとっているのでしょう

お礼

回答ありがとうございます。
難しいですね・・・
頑張って理解していきたいと思います。

redfox63様が貼ってくださったコードをつなぎ合わせて以下のコードを作成しましたが、透過されませんでした。
いろいろ探したのですが、どうしても分かりません。
すみませんが、添削をお願いします。
何度もすみません。

Sub ShowPictures()
/*ピクチャを描写する*/
Dim n As Long
Dim hDC As HDC
Dim hMyMaskDC As HDC '自機マスク用
Dim hMyMaskBmp As HBITMAP '自機マスク用
Dim hMyTempDC As DWord
Dim hMyTempBmp As DWord

hDC=GetDC(hMainWnd)

'背景
BitBlt(hMemDC,0,0,640,480,hBackDC,0,0,SRCCOPY)

'敵画像
For n=0 to 100 Step 1
BitBlt(hMemDC,ex[n],ey[n],30,30,hEneDC[n],0,0,SRCCOPY)
Next

'自機描写
hMyMaskDC=CreateCompatibleDC(hDC)

hMyMaskBmp = LoadImage(0,"普通マスク.bmp",IMAGE_BITMAP,0,0,LR_DEFAULTSIZE or LR_LOADFROMFILE)
SelectObject(hMyMaskDC,hMyMaskBmp)
BitBlt(hMyMaskDC,0,0,x,y,hMyDC,0,0,SRCCOPY)

hMyTempDC=CreateCompatibleDC(hDC)

hMyTempBmp = LoadImage(0,"普通.bmp", IMAGE_BITMAP,0,0,LR_DEFAULTSIZE or LR_LOADFROMFILE)
SelectObject(hMyTempDC,hMyTempBmp)

BitBlt(hMemDC,x,y,40,50,hMyMaskDC,0,0,SRCAND)
BitBlt(hMemDC,x,y,40,50,hMyTempDC,0,0,SRCPAINT)

'キャラクタの一時画像をメモリから解放
DeleteDC(hMyTempDC)
DeleteObject(hMyTempBmp)

DeleteObject(hMyMaskBmp)
DeleteDC(hMyMaskDC)

InvalidateRect(hMainWnd,ByVal 0,FALSE)
End Sub

回答No.1

redfox63

表示したい『自機』のマスク画像と描写画像を準備して
LoadImageなどでビットマップハンドルとして取得しましょう

CreateBitmapで生成しただけなら黒の矩形になって当然だと思いますよ

'自機描写
hMyMaskDC=CreateCompatibleDC(hDC)
' ここを修正
'hMyMaskBmp=CreateBitmap(40,50,1,1,0)
hMyMaskBmp = LoadImage( 0, "myImgMask.bmp", IMAGE_BITMAP,0,0,LR_DEFAULTSIZE or LR_LOADFROMFILE)
SelectObject(hMyMaskDC,hMyMaskBmp)
BitBlt(hMyMaskDC,0,0,x,y,hMyDC,0,0,SRCCOPY)

hMyTempDC=CreateCompatibleDC(hDC)
' ここも修正
' hMyTempBmp=CreateCompatibleBitmap(hDC,40,50)
hMyTempBmp = LoadImage( 0, "myImg.bmp", IMAGE_BITMAP,0,0,LR_DEFAULTSIZE or LR_LOADFROMFILE)
SelectObject(hMyTempDC,hMyTempBmp)

' 実際の描画
' 背景とのAND処理
' これで自機の部分の黒抜き画像になる
BitBlt(hMemDC,0,0,x,y,hMyMaskDC,0,0,SRCAND)

'キャラクタ画像をOR転送
' 黒抜き部分自機を描画
BitBlt(hMemDC,0,0,x,y,hMyTempDC,0,0,SRCPAINT)

という順序で実行します

後でMask画像でAND転送するとせっかく描画した自機を『黒抜き』にしてしまいます

お礼

ご回答ありがとうございます。

>>表示したい『自機』のマスク画像
なのですが、
http://www.activebasic.com/help_center/articles/win32/index.html
の、RPGゲームを作成の部分のコードをいろいろ参考にして、上のコードを書いてみたのですが、RPGゲームのファイルにマスク画像はありませんでした。

Sub DrawCharacter(CharTipX As Long, CharTipY As Long, MiddleOffsetX As Double, MiddleOffsetY As Double)
Dim hMaskDC As DWord
Dim hMaskBmp As DWord
Dim hTempDC As DWord
Dim hTempBmp As DWord
Dim x As Long, y As Long

'マップデータをコピー
BitBlt(hMemDC,0,0,MAX_MAPX*MAPCHIP_PIXEL,MAX_MAPY*MAPCHIP_PIXEL,hMapDC,0,0,SRCCOPY)

'マスク用画像を作成
hMaskDC=CreateCompatibleDC(hMemDC)
hMaskBmp=CreateBitmap(CHAR_PIXEL_X,CHAR_PIXEL_Y,1,1,0)
SelectObject(hMaskDC,hMaskBmp)
BitBlt(hMaskDC,0,0,CHAR_PIXEL_X,CHAR_PIXEL_Y, _
hCharTipsDC, CharTipX*CHAR_PIXEL_X, CharTipY*CHAR_PIXEL_Y, SRCCOPY)

'スプライト用のキャラクタ画像を作成
hTempDC=CreateCompatibleDC(hMemDC)
hTempBmp=CreateCompatibleBitmap(hMemDC,CHAR_PIXEL_X,CHAR_PIXEL_Y)
SelectObject(hTempDC,hTempBmp)
BitBlt(hTempDC,0,0,CHAR_PIXEL_X,CHAR_PIXEL_Y,hMaskDC,0,0,NOTSRCCOPY)
BitBlt(hTempDC,0,0,CHAR_PIXEL_X,CHAR_PIXEL_Y, _
hCharTipsDC, CharTipX*CHAR_PIXEL_X, CharTipY*CHAR_PIXEL_Y,SRCAND)

x=CharPos.x*MAPCHIP_PIXEL-((CHAR_PIXEL_X-MAPCHIP_PIXEL)/2)+MAPCHIP_PIXEL*MiddleOffsetX
y=CharPos.y*MAPCHIP_PIXEL-((CHAR_PIXEL_Y-MAPCHIP_PIXEL)/2)+MAPCHIP_PIXEL*MiddleOffsetY

'マスク画像をAND転送
BitBlt(hMemDC, x, y, CHAR_PIXEL_X, CHAR_PIXEL_Y, _
hMaskDC, 0, 0, SRCAND)

'キャラクタ画像をOR転送
BitBlt(hMemDC, x, y, CHAR_PIXEL_X, CHAR_PIXEL_Y, _
hTempDC,0,0,SRCPAINT)

'マスク用画像をメモリから解放
DeleteDC(hMaskDC)
DeleteObject(hMaskBmp)

'キャラクタの一時画像をメモリから解放
DeleteDC(hTempDC)
DeleteObject(hTempBmp)
End Sub

これは、どのようにして透過処理をしているのでしょうか。
すみませんが、もう一度ご教授の方をお願いできないでしょうか。