クリップボードへ転送と取り出し(BITMAP)U          <TOP>


BITMAPファイルを読み込み、クリップボードへ転送します。また、そのデータをピクチャボックスに描画します。

LoadImage 画像ファイルの読み込み

CopyImage イメージを拡大縮小してコピー

OpenClipboard クリップボードをオープン

EmptyClipboard クリップボードをからにする

SetClipboardData クリップボードにデータを設定

GetClipboardData クリップボードから指定フォーマットのデータを検索

CloseClipboard クリップボードをクローズ

IsClipboardFormatAvailable 指定したフォーマットがクリップボードにあるかどうかを判定

CreateCompatibleDC メモリデバイスコンテキストを作成

SelectObject 指定されたデバイスコンテキストのオブジェクトを選択

GetObject オブジェクトを取得

BitBlt ビットブロック転送を行う

DeleteDC 指定されたデバイスコンテキストを削除

GetDC デバイスコンテキストのハンドルを取得

ReleaseDC デバイスコンテキストを解放

 

BitmapファイルをEditBoxにドラッグ&ドロップし「コピー」クリックでクリップボードに転送、「貼り付け」でフォームに画像を貼り付けます。

 

'================================================================
'= クリップボードへ転送と取り出し(BITMAP)U
'=    (Clipboard.bas)
'================================================================
#include "Windows.bi"

Type BITMAP
    bmType       As Long
    bmWidth      As Long
    bmHeight     As Long
    bmWidthBytes As Long
    bmPlanes     As Integer
    bmBitsPixel  As Integer
    bmBits       As Long
End Type

#define LR_LOADFROMFILE &H10            '外部ファイルからロードする
#define IMAGE_BITMAP 0                  'ビットマップ
#define IMAGE_CURSOR 2                  'カーソル
#define IMAGE_ENHMETAFILE 3             '拡張メタファイル
#define IMAGE_ICON 1                    'アイコン
#define CF_TEXT 1                       'テキスト形式のデータ。各行は復帰改行(CR-LF)コードで終わる
#define CF_BITMAP 2                     'ビットマップのデータ(HBITMAP)
#define SRCCOPY &HCC0020                'そのまま転送

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

' クリップボードをオープン
Declare Function Api_OpenClipboard& Lib "User32" Alias "OpenClipboard" (ByVal hWnd&)

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

' クリップボードを空にする
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_IsClipboardFormatAvailable& Lib "user32" Alias "IsClipboardFormatAvailable" (ByVal wFormat&)

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

' オブジェクト取得
Declare Function Api_GetObject& Lib "gdi32" Alias "GetObjectA" (ByVal hObject&, ByVal nCount&, lpObject 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_SelectObject& Lib "gdi32" Alias "SelectObject" (ByVal hDC&, ByVal hObject&)

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

Var Shared Edit1 As Object
Var Shared Button1 As Object
Var Shared Button2 As Object

Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
Button2.Attach GetDlgItem("Button2") : Button2.SetFontSize 14

Var Shared hDC As Long
Var Shared mhDC As Long
Var Shared FileName As String

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

    hDC = Api_GetDC(GethWnd)
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
'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var hBitmap As Long
    Var Ret As Long

    'ビットマップを指定するサイズでメモリにロード
    hBitmap = Api_LoadImage(GethInst, FileName, IMAGE_BITMAP, 100, 100, LR_LOADFROMFILE)
    If hBitmap = 0 Then
        A% = MessageBox(GetWindowText, "ビットマップをロードできません!", 0, 2)
        Exit Sub
    End If

    'クリップボードをオープン
    Ret = Api_OpenClipboard(GethWnd)

    'クリップボードをクリア
    Ret = Api_EmptyClipboard()

    'クリップボードにビットマップをセット
    Ret = Api_SetClipboardData(CF_BITMAP, hBitmap)

    'クリップボードをクローズ
    Ret = Api_CloseClipboard()
End Sub

'================================================================
'=
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Var bmp As BITMAP
    Var hBit As Long
    Var Ret As Long

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

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

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

        'Object取得
        Ret = Api_GetObject(hBit, Len(bmp), bmp)

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

        '指定ののデバイスコンテキストにメモリデバイスコンテキストのデータを転送
        Ret = Api_BitBlt(hDC, 10, 40, bmp.bmWidth, bmp.bmHeight, mhDC, 0, 0, SRCCOPY)
    End If
End Sub

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

    Ret = Api_ReleaseDC(GethWnd, hDC)
    Ret = Api_DeleteDC(mhDC)
    Ret = Api_CloseClipboard()
End SUb

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