画像転送 <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