'================================================================
'= クリップボードが持つデータ形式の列挙と表示
'=     (EnumClipboardFormats.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

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

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

' クリップボード内にあるフォーマットを列挙
Declare Function Api_EnumClipboardFormats& Lib "user32" Alias "EnumClipboardFormats" (ByVal wFormat&)

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

' クリップボードのフォーマットから名前を取得
Declare Function Api_GetClipboardFormatName& Lib "user32" Alias "GetClipboardFormatNameA" (ByVal wFormat&, ByVal lpString$, ByVal nMaxCount&)

' 指定された文字列のバイトまたは文字の長さを返す
Declare Function Api_lstrlen& Lib "Kernel32" Alias "lstrlenA" (ByVal lpString$)

' 文字列をコピーする
Declare Function Api_lstrcpy& Lib "Kernel32" Alias "lstrcpyW" (lpszString1 As Any, lpszString2 As Any)

' ヒープに確保されたメモリをロック
Declare Function Api_GlobalLock& Lib "kernel32" Alias "GlobalLock" (ByVal hMem&)

' メモリブロックのロックを解除
Declare Function Api_GlobalUnlock& Lib "kernel32" Alias "GlobalUnlock" (ByVal hMem&)

' オブジェクト取得
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_CreateCompatibleDC& Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hDC&)

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

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

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

#define SRCCOPY &HCC0020                'そのまま転送
#define CF_BITMAP 2                     'ビットマップのデータ(HBITMAP)
#define CF_TEXT 1                       'テキスト形式のデータ。各行は復帰改行(CR-LF)コードで終わる

Var Shared List1 As Object
Var Shared Picture1 As Object
Var Shared Button1 As Object

List1.Attach GetDlgItem("List1") : List1.SetFontSize 12
List1.SetWindowSize 152, 136
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14
Picture1.Attach GetDlgItem("Picture1")

Var Shared mhDC As Long
Var Shared phDC As Long

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

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

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var lFormat As Long
    Var sFormat As String * 256
    Var i As Integer
    Var Ret As Long

    List1.ResetContent
    Picture1.Cls
   
    Ret = Api_OpenClipboard(GethWnd)
   
    Do
        i = i + 1
        lFormat = Api_EnumClipboardFormats(lFormat)
        If lFormat = 0 Then Exit Do
      
        Select Case lFormat
            Case CF_TEXT
                sFormat = "Text" & Chr$(0)
            Case CF_BITMAP
                sFormat = "Bitmap" & Chr$(0)
            Case CF_METAFILEPICT
                sFormat = "CF_METAFILEPICT" & Chr$(0)
            Case CF_SYLK
                sFormat = "CF_SYLK" & Chr$(0)
            Case CF_DIF
                sFormat = "CF_DIF" & Chr$(0)
            Case CF_TIFF
                sFormat = "CF_TIFF" & Chr$(0)
            Case CF_OEMTEXT
                sFormat = "CF_OEMTEXT" & Chr$(0)
            Case CF_DIB
                sFormat = "CF_DIB" & Chr$(0)
            Case CF_PALETTE
                sFormat = "CF_PALETTE" & Chr$(0)
            Case CF_PENDATA
                sFormat = "CF_PENDATA" & Chr$(0)
            Case CF_RIFF
                sFormat = "CF_RIFF" & Chr$(0)
            Case CF_WAVE
                sFormat = "CF_WAVE" & Chr$(0)
            Case CF_UNICODETEXT
                sFormat = "CF_UNICODETEXT" & Chr$(0)
            Case CF_ENHMETAFILE
                sFormat = "CF_ENHMETAFILE" & Chr$(0)
            Case CF_HDROP
                sFormat = "CF_HDROP" & Chr$(0)
            Case CF_LOCALE
                sFormat = "CF_LOCALE" & Chr$(0)
            Case CF_DIBV5
                sFormat = "CF_DIBV5" & Chr$(0)
            Case Else
                If Api_GetClipboardFormatName(lFormat, sFormat, Len(sFormat)) = 0 Then
                    sFormat = "不明" & Chr$(0)
                End If
        End Select
      
        List1.AddString Left$(sFormat, InStr(1, sFormat, Chr$(0)) - 1) & " (" & Trim$(Str$(lFormat)) & ")"
    Loop
   
    Ret = Api_CloseClipboard
End Sub

'================================================================
'=
'================================================================
Declare Sub List1_Click edecl ()
Sub List1_Click()
    Var bmp As BITMAP
    Var hBit As Long
    Var hBitmap As Long
    Var TmpStr As String
    Var TmpStr2 As String
    Var StrLen As Long
    Var hTmpStr As Long
    Var pTmpStr As Long
    Var Ret As Long

    TmpStr2 = List1.GetText(List1.GetCursel)

    Select Case Left$(TmpStr2, InStr(TmpStr2, "(") - 2)
        Case "Text"
            Ret = Api_OpenClipboard(GethWnd)
            hTmpStr = Api_GetClipboardData(CF_TEXT)
            pTmpStr = Api_GlobalLock(hTmpStr)
      
            TmpStr = Space$(Api_lstrLen(ByVal pTmpStr))
            Ret = Api_lstrcpy(TmpStr, ByVal pTmpStr)
            Ret = Api_GlobalUnlock(hTmpStr)
      
            Picture1.Cls
            Picture1.SetFontName "ＭＳ ゴシック"
            Picture1.SetFontSize 12
            Picture1.Print TmpStr

        Case "Bitmap"
            Ret = Api_OpenClipboard(GethWnd)

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

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

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

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

        Case Else
            Picture1.Cls
            Picture1.SetFontSize 12
            Picture1.Print "表示できません！"
    End Select

    Ret = Api_CloseClipboard
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