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

调用范例：

Private Sub Command1_Click()
    PasteToImage Me.Image0
End Sub

Option Compare Database
Option Explicit

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 a() As Byte, ByVal p As Long) As Long
    If a(p + 3) <= 127 Then
        Byt2Lng = ((CLng(a(p + 3)) * 256 + a(p + 2)) * 256 + a(p + 1)) * 256 + a(p)
    Else
        Byt2Lng = -1 - (((CLng(Not a(p + 3)) * 256 + (Not a(p + 2))) * 256 + (Not a(p + 1))) * 256 + (Not a(p)))
    End If
End Function

Public Function Byt2Int(ByRef a() As Byte, ByVal p As Long) As Integer
    If a(p + 1) <= 127 Then
        Byt2Int = CInt(a(p + 1)) * 256 + a(p)
    Else
        Byt2Int = CInt(Not a(p + 1)) * 256 + (Not a(p)) + 1
    End If
End Function

Public Function ReadBytes(a() As Byte, p As Long, t As Integer) As Long
    If t = 1 Then
        ReadBytes = a(p)
    ElseIf t = 2 Then
        ReadBytes = Byt2Int(a, p)
    ElseIf t = 4 Then
        ReadBytes = Byt2Lng(a, p)
    End If
End Function