画像転送          <TOP>


BitBlt ビットブロック転送を行う。コピー元からコピー先のデバイスコンテキストへ、指定された長方形内の各ピクセルの色データをコピー
CreateBitmap 指定された幅・高さ・色形式を持つビットマップを作成
SetBkColor デバイスコンテキストの背景色を設定
SelectObject 指定されたデバイスコンテキストのオブジェクトを選択
CreateCompatibleBitmap デバイスコンテキストと互換性のあるビットマップを作成
CreateCompatibleDC 指定されたデバイスコンテキストに関連するデバイスと互換性のあるメモリデバイスコンテキストを作成
DeleteDC 指定されたデバイスコンテキストを削除
DeleteObject 論理オブジェクトを削除し、そのオブジェクトに関連付けられていたすべてのシステムリソースを解放
GetDC 指定されたウィンドウのデバイスコンテキストのハンドルを取得
ReleaseDC デバイスコンテキストを解放
 

Picture2の画像をPicture1に転送しています。

 

'================================================================
'= 画像転送
'=    (BitBlt.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 SRCCOPY &HCC0020                '単純な上書き
#define NOTSRCCOPY &H330008             '反転コピー
#define SRCAND &H8800C6                 '転送先の画像とAND演算して転送
#define SRCINVERT &H660046              '転送先の画像とXOR演算して転送
#define vbWhite &HFFFFFF                '白のカラーコード

Var Shared PICTURE(2) As Object
Var Shared Bitmap As Object

For i = 0 To 2
    Picture(i).Attach GetDlgItem("Picture" & Trim$(Str$(i + 1)))
Next i
BitmapObject Bitmap

Var Shared rc As RECT
Var Shared pMove As Integer
Var Shared hDC1 As Long
Var Shared hDC2 As Long

'================================================================
'=
'================================================================
Declare Sub TranspPic(OutDstDC As Long, DstDC As Long, SrcDC As Long, SrcRect As RECT, ByVal DstX As Long, ByVal DstY As Long, TransColor As Long)
Sub TranspPic(OutDstDC As Long, DstDC As Long, SrcDC As Long, SrcRect As RECT, ByVal DstX As Long, ByVal DstY As Long, TransColor As Long)
    Var W As Long
    Var H As Long
    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
    H = SrcRect.Bottom - SrcRect.Top
     
    'モノクロと反転マスク
    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)
    Ret = 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)
     
    'オブジェクトの生成、DC解放
    hMonoMask = Api_SelectObject(MonoMaskDC, hPrevMask)
    Ret = Api_DeleteObject(hMonoMask)
    Ret = Api_DeleteDC(MonoMaskDC)
    
    hMonoInv = Api_SelectObject(MonoInvDC, hPrevInv)
    Ret = Api_DeleteObject(hMonoInv)
    Ret = Api_DeleteDC(MonoInvDC)
    
    hResultDst = Api_SelectObject(ResultDstDC, hPrevDst)
    Ret = Api_DeleteObject(hResultDst)
    Ret = Api_DeleteDC(ResultDstDC)
    
    hResultSrc = Api_SelectObject(ResultSrcDC, hPrevSrc)
    Ret = Api_DeleteObject(hResultSrc)
    Ret = Api_DeleteDC(ResultSrcDC)
End Sub

'================================================================
'=
'================================================================
Declare Sub MovePicTo (ByVal X As Long, ByVal Y As Long)
Sub MovePicTo(ByVal X As Long, ByVal Y As Long)
    X = X - rc.Right / 2
    Y = Y - rc.Bottom / 2

    Bitmap.LoadFile "Flower256.bmp"
    Picture(0).DrawBitmap Bitmap, 0, 0
    Bitmap.DeleteObject 
    TranspPic hDC1, hDC2, hDC2, rc, X, Y, vbWhite
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
    Bitmap.LoadFile "flower256.bmp"
    Picture(0).DrawBitmap Bitmap, 0, 0
    Bitmap.DeleteObject 

    Bitmap.LoadFile "bike6.bmp"	'"flower_Gray.bmp"
    Picture(1).DrawBitmap Bitmap, 0, 0
    Bitmap.DeleteObject 

    hDC1 = Api_GetDC(Picture(0).GethWnd)
    hDC2 = Api_GetDC(Picture(1).GethWnd)

    rc.Left = 0
    rc.Top = 0
    rc.Right = Picture(1).GetWidth
    rc.Bottom = Picture(1).GetHeight
End Sub

'================================================================
'=
'================================================================
Declare Sub Picture1_Click edecl ()
Sub Picture1_Click()
    If pMove = False Then
        pMove = True
    Else
        pMove = False
    End If
End Sub

'================================================================
'=
'================================================================
Declare Sub Picture1_MouseMove edecl (ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Sub Picture1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    If pMove Then 
        MovePicTo X, Y
    End If
End Sub

'================================================================
'=
'================================================================
Declare Sub MainForm_QueryClose()
Sub MainForm_QueryClose()
    Var Ret As Long

    Ret = Api_ReleaseDC(Picture(0).GethWnd, hDC1)
    Ret = Api_ReleaseDC(Picture(1).GethWnd, hDC2)
End Sub

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