设为首页收藏本站Access中国
开启辅助访问 切换到宽版

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步，快速开始

Office中国论坛/Access中国论坛»论坛首页 › Access 资料区 › Access源码 › 用代码插入图片到OLE对象的2种方法
12345678910... 14下一页
返回列表 发新帖
查看: 54993|回复: 137
打印 上一主题 下一主题

[模块/函数] 用代码插入图片到OLE对象的2种方法

[复制链接]
t小宝

点击这里给我发消息
跳转到指定楼层
1#
发表于 2013-7-26 17:42:59 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
Access中的Ole对象总感觉是个神秘的东西，功能好象很强大，既可以显示图片，还可显示Word文档、Excel表格等，但对它的控制却不象其它对象那么容易，联机帮助中讲的不多，仅有的一点帮助看得也是一头雾水。
拿Ole字段储存图片来说，通过菜单操作在Ole字段中插入图片后，在表中会以文字显示，可能是“图片”，又可能是“位图图像”，还可能是“包”，绑定到窗体的Ole对象框后，有的显示图片，有的是显示一个图标加上文件名。总之各种情况，有点让人望而却步，玩不起不玩总可以吧~

不过有时候我们还不得不用它，比如要在连续窗体每一行显示一个图片时，就可以用ole字段来显示图片了。红尘如烟大侠大家都知道吧，他做的通用平台里的图标编辑窗口就是这样的。

那么怎样在ole字段中插入图片文件，绑定到窗体时能显示为图片？有下面两个方法：
1、象上面说的用Access自身提供的插入对象操作，插入图片文件，但只有位图文件能显示图片。
2、把图片插入到Access的图片框中，再复制图片框粘贴到ole对象框，或者把图片插入到Word中，再把Word中的图片复制粘贴到ole对象框。这种方法可以显示大部分格式的图片，jpg、gif、png、ico等都可以，并且还可以保持透明哦~

这些大家可能都懂了，我只是总结一下，呵呵...

但是，昨天岭南王子给我下任务了，说要用纯代码插入图片到ole对象框...王子的命令不得不执行啊...
不过王子的要求很合理，封装好的程序给别人使用，要添加图片，总不能让人打开Word把图片拷来拷去吧，显示得太不专业了。

今天把上面说的两种手工插入图片的方法用代码实现了，把关键的第二种贴上来，做得匆忙请大家指正：
模块中：
  1. ' 示  例: 演示代码插入图片到Ole对象框的2种方法
  2. ' 作  者: t小宝(QQ:377922812)
  3. ' 日  期: 2013-07-26

  5. Private Type METAFILEPICT
  6.         mm As Long
  7.         hMF As Long
  8.         yExt As Long
  9.         xExt As Long
  10. End Type

  12. Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

  14. Private Declare Function SetEnhMetaFileBits Lib "gdi32" (ByVal cbBuffer As Long, lpData As Byte) As Long
  15. Private Declare Function SetMetaFileBitsEx Lib "gdi32" (ByVal nSize As Long, lpData As Byte) As Long
  16. Private Declare Function SetWinMetaFileBits Lib "gdi32" (ByVal cbBuffer As Long, lpbBuffer As Byte, ByVal hdcRef As Long, lpmfp As METAFILEPICT) As Long

  18. Private Declare Function GlobalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
  19. Private Declare Function GlobalLock Lib "kernel32.dll" (ByVal hMem As Long) As Long
  20. Private Declare Function GlobalSize Lib "kernel32.dll" (ByVal hMem As Long) As Long
  21. Private Declare Function GlobalUnlock Lib "kernel32.dll" (ByVal hMem As Long) As Long
  22. Private Declare Function GlobalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long

  24. Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
  25. Private Declare Function CloseClipboard Lib "user32" () As Long
  26. Private Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
  27. Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
  28. Private Declare Function EmptyClipboard Lib "user32" () As Long

  30. Private Const CF_BITMAP = 2
  31. Private Const CF_DIB = 8
  32. Private Const CF_METAFILEPICT = 3
  33. Private Const CF_ENHMETAFILE = 14
  34. Private Const GMEM_MOVEABLE = &H2

  36. '----------------------------------------------------------------------------------------------------------------------------------
  37. ' 代码插入图片到Ole对象框之剪贴板法
  38. ' 原理：先加载图片到图片框，获取图片框的PictureData，根据其类型转为相应格式放到剪贴板，最后粘贴到Ole对象框。
  39. ' 这个方法相当于在设计视图中插入一幅图片到图片框，然后复制该图片框，再在窗体视图中粘贴到Ole对象框。
  40. ' 这种方法支持更多的格式，只要能加载到图片框的图片都可以插入到Ole对象框中并显示。
  41. ' 但透明的png图片会有锯齿，这没办法。因为Ole对象框只能显示位图和图元文件，增强型图元文件粘贴到Ole对象框中会转为图元文件。
  42. ' 另外，图片框能加载的图片格式及效果和电脑上安装的图形筛选器版本有关。
  43. ' 注意：对于2007或以上版本，须要在Access选项中将图片属性储存格式设置为：将所有图片数据转换成位图。否则使用此方法不成功。
  44. ' 也可用LoadPicture直接创建StdPicture对象来获取图像的句柄并处理，但不支持png图片，且gif图片也会丢失透明部分，非透明图片可用。
  45. '----------------------------------------------------------------------------------------------------------------------------------
  46. Public Function ImageToObjFrame(imgBox As Image, objFrame As BoundObjectFrame) As Boolean
  47. On Error GoTo ErrHandle

  49.     Dim bytArray() As Byte
  50.     Dim tMf As METAFILEPICT
  51.     Dim hGlobal As Long
  52.     Dim lHandle As Long
  53.     Dim lRet As Long

  55.     If IsNull(imgBox.PictureData) Then Exit Function

  57.     If OpenClipboard(0) Then                                                      ' 使用剪贴板前先打开
  58.         Call EmptyClipboard                                                       ' 为了不出意外清空剪贴板给自己用
  59.         bytArray() = imgBox.PictureData                                           ' 把图片框的数据放到数组备用

  61.         Select Case bytArray(0)                                                   ' 图片框中的图片有位图、图元文件、增强图元文件3种类型
  62.         Case 40  '位图(DIB)
  63.             hGlobal = GlobalAlloc(GMEM_MOVEABLE, UBound(bytArray) + 1)            ' 创建缓冲区，用于存放DIB数据
  64.             lHandle = GlobalLock(hGlobal)                                         ' 获取缓冲区读写指针，这个指针就是DIB的句柄了
  65.             CopyMemory ByVal lHandle, bytArray(0), UBound(bytArray) + 1           ' 复制字节数组内容(DIB数据)到缓冲区
  66.             GlobalUnlock hGlobal                                                  ' 解锁后才能使用
  67.             lRet = SetClipboardData(CF_DIB, lHandle)                              ' 把DIB放入剪贴板
  68.             GlobalFree hGlobal                                                    ' 释放分配的缓冲区空间，也可以不释放，系统会自己处理
  69.             
  70.         Case 3   '图元文件
  71. '            lHandle = SetMetaFileBitsEx(UBound(bytArray) + 1 - 24, bytArray(24))               ' 创建图元文件
  72. '            lRet = SetClipboardData(CF_METAFILEPICT, lHandle)                                  ' 把图元文件放入剪贴板，不成功，不知何故！

  74.             '上面的代码把图元文件放入剪贴板不成功，转成增强型图元文件就可以了
  75.             CopyMemory tMf, bytArray(8), Len(tMf)
  76.             lHandle = SetWinMetaFileBits(UBound(bytArray) + 24 + 1 - 8, bytArray(24), 0&, tMf)   ' 从图元文件数据创建增强型图元文件
  77.             lRet = SetClipboardData(CF_ENHMETAFILE, lHandle)                                     ' 把增强型图元文件放入剪贴板

  79.         Case 14  '增强图元文件
  80.             lHandle = SetEnhMetaFileBits(UBound(bytArray) + 1 - 8, bytArray(8))                  ' 创建增强型图元文件
  81.             lRet = SetClipboardData(CF_ENHMETAFILE, lHandle)                                     ' 把增强型图元文件放入剪贴板
  82.         Case Else
  83.         End Select
  84.         
  85.         Call CloseClipboard                                                       ' 必须关闭剪贴板才能复制
  86.         
  87.         If lRet Then
  88.             objFrame.SetFocus                                                     ' 把焦点移到Ole对象框
  89.             DoCmd.RunCommand acCmdPaste                                           ' 把上面放到剪贴板中的东东粘贴到Ole对象框中
  90.             Call OpenClipboard(0)                                                 ' 重新打开剪贴板以清空内容。也可以保留
  91.             Call EmptyClipboard                                                   ' 清空剪贴板
  92.             Call CloseClipboard                                                   ' 剪贴板用完要关闭，不然之后程序不能正常复制
  93.             ImageToObjFrame = True
  94.         End If

  96.     End If
  97. ErrHandle:
  98.    
  99. End Function
复制代码
窗体中：
  1. '----------------------------------------------------------------------------------------------------------------------------------
  2. ' 代码插入图片到Ole对象框之剪贴板法
  3. ' 原理：请看模块中的ImageToObjFrame函数
  4. '----------------------------------------------------------------------------------------------------------------------------------
  5. Private Sub Command2_Click()

  7.     Dim sFileName As String
  8.     Dim bytArray() As Byte
  9.     Dim tMf As METAFILEPICT
  10.     Dim hGlobal As Long
  11.     Dim lHandle As Long
  12.     Dim lRet As Long

  14.     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)")
  15.     If Len(sFileName) = 0 Then Exit Sub

  17.     Me.Image0.Picture = sFileName
  18.    
  19.     If ImageToObjFrame(Me.Image0, Me.FPicture2) Then
  20.         Me.FName = Mid(sFileName, InStrRev(sFileName, "") + 1)
  21.     End If
  22.    
  23.     Me.Image0.Picture = ""
  24.    
  25. End Sub
复制代码
示例mdb是少不了的：
游客，如果您要查看本帖隐藏内容请回复




本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有帐号？注册

x

评分

参与人数 1经验 +10 收起 理由
鱼儿游游 + 10 很给力!

查看全部评分

本帖被以下淘专辑推荐:

分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏4 分享分享 分享淘帖1 订阅订阅
回复

使用道具 举报

t小宝

点击这里给我发消息
2#
 楼主| 发表于 2013-7-26 17:47:22 | 只看该作者
坐个沙发
有图有真相，两种方法效果对比

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有帐号？注册

x
回复 支持 反对

使用道具 举报

岭南王子

点击这里给我发消息
3#
发表于 2013-7-26 17:58:53 | 只看该作者
谢谢分享!
回复

使用道具 举报

smileyoufu

点击这里给我发消息
4#
发表于 2013-7-26 18:06:03 | 只看该作者
好东西，板凳一个。
回复 支持 反对

使用道具 举报

xie62
5#
发表于 2013-7-26 18:23:22 | 只看该作者
谢谢分享!
回复

使用道具 举报

tmtony

点击这里给我发消息
6#
发表于 2013-7-26 22:34:46 | 只看该作者
精彩, 谢谢小宝分享!
回复 支持 反对

使用道具 举报

tmtony

点击这里给我发消息
7#
发表于 2013-7-26 22:35:01 | 只看该作者
转播一下
回复

使用道具 举报

zhuyiwen

点击这里给我发消息
8#
发表于 2013-7-27 05:52:32 | 只看该作者
顶一个，呵呵
回复 支持 反对

使用道具 举报

asklove
9#
发表于 2013-7-29 16:16:10 | 只看该作者
收藏了，谢分享
回复 支持 反对

使用道具 举报

kangking
10#
发表于 2013-8-26 10:39:07 | 只看该作者
学习
回复

使用道具 举报

下一页 »
12345678910... 14下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2024-11-29 04:47 , Processed in 0.314900 second(s), 38 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表