'================================================================
'= BITMAPのクリップボード転送と取り出し

'=    (SetClipboardData.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 IMAGE_BITMAP 0                  'ビットマップ
#define LR_DEFAULTSIZE &H40             '標準サイズで表示
#define LR_COPYRETURNORG &H4            '指定されたサイズを無視し、そのままコピー
#define LR_SHARED &H8000                'イメージハンドルを固定する
#define LR_LOADFROMFILE &H10            '外部ファイルからロードする

#define CF_BITMAP 2                     'ビットマップのデータ(HBITMAP)
#define CF_DIB 8                        '構造体とビットマップビットからなるメモリオブジェクト
#define CF_DIF 5                        'SoftwareArts社のDIFデータ交換形式
#define CF_TEXT 1                       'テキスト形式のデータ。各行は復帰改行(CR-LF)コードで終わる
#define CF_TIFF 6                       'TIFF形式の画像データ
#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_CopyImage& Lib "user32" Alias "CopyImage" (ByVal handle&, ByVal imageType&, ByVal newWidth&, ByVal newHeight&, ByVal lFlags&)

' クリップボードをオープン
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_GetObject& Lib "gdi32" Alias "GetObjectA" (ByVal hObject&, ByVal nCount&, lpObject As Any)

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

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

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

Var Shared Picture1 As Object
Var Shared Text(1) As Object
Var Shared Edit(1) As Object
Var Shared Button(1) As Object

Picture1.Attach GetDlgItem("Picture1")
For i = 0 To 1
    Text(i).Attach GetDlgItem("Text" & Trim$(Str$(i + 1))) : Text(i).SetFontSize 14
    Edit(i).Attach GetDlgItem("Edit" & Trim$(Str$(i + 1))) : Edit(i).SetFontSize 14
    Button(i).Attach GetDlgItem("Button" & Trim$(Str$(i + 1))) : Button(i).SetFontSize 14
Next

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

    phDC = Api_GetDC(Picture1.GethWnd)

    Picture1.Cls

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

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

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

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

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

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

        Ret = Api_ReleaseDC(Picture1.GethWnd, phDC)
        Ret = Api_DeleteDC(mhDC)
        Ret = Api_CloseClipboard()
    End If
End Sub

'================================================================
'= LoadImage → SetClipboardData
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var hBit As Long
    Var nx As Long
    Var ny As Long
    Var Ret As Long

    Ret = Api_OpenClipboard(GethWnd)
    Ret = Api_EmptyClipboard

    nx = Val(Edit(0).GetWindowText)
    ny = Val(Edit(1).GetWindowText)

    '画像ファイル(bike1.bmp)を読み込む
    hBit = Api_LoadImage(0, "bike1.bmp", IMAGE_BITMAP, nx, ny, LR_LOADFROMFILE)

    'クリップボードにデータを設定
    Ret = Api_SetClipboardData(CF_BITMAP, hBit)

    Ret = Api_CloseClipboard

    ImageFromClipBoard 
End Sub

'================================================================
'= LoadImage → CopyImage → SetClipboardData
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Var hBit As Long
    Var hNew As Long
    Var nx As Long
    Var ny As Long
    Var Ret As Long

    Ret = Api_OpenClipboard(GethWnd)
    Ret = Api_EmptyClipboard

    nx = Val(Edit(0).GetWindowText)
    ny = Val(Edit(1).GetWindowText)

    '画像ファイル(bike1.bmp)を読み込む
    hBit = Api_LoadImage(0, "bike1.bmp", IMAGE_BITMAP, 0, 0, LR_LOADFROMFILE)

    'イメージを拡大縮小してコピー
    hNew = Api_CopyImage(hBit, IMAGE_BITMAP, nx, ny, LR_COPYRETURNORG)

    'クリップボードにデータを設定
    Ret = Api_SetClipboardData(CF_BITMAP, hNew)

    Ret = Api_CloseClipboard

    ImageFromClipBoard 
End Sub

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