こんな関数はいかがですか?
MaskBlt
マスク処理(透過コピー)をします。
MaskBlt(
hdcDest As HDC, _
nXDest As Long, _
nYDest As Long, _
nWidth As Long, _
nHeight As Long, _
hdcSrc As HDC, _
nXSrc As Long, _
nYSrc As Long, _
bkColor As DWord) As Long
hdcDest
コピー先のデバイスコンテキストです。
nXDest
コピー先長方形領域の左上隅の X 座標を指定します。
nYDest
コピー先長方形領域の左上隅の Y 座標を指定します。
nWidth
コピー先長方形領域の幅を指定します。
nHeight
コピー先長方形領域の高さを指定します。
hdcSrc
コピー元デバイス コンテキストのハンドルを指定します。
nXSrc
コピー元長方形領域の左上隅の X 座標を指定します。
nYSrc
コピー元長方形領域の左上隅の Y 座標を指定します。
bkColor
透過色を指定します。
戻り値
関数が成功すると TRUE が返ります。失敗すると FALSE が返ります。
コード:
Function MaskBlt(hdcDest As HDC, nXDest As Long, nYDest As Long, nWidth As Long, nHeight As Long, hdcSrc As HDC, nXSrc As Long, nYSrc As Long, bkColor As DWord) As Long
Dim hMaskDC As HDC, hMaskBmp As HBITMAP, oldBkColor As DWord, hTempDC As HDC, hTempBmp As HBITMAP, ret1 As Long, ret2 As Long
'背景色を指定
oldBkColor = SetBkColor(hdcSrc, bkColor)
'マスク用画像を作成
hMaskDC = CreateCompatibleDC(hdcSrc)
hMaskBmp = CreateBitmap(nWidth, nHeight, 1, 1, 0)
SelectObject(hMaskDC, hMaskBmp)
BitBlt(hMaskDC, 0, 0, nWidth, nHeight, hdcSrc, nXSrc, nYSrc, SRCCOPY)
'スプライト用画像を作成
hTempDC = CreateCompatibleDC(hdcSrc)
hTempBmp = CreateCompatibleBitmap(hdcSrc, nWidth, nHeight)
SelectObject(hTempDC, hTempBmp)
BitBlt(hTempDC, 0, 0, nWidth, nHeight, hMaskDC, 0, 0, NOTSRCCOPY)
BitBlt(hTempDC, 0, 0, nWidth, nHeight, hdcSrc, nXSrc, nYSrc, SRCAND)
'スプライト処理
ret1 = BitBlt(hdcDest, nXDest, nYDest, nWidth, nHeight, hMaskDC, 0, 0, SRCAND)
ret2 = BitBlt(hdcDest, nXDest, nYDest, nWidth, nHeight, hTempDC, 0, 0, SRCPAINT)
'全て元に戻す
SetBkColor(hdcSrc, oldBkColor)
DeleteDC(hTempDC) : DeleteObject(hTempBmp)
DeleteDC(hMaskDC) : DeleteObject(hMaskBmp)
If ret1 = 1 and ret2 = 1 Then
MaskBlt = 1
Else
MaskBlt = 0
End If
End Function
長くてすみません。