'================================================================
'= 画像透過転送
'=    (TransparentBlt2.bas)
'================================================================
#include "Windows.bi"

Type RECT
   Left   As Long
   Top    As Long
   Right  As Long
   Bottom As Long
End Type

' ビットブロック転送を行う。コピー元からコピー先のデバイスコンテキストへ、指定された長方形内の各ピクセルの色データをコピー
Declare Function Api_BitBlt& Lib "gdi32" Alias "BitBlt" (ByVal hDestDC&, ByVal X&, ByVal Y&, ByVal nWidth&, ByVal nHeight&, ByVal hSrcDC&, ByVal xSrc&, ByVal ySrc&, ByVal dwRop&)

' 指定された幅・高さ・色形式を持つビットマップを作成
Declare Function Api_CreateBitmap& Lib "gdi32" Alias "CreateBitmap" (ByVal nWidth&, ByVal nHeight&, ByVal nPlanes&, ByVal nBitCount&, lpBits As Any)

' デバイスコンテキストの背景色を設定
Declare Function Api_SetBkColor& Lib "gdi32" Alias "SetBkColor" (ByVal hDC&, ByVal crColor&)

' 指定されたデバイスコンテキストのオブジェクトを選択
Declare Function Api_SelectObject& Lib "gdi32" Alias "SelectObject" (ByVal hDC&, ByVal hObject&)

' デバイスコンテキストと互換性のあるビットマップを作成
Declare Function Api_CreateCompatibleBitmap& Lib "gdi32" Alias "CreateCompatibleBitmap" (ByVal hDC&, ByVal nWidth&, ByVal nHeight&)

' 指定されたデバイスコンテキストに関連するデバイスと互換性のあるメモリデバイスコンテキストを作成
Declare Function Api_CreateCompatibleDC& Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hDC&)

' 指定されたデバイスコンテキストを削除
Declare Function Api_DeleteDC& Lib "gdi32" Alias "DeleteDC" (ByVal hDC&)

' ペン、ブラシ、フォント、ビットマップ、リージョン、パレットのいずれかの論理オブジェクトを削除し、そのオブジェクトに関連付けられていたすべてのシステムリソースを解放。オブジェクトを削除した後は、指定されたハンドルは無効になる
Declare Function Api_DeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject&)

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

' デバイスコンテキストを解放
Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&)

#define SRCAND &H8800C6                 '転送先の画像とAND演算して転送
#define SRCCOPY &HCC0020                'そのまま転送
#define SRCERASE &H440328               '転送先ビットマップを反転、その結果と転送元ビットマップを論理AND演算子で結合
#define SRCINVERT &H660046              '転送先の画像とXOR演算して転送
#define SRCPAINT &HEE0086               '転送先の画像とOR演算して転送
#define NOTSRCCOPY &H330008             '転送元の色データが全反転
#define NOTSRCERASE &H1100A6            'コピー元の色と、コピー先の色を論理OR演算子で結合し、さらに反転
#define MERGECOPY &HC000CA              'コピー元の色と、コピー先の色を論理AND演算子で結合
#define MERGEPAINT &HBB0226             '反転した転送元ビットマップとパターンビットマップを論理OR演算子で結合
#define vbWhite &HFFFFFF                '白のカラーコード
#define vbBlack &H000000                '黒のカラーコード

Var shared Picture1 As Object
Var shared Radio(3) As Object
Var Shared Button1 As Object
Var shared Bitmap As Object

Picture1.Attach GetDlgItem("Picture1")
For i = 0 To 3
    Radio(i).Attach GetDlgItem("Radio" & Trim$(Str$(i + 1))) : Radio(i).SetFontSize 14
Next i
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
BitmapObject Bitmap

'================================================================
'=
'================================================================
Declare Sub TransparentBlt(OutDstDC As Long, DstDC As Long, SrcDC As Long, SrcRect As RECT, DstX As Integer, DstY As Integer, TransColor As Long)
Sub TransparentBlt(OutDstDC As Long, DstDC As Long, SrcDC As Long, SrcRect As RECT, DstX As Integer, DstY As Integer, TransColor As Long)
    Var W As Integer
    Var H As Integer
    Var MonoMaskDC As Long
    Var hMonoMask As Long
    Var MonoInvDC As Long
    Var hMonoInv As Long
    Var ResultDstDC As Long
    Var hResultDst As Long
    Var ResultSrcDC As Long
    Var hResultSrc As Long
    Var hPrevMask As Long
    Var hPrevInv As Long
    Var hPrevSrc As Long
    Var hPrevDst As Long
    Var OldBC As Long
    Var Ret As Long
   
    W = SrcRect.Right - SrcRect.Left + 1
    H = SrcRect.Bottom - SrcRect.Top + 1
   
   'モノクロマスクおよびインバートマスクの作成
    MonoMaskDC = Api_CreateCompatibleDC(DstDC)
    MonoInvDC = Api_CreateCompatibleDC(DstDC)
    hMonoMask = Api_CreateBitmap(W, H, 1, 1, ByVal 0)
    hMonoInv = Api_CreateBitmap(W, H, 1, 1, ByVal 0)
    hPrevMask = Api_SelectObject(MonoMaskDC, hMonoMask)
    hPrevInv = Api_SelectObject(MonoInvDC, hMonoInv)
   
   'デバイスコンテキストとビットマップの作成
    ResultDstDC = Api_CreateCompatibleDC(DstDC)
    ResultSrcDC = Api_CreateCompatibleDC(DstDC)
    hResultDst = Api_CreateCompatibleBitmap(DstDC, W, H)
    hResultSrc = Api_CreateCompatibleBitmap(DstDC, W, H)
    hPrevDst = Api_SelectObject(ResultDstDC, hResultDst)
    hPrevSrc = Api_SelectObject(ResultSrcDC, hResultSrc)
   
   'モノクロマスクのコピー
    OldBC = Api_SetBkColor(SrcDC, TransColor)
    nRet = Api_BitBlt(MonoMaskDC, 0, 0, W, H, SrcDC, SrcRect.Left, SrcRect.Top, SRCCOPY)
    TransColor = Api_SetBkColor(SrcDC, OldBC)
   
   'マスクのインバース作成
    Ret = Api_BitBlt(MonoInvDC, 0, 0, W, H, MonoMaskDC, 0, 0, NOTSRCCOPY)
   
   'バックグラウンドの作成
    Ret = Api_BitBlt(ResultDstDC, 0, 0, W, H, DstDC, DstX, DstY, SRCCOPY)
   
   'モノクロマスクとのAND演算
    Ret = Api_BitBlt(ResultDstDC, 0, 0, W, H, MonoMaskDC, 0, 0, SRCAND)
   
   'オーバーラップの作成
    Ret = Api_BitBlt(ResultSrcDC, 0, 0, W, H, SrcDC, SrcRect.Left, SrcRect.Top, SRCCOPY)
   
   'インバースモノクロマスクとのAND演算
    Ret = Api_BitBlt(ResultSrcDC, 0, 0, W, H, MonoInvDC, 0, 0, SRCAND)
   
   '二つのXOR演算
    Ret = Api_BitBlt(ResultDstDC, 0, 0, W, H, ResultSrcDC, 0, 0, SRCINVERT)
   
   '出力
    Ret = Api_BitBlt(OutDstDC, DstX, DstY, W, H, ResultDstDC, 0, 0, SRCCOPY)
   
   'クリーンアップ
    hMonoMask = Api_SelectObject(MonoMaskDC, hPrevMask)
    Ret = Api_DeleteObject(hMonoMask)

    hMonoInv = Api_SelectObject(MonoInvDC, hPrevInv)
    Ret = Api_DeleteObject(hMonoInv)

    hResultDst = Api_SelectObject(ResultDstDC, hPrevDst)
    Ret = Api_DeleteObject(hResultDst)

    hResultSrc = Api_SelectObject(ResultSrcDC, hPrevSrc)
    Ret = Api_DeleteObject(hResultSrc)

    Ret = Api_DeleteDC(MonoMaskDC)
    Ret = Api_DeleteDC(MonoInvDC)
    Ret = Api_DeleteDC(ResultDstDC)
    Ret = Api_DeleteDC(ResultSrcDC)
End Sub

'================================================================
'=
'================================================================
Declare Sub Radio1_on edecl ()
Sub Radio1_on()
    Bitmap.LoadFile "Bike1.bmp"
    Picture1.DrawBitmap Bitmap, 0, 0
    Bitmap.DeleteObject
    Cls
End Sub

'================================================================
'=
'================================================================
Declare Sub Radio2_on edecl ()
Sub Radio2_on()
    Bitmap.LoadFile "Bike5.bmp"
    Picture1.DrawBitmap Bitmap, 0, 0
    Bitmap.DeleteObject
    Cls
End Sub

'================================================================
'=
'================================================================
Declare Sub Radio3_on edecl ()
Sub Radio3_on()
    Cls
End Sub

'================================================================
'=
'================================================================
Declare Sub Radio4_on edecl ()
Sub Radio4_on()
    Cls
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start
    Radio1_on
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var rc As RECT
    Var phDC As Long
    Var fhDC As Long
    Var Mask As Long
    Var Ret As Long

    phDC = Api_GetDC(Picture1.GethWnd)
    fhDC = Api_GetDC(GethWnd)

    rc.Left = 0
    rc.Top = 0
    rc.Right = Picture1.GetWidth
    rc.Bottom = Picture1.GetHeight

    cls
    If Radio(2).GetCheck = 1 Then
        Mask = vbWhite
    Else If Radio(3).GetCheck = 1 Then
        Mask = vbBlack
    End If

    TransparentBlt fhDC, fhDC, phDC, rc, 30, 60, Mask

    Ret = Api_ReleaseDC(phDC, Picture1.GethWnd)
    Ret = Api_ReleaseDC(fhDC, GethWnd)
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End