画像のネガ・ポジ変換(U)          <TOP>


LoadImage 画像ファイルの読み込み
GetObject オブジェクト取得
GetBitmapBits 指定されたビットマップのビットを取得し、バッファにコピー
SetBitmapBits ビットマップに指定された値をセット
BitBlt ビットブロック転送
OpenClipboard クリップボードをオープン
EmptyClipboard クリップボードを空にする
IsClipboardFormatAvailable 指定したフォーマットがクリップボードにあるかどうか判定
SetClipboardData クリップボードにデータを設定
GetClipboardData クリップボードから指定フォーマットのデータを検索
CloseClipboard クリップボードをクローズ
CreateCompatibleDC 指定されたデバイスコンテキストに関連するデバイスと互換性のあるメモリデバイスコンテキストを作成
SelectObject 指定されたデバイスコンテキストのオブジェクトを選択
DeleteDC 指定されたデバイスコンテキストを削除
GetDC 指定されたウィンドウのデバイスコンテキストのハンドルを取得
ReleaseDC デバイスコンテキストを解放
 

例では、取り込んだBitmapを反転後、クリップボードに転送しPicture2に貼り付けています。

 

'================================================================
'= 画像のポジ・ネガ変換(U)
'=    (GetBitmapBits2.bas)
'================================================================
#include "Windows.bi"

Type BITMAP
    bmType       As Long                'ビットマップ タイプを指定(0)
    bmWidth      As Long                'ビットマップの幅を指定
    bmHeight     As Long                'ビットマップの高さを指定
    bmWidthBytes As Long                '1 走査線あたりのバイト数を指定
    bmPlanes     As Integer             'カラープレーンを指定(通常1)
    bmBitsPixel  As Integer             '1 ピクセルを定義するのに必要なビット数を指定
    bmBits       As Long                'ビット データが格納されているの配列へのポインタを指定
End Type

#define IMAGE_BITMAP 0                  'ビットマップ
#define LR_LOADFROMFILE &H10            '外部ファイルからロードする
#define SRCCOPY &HCC0020                'そのまま転送
#define CF_BITMAP 2                     'ビットマップのデータ(HBITMAP)
#define CrLf Chr$(13, 10)

' オブジェクト取得
Declare Function Api_GetObject& Lib "gdi32" Alias "GetObjectA" (ByVal hObject&, ByVal nCount&, lpObject As Any)

' 画像ファイルの読み込み
Declare Function Api_LoadImage& Lib "user32" Alias "LoadImageA" (ByVal hInst&, ByVal lpszName$, ByVal uType&, ByVal cxDesired&, ByVal cyDesired&, ByVal fuLoad&)

' 指定されたビットマップのビットを取得し、バッファにコピー
Declare Function Api_GetBitmapBits& Lib "gdi32" Alias "GetBitmapBits" (ByVal hBitmap&, ByVal dwCount&, lpBits As Any)

' ビットマップに指定された値をセット
Declare Function Api_SetBitmapBits& Lib "gdi32" Alias "SetBitmapBits" (ByVal hBitmap&, ByVal dwCount&, lpBits As Any)

' 指定されたウィンドウのデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

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

' ビットブロック転送を行う。コピー元からコピー先のデバイスコンテキストへ、指定された長方形内の各ピクセルの色データをコピー
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_OpenClipboard& Lib "user32" Alias "OpenClipboard" (ByVal hWnd&)

' クリップボードを空にする
Declare Function Api_EmptyClipboard& Lib "user32" Alias "EmptyClipboard" ()

' クリップボードにデータを設定
Declare Function Api_SetClipboardData& Lib "user32" Alias "SetClipboardData" (ByVal wFormat&, ByVal hMem&)

' クリップボードから指定フォーマットのデータを検索
Declare Function Api_GetClipboardData& Lib "user32" Alias "GetClipboardData" (ByVal wFormat&)

' クリップボードをクローズ
Declare Function Api_CloseClipboard& Lib "user32" Alias "CloseClipboard" ()

' 指定したフォーマットがクリップボードにあるかどうか判定
Declare Function Api_IsClipboardFormatAvailable& Lib "user32" Alias "IsClipboardFormatAvailable" (ByVal wFormat&)

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

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

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

Var Shared Picture1 As Object
Var Shared Picture2 As Object
Var Shared Edit1 As Object
Var Shared Button1 As Object
Var SHared Bitmap As Object

Picture1.Attach GetDlgItem("Picture1")
Picture2.Attach GetDlgItem("Picture2")
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
BitmapObject Bitmap

Var Shared FileName As String
Var Shared bm As BITMAP

'================================================================
'= ClipBoardからPictureBoxへ
'================================================================
Declare Sub ImageFromClipBoard ()
Sub ImageFromClipBoard()
    Var hBitmap As Long
    Var phDC As Long
    Var mhDC As Long
    Var Ret As Long

    phDC = Api_GetDC(Picture2.GethWnd)

    Picture2.Cls

    'Bitmap型式データの有無を調査
    If Api_IsClipboardFormatAvailable(CF_BITMAP) <> 0 Then
        Ret = Api_OpenClipboard(GethWnd)

        '指定フォーマットのBITMAPデータを検索
        hBitmap = Api_GetClipboardData(CF_BITMAP)

        'メモリデバイスコンテキストを作成
        mhDC = Api_CreateCompatibleDC(phDC)

        'Object取得
        Ret = Api_GetObject(hBitmap, Len(bm), bm)

        'Object選択
        Ret = Api_SelectObject(mhDC, hBitmap)

        '指定の(PictureBox)のデバイスコンテキストにメモリデバイスコンテキストのデータを転送
        Ret = Api_BitBlt(phDC, 0, 0, bm.bmWidth, bm.bmHeight, mhDC, 0, 0, SRCCOPY)

        '解放処理
        Ret = Api_ReleaseDC(Picture1.GethWnd, phDC)
        Ret = Api_DeleteDC(mhDC)
        Ret = Api_CloseClipboard()
    End If
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var hBitmap As Long
    Var Ret As Long

    'ファイルからBitmapをロード
    hBitmap = Api_LoadImage(0, FileName, IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)

    If hBitmap = 0 Then
        A% = MessageBox("ロードできません!", "BitmapFileをEditBoxに" & CrLf & CrLf & "Drag & Dropしてください!", 0, 2)
        Exit Sub
    End If

    '元の画像をPicture1に(F-Basic)
    Bitmap.LoadFile FileName
    Picture1.DrawBitmap Bitmap, 0, 0
    Bitmap.DeleteObject

    'オブジェクトを取得
    Ret = Api_GetObject(hBitmap, Len(bm), bm)

    Var Img(bm.bmWidthBytes - 1, bm.bmHeight - 1) As Byte

    'ビットマップのビットを取得し、バッファにコピー
    Ret = Api_GetBitmapBits(hBitmap, bm.bmWidthBytes * bm.bmHeight, Img(0, 0))

    '反転処理
    For y = 0 To bm.bmHeight - 1
        For x = 0 To bm.bmWidthBytes - 1
            Img(x, y) = Not Img(x, y)
        Next
    Next

    '反転されたビットマップ値をセット
    Ret = Api_SetBitmapBits(hBitmap, bm.bmWidthBytes * bm.bmHeight, Img(0, 0))

    'クリップボードにデータを設定
    Ret = Api_OpenClipboard(GethWnd)
    Ret = Api_EmptyClipboard
    Ret = Api_SetClipboardData(CF_BITMAP, hBitmap)
    Ret = Api_CloseClipboard

    'ClipboardからPicture2に画像を転送
    ImageFromClipBoard 
End Sub

'================================================================
'= シェルドロップされたファイル名を取得
'================================================================
Declare Sub Edit1_DropFiles edecl (ByVal DF As Long)
Sub Edit1_DropFiles(ByVal DF As Long)
    Var CN As Long

    CN = GetDropFileCount(DF)
    FileName = GetDropFileName(DF, 0)
    Edit1.SetWindowText FileName
End Sub

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