用代码插入图片到OLE对象的2种方法 - Office中国论坛/Access中国论坛

' 示例: 演示代码插入图片到Ole对象框的2种方法
' 作者: t小宝(QQ:377922812)
' 日期: 2013-07-26
Private Type METAFILEPICT
mm As Long
hMF As Long
yExt As Long
xExt As Long
End Type
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function SetEnhMetaFileBits Lib "gdi32" (ByVal cbBuffer As Long, lpData As Byte) As Long
Private Declare Function SetMetaFileBitsEx Lib "gdi32" (ByVal nSize As Long, lpData As Byte) As Long
Private Declare Function SetWinMetaFileBits Lib "gdi32" (ByVal cbBuffer As Long, lpbBuffer As Byte, ByVal hdcRef As Long, lpmfp As METAFILEPICT) As Long
Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalSize Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Const CF_BITMAP = 2
Private Const CF_DIB = 8
Private Const CF_METAFILEPICT = 3
Private Const CF_ENHMETAFILE = 14
Private Const GMEM_MOVEABLE = &H2
'----------------------------------------------------------------------------------------------------------------------------------
' 代码插入图片到Ole对象框之剪贴板法
' 原理：先加载图片到图片框，获取图片框的PictureData，根据其类型转为相应格式放到剪贴板，最后粘贴到Ole对象框。
' 这个方法相当于在设计视图中插入一幅图片到图片框，然后复制该图片框，再在窗体视图中粘贴到Ole对象框。
' 这种方法支持更多的格式，只要能加载到图片框的图片都可以插入到Ole对象框中并显示。
' 但透明的png图片会有锯齿，这没办法。因为Ole对象框只能显示位图和图元文件，增强型图元文件粘贴到Ole对象框中会转为图元文件。
' 另外，图片框能加载的图片格式及效果和电脑上安装的图形筛选器版本有关。
' 注意：对于2007或以上版本，须要在Access选项中将图片属性储存格式设置为：将所有图片数据转换成位图。否则使用此方法不成功。
' 也可用LoadPicture直接创建StdPicture对象来获取图像的句柄并处理，但不支持png图片，且gif图片也会丢失透明部分，非透明图片可用。
'----------------------------------------------------------------------------------------------------------------------------------
Public Function ImageToObjFrame(imgBox As Image, objFrame As BoundObjectFrame) As Boolean
On Error GoTo ErrHandle
Dim bytArray() As Byte
Dim tMf As METAFILEPICT
Dim hGlobal As Long
Dim lHandle As Long
Dim lRet As Long
If IsNull(imgBox.PictureData) Then Exit Function
If OpenClipboard(0) Then ' 使用剪贴板前先打开
Call EmptyClipboard ' 为了不出意外清空剪贴板给自己用
bytArray() = imgBox.PictureData ' 把图片框的数据放到数组备用
Select Case bytArray(0) ' 图片框中的图片有位图、图元文件、增强图元文件3种类型
Case 40 '位图(DIB)
hGlobal = GlobalAlloc(GMEM_MOVEABLE, UBound(bytArray) + 1) ' 创建缓冲区，用于存放DIB数据
lHandle = GlobalLock(hGlobal) ' 获取缓冲区读写指针，这个指针就是DIB的句柄了
CopyMemory ByVal lHandle, bytArray(0), UBound(bytArray) + 1 ' 复制字节数组内容(DIB数据)到缓冲区
GlobalUnlock hGlobal ' 解锁后才能使用
lRet = SetClipboardData(CF_DIB, lHandle) ' 把DIB放入剪贴板
GlobalFree hGlobal ' 释放分配的缓冲区空间，也可以不释放，系统会自己处理
Case 3 '图元文件
' lHandle = SetMetaFileBitsEx(UBound(bytArray) + 1 - 24, bytArray(24)) ' 创建图元文件
' lRet = SetClipboardData(CF_METAFILEPICT, lHandle) ' 把图元文件放入剪贴板，不成功，不知何故！
'上面的代码把图元文件放入剪贴板不成功，转成增强型图元文件就可以了
CopyMemory tMf, bytArray(8), Len(tMf)
lHandle = SetWinMetaFileBits(UBound(bytArray) + 24 + 1 - 8, bytArray(24), 0&, tMf) ' 从图元文件数据创建增强型图元文件
lRet = SetClipboardData(CF_ENHMETAFILE, lHandle) ' 把增强型图元文件放入剪贴板
Case 14 '增强图元文件
lHandle = SetEnhMetaFileBits(UBound(bytArray) + 1 - 8, bytArray(8)) ' 创建增强型图元文件
lRet = SetClipboardData(CF_ENHMETAFILE, lHandle) ' 把增强型图元文件放入剪贴板
Case Else
End Select
Call CloseClipboard ' 必须关闭剪贴板才能复制
If lRet Then
objFrame.SetFocus ' 把焦点移到Ole对象框
DoCmd.RunCommand acCmdPaste ' 把上面放到剪贴板中的东东粘贴到Ole对象框中
Call OpenClipboard(0) ' 重新打开剪贴板以清空内容。也可以保留
Call EmptyClipboard ' 清空剪贴板
Call CloseClipboard ' 剪贴板用完要关闭，不然之后程序不能正常复制
ImageToObjFrame = True
End If
End If
ErrHandle:
End Function

复制代码