图形/图像
用代码插入图片到OLE对象的2种方法
2014-12-19 16:03:34
Access中的Ole对象总感觉是个神秘的东西，功能好象很强大，既可以显示图片，还可显示Word文档、Excel表格等，但对它的控制却不象其它对象那么容易，联机帮助中讲的不多，仅有的一点帮助看得也是一头雾水。
拿Ole字段储存图片来说，通过菜单操作在Ole字段中插入图片后，在表中会以文字显示，可能是“图片”，又可能是“位图图像”，还可能是“包”，绑定到窗体的Ole对象框后，有的显示图片，有的是显示一个图标加上文件名。总之各种情况，有点让人望而却步，玩不起不玩总可以吧~
不过有时候我们还不得不用它，比如要在连续窗体每一行显示一个图片时，就可以用ole字段来显示图片了。红尘如烟大侠大家都知道吧，他做的通用平台里的图标编辑窗口就是这样的。
那么怎样在ole字段中插入图片文件，绑定到窗体时能显示为图片？有下面两个方法：
1、象上面说的用Access自身提供的插入对象操作，插入图片文件，但只有位图文件能显示图片。
2、把图片插入到Access的图片框中，再复制图片框粘贴到ole对象框，或者把图片插入到Word中，再把Word中的图片复制粘贴到ole对象框。这种方法可以显示大部分格式的图片，jpg、gif、png、ico等都可以，并且还可以保持透明哦~
这些大家可能都懂了，我只是总结一下，呵呵...
但是，昨天岭南王子给我下任务了，说要用纯代码插入图片到ole对象框...王子的命令不得不执行啊...
不过王子的要求很合理，封装好的程序给别人使用，要添加图片，总不能让人打开Word把图片拷来拷去吧，显示得太不专业了。
今天把上面说的两种手工插入图片的方法用代码实现了，把关键的第二种贴上来，做得匆忙请大家指正：
模块中：
' 示 例: 演示代码插入图片到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
窗体中：
'----------------------------------------------------------------------------------------------------------------------------------
' 代码插入图片到Ole对象框之剪贴板法
' 原理：请看模块中的ImageToObjFrame函数
'----------------------------------------------------------------------------------------------------------------------------------
Private Sub Command2_Click()
Dim sFileName As String
Dim bytArray() As Byte
Dim tMf As METAFILEPICT
Dim hGlobal As Long
Dim lHandle As Long
Dim lRet As Long
sFileName = GetFileName(1, , "图片文件(*.bmp;*.jpg;*.gif;*.ico;*.tif;*.png;*.wmf;*.emf)BMP格式(*.bmp)JPG格式(*.jpg)GIF格式(*.gif)ICO格式(*.ico)TIFF格式(*.tif)PNG格式(*.png)WMF格式(*.wmf)EMF格式(*.emf)")
If Len(sFileName) = 0 Then Exit Sub
Me.Image0.Picture = sFileName
If ImageToObjFrame(Me.Image0, Me.FPicture2) Then
Me.FName = Mid(sFileName, InStrRev(sFileName, "\") + 1)
End If
Me.Image0.Picture = ""
End Sub