直接粘贴剪贴版的位图数据到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

[1] [2] 下一页

复制本页网址和标题，发送给你QQ/Msn的好友一起分享

上一篇:SqlServer的更新锁(UPDLOCK)

下一篇:总结：SQL Server日志清除的两种方法