'================================================================
'= ビットマップの画像情報を取得
'=    (GetObject2.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 OBJ_DC 3                        'デバイスコンテキスト
#define OBJ_ENHMETADC 12                '拡張メタファイルのデバイスコンテキスト
#define OBJ_ENHMETAFILE 13              '拡張メタファイル
#define OBJ_EXTPEN 11                   '拡張ペン
#define OBJ_FONT 6                      'フォント
#define OBJ_MEMDC 10                    'メモリデバイスコンテキスト
#define OBJ_METADC 4                    'メタファイルのデバイスコンテキスト
#define OBJ_METAFILE 9                  'メタファイル
#define OBJ_PAL 5                       'パレット
#define OBJ_PEN 1                       'ペン
#define OBJ_REGION 8                    '領域
#define OBJ_BITMAP 7

#define IMAGE_BITMAP 0                  'ビットマップ
#define IMAGE_CURSOR 2                  'カーソル
#define IMAGE_ENHMETAFILE 3             '拡張メタファイル
#define IMAGE_ICON 1                    'アイコン
#define LR_LOADFROMFILE &H10            '外部ファイルからロードする
#define LR_CREATEDIBSECTION &H2000      'デバイス独立ビットマップとしてロードする
#define SRCCOPY &HCC0020                'そのまま転送

' 指定されたデバイスコンテキストに関連するデバイスと互換性のあるメモリデバイスコンテキストを作成
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_GetObjectType& Lib "gdi32" Alias "GetObjectType" (ByVal hgdiobj&)

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

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

' ビットブロック転送を行う。コピー元からコピー先のデバイスコンテキストへ、指定された長方形内の各ピクセルの色データをコピー
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 Picture1 As Object
Var Shared Edit1 As Object
Var Shared Text1 As Object
Var Shared Text2 As Object
Var Shared Button1 As Object

Picture1.Attach GetDlgItem("Picture1")
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 12
Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Text2.Attach GetDlgItem("Text2") : Text2.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

Var Shared FileName As String
Var Shared hDC As Long

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var bm As BITMAP
    Var hBitmap As Long
    Var BitmapDC As Long
    Var Ret As Long
   
    hDC = Api_GetDC(Picture1.GethWnd)

    Picture1.Cls

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

    '呼び出し失敗の場合終了
    If (hBitmap = 0) Then
        A% = MessageBox("Bitmap Load Error", "Error, Bitmapファイルではありません！", 0, 2)
        End
    End If

    'ロードしたBitmapのデバイスコンテキストを作成
    BitmapDC = Api_CreateCompatibleDC(0)

    '失敗した場合プロシージャを抜ける
    If (BitmapDC = 0) Then
        A% = MessageBox("Device Context Error", "Error, デバイスコンテキストを作成できません！", 0, 2)
        Exit Sub
    End If

    '作成されたデバイスコンテキストにBitmapをAttach
    Ret = Api_SelectObject(BitmapDC, hBitmap)

    'イメージ情報を取得
    Ret = Api_GetObject(hBitmap, Len(bm), bm)

    'Pictureに描画
    Ret = Api_BitBlt(hDC, 0, 0, bm.bmWidth, bm.bmHeight, BitmapDC, 0, 0, SRCCOPY)

    Text1.SetWindowText Trim$(Str$(bm.bmBitsPixel)) & "Bit"
    Text2.SetWindowtext Trim$(Str$(bm.bmWidth)) & "x" & Trim$(Str$(bm.bmHeight))

    Ret = Api_ReleaseDC(hDC, Picture1.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 MainForm_QueryClose edecl ()
Sub MainForm_QueryClose()
    Var Ret As Long

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

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