'================================================================
'= ファイルからBitmapをロード

'=    (LoadImage.bas)
'================================================================
#include "Windows.bi"

#define LR_LOADFROMFILE &H10            '外部ファイルからロードする
#define IMAGE_BITMAP 0                  'ビットマップ
#define IMAGE_CURSOR 2                  'カーソル
#define IMAGE_ICON 1                    'アイコン
#define IMAGE_ENHMETAFILE 3             '拡張メタファイル
#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_IsClipboardFormatAvailable& Lib "user32" Alias "IsClipboardFormatAvailable" (ByVal wFormat&)

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

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

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

' 指定されたデバイスコンテキストを削除
Declare Function Api_DeleteDC& Lib "gdi32" Alias "DeleteDC" (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_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

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

Var Shared hBitmap As Long
Var Shared phDC As Long
Var Shared FileName As String

Var Shared Picture1 As Object
Var Shared Edit1 As Object

Picture1.Attach GetDlgItem("Picture1")
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14

'================================================================
'=
'================================================================
Declare Sub Mainform_Start edecl ()
Sub Mainform_Start()
    'ピクチャボックスのデバイスコンテキストを取得
    phDC = Api_GetDC(Picture1.GethWnd)
End Sub

'================================================================
'= 
'================================================================
Declare Sub PicturePaste edecl ()
Sub PicturePaste()
    Var hBuf As Long
    Var Ret As Long

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

    If hBitmap = 0 Then
        A% = MessageBox(GetWindowText, "ビットマップファイルをロードできません！", 0, 2)
        Exit Sub
    End If

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

    'クリップボードを初期化
    Ret = Api_EmptyClipboard()

    'クリップボードにBitmapをロード
    Ret = Api_SetClipboardData(CF_BITMAP, hBitmap)

    'クリップボードにBitmapが存在するかどうかを判断
    If Api_IsClipboardFormatAvailable(CF_BITMAP) = 0 Then
        A% = MessageBox(GetWindowText, "クリップボードにBitmapがありません！", 0, 2)
    End If

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

    Picture1.Cls

    'クリップボードに指定したフォーマットのデータがあるかどうかを調べる
    Ret = Api_GetClipboardData(CF_BITMAP)

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

    'オブジェクトを選択
    Ret = Api_SelectObject(hBuf, hBitmap)

    'ビットブロックの転送
    Ret = Api_BitBlt(phDC, 0, 0, Picture1.GetWidth, Picture1.GetHeight, hBuf, 0, 0, SRCCOPY)

    'デバイスコンテキストを削除
    Ret = Api_DeleteDC(hBuf)
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
    PicturePaste
End Sub

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

    Ret = Api_ReleaseDC(Picture1.GethWnd, phDC)
End Sub

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