クリップボードへ転送と取り出し(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