直接粘贴剪贴版的位图数据到Image控件

调用范例：

Private Sub Command1_Click()
    PasteToImage Me.Image0
End Sub

模块段代码：

Option Compare Database
Option Explicit

Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
   (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

Public Const CF_TEXT = 1
Public Const CF_BITMAP = 2
Public Const CF_METAFILEPICT = 3
Public Const CF_DIB = 8
Public Const CF_ENHMETAFILE = 14

Public Sub PasteToImage(ByRef imgDest As Image)
    Dim hBMP As Long
    Dim arrData() As Byte
    Dim biClrUsed As Long, biSizeImage As Long
    
    OpenClipboard Application.hWndAccessApp
    hBMP = GetClipboardData(CF_DIB)
    CloseClipboard
    
    If hBMP <> 0 Then
        ReDim arrData(39)
        CopyMemory ByVal VarPtr(arrData(0)), ByVal hBMP, 40
        
        biClrUsed = ReadBytes(arrData, 32, 2)
        biSizeImage = ReadBytes(arrData, 20, 4)
        
        ReDim arrData(39 + biClrUsed * 8 + biSizeImage)
        
        CopyMemory ByVal VarPtr(arrData(0)), ByVal hBMP, 40 + biClrUsed * 8 + biSizeImage
        
        imgDest.PictureData = arrData
    End If
End Sub

'以下均为二进制数据读取函数
Public Function Byt2Lng(ByRef arrData() As Byte, ByVal p As Long) As Long
    CopyMemory VarPtr(Byt2Lng), VarPtr(arrData(p)), 4
End Function

Public Function Byt2Int(ByRef arrData() As Byte, ByVal p As Long) As Integer
    CopyMemory VarPtr(Byt2Int), VarPtr(arrData(p)), 2
End Function

Public Function ReadBytes(arrData() As Byte, p As Long, t As Integer) As Long
    If t >= 1 And t <= 4 Then CopyMemory VarPtr(ReadBytes), VarPtr(arrData(p)), t
End Function

Public Sub WriteBytes(ByRef arrData() As Byte, p As Long, Value As Long, t As Integer)
    If t >= 1 And t <= 4 Then CopyMemory VarPtr(arrData(p)), VarPtr(Value), t
End Sub