設(shè)為首頁收藏本站Access中國

Office中國論壇/Access中國論壇

 找回密碼
 注冊

QQ登錄

只需一步，快速開始

返回列表 發(fā)新帖
查看: 58742|回復(fù): 138
打印 上一主題 下一主題

[模塊/函數(shù)] 用代碼插入圖片到OLE對象的2種方法

[復(fù)制鏈接]

點擊這里給我發(fā)消息
跳轉(zhuǎn)到指定樓層
1#
發(fā)表于 2013-7-26 17:42:59 | 只看該作者 回帖獎勵 |倒序瀏覽 |閱讀模式
Access中的Ole對象總感覺是個神秘的東西，功能好象很強大，既可以顯示圖片，還可顯示W(wǎng)ord文檔、Excel表格等，但對它的控制卻不象其它對象那么容易，聯(lián)機幫助中講的不多，僅有的一點幫助看得也是一頭霧水。
拿Ole字段儲存圖片來說，通過菜單操作在Ole字段中插入圖片后，在表中會以文字顯示，可能是“圖片”，又可能是“位圖圖像”，還可能是“包”，綁定到窗體的Ole對象框后，有的顯示圖片，有的是顯示一個圖標(biāo)加上文件名�？傊鞣N情況，有點讓人望而卻步，玩不起不玩總可以吧~

不過有時候我們還不得不用它，比如要在連續(xù)窗體每一行顯示一個圖片時，就可以用ole字段來顯示圖片了。紅塵如煙大俠大家都知道吧，他做的通用平臺里的圖標(biāo)編輯窗口就是這樣的。

那么怎樣在ole字段中插入圖片文件，綁定到窗體時能顯示為圖片？有下面兩個方法：
1、象上面說的用Access自身提供的插入對象操作，插入圖片文件，但只有位圖文件能顯示圖片。
2、把圖片插入到Access的圖片框中，再復(fù)制圖片框粘貼到ole對象框，或者把圖片插入到Word中，再把Word中的圖片復(fù)制粘貼到ole對象框。這種方法可以顯示大部分格式的圖片，jpg、gif、png、ico等都可以，并且還可以保持透明哦~

這些大家可能都懂了，我只是總結(jié)一下，呵呵...

但是，昨天嶺南王子給我下任務(wù)了，說要用純代碼插入圖片到ole對象框...王子的命令不得不執(zhí)行啊...
不過王子的要求很合理，封裝好的程序給別人使用，要添加圖片，總不能讓人打開Word把圖片拷來拷去吧，顯示得太不專業(yè)了。

今天把上面說的兩種手工插入圖片的方法用代碼實現(xiàn)了，把關(guān)鍵的第二種貼上來，做得匆忙請大家指正：
模塊中：
  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，根據(jù)其類型轉(zhuǎn)為相應(yīng)格式放到剪貼板，最后粘貼到Ole對象框。
  39. ' 這個方法相當(dāng)于在設(shè)計視圖中插入一幅圖片到圖片框，然后復(fù)制該圖片框，再在窗體視圖中粘貼到Ole對象框。
  40. ' 這種方法支持更多的格式，只要能加載到圖片框的圖片都可以插入到Ole對象框中并顯示。
  41. ' 但透明的png圖片會有鋸齒，這沒辦法。因為Ole對象框只能顯示位圖和圖元文件，增強型圖元文件粘貼到Ole對象框中會轉(zhuǎn)為圖元文件。
  42. ' 另外，圖片框能加載的圖片格式及效果和電腦上安裝的圖形篩選器版本有關(guān)。
  43. ' 注意：對于2007或以上版本，須要在Access選項中將圖片屬性儲存格式設(shè)置為：將所有圖片數(shù)據(jù)轉(zhuǎn)換成位圖。否則使用此方法不成功。
  44. ' 也可用LoadPicture直接創(chuàng)建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                                           ' 把圖片框的數(shù)據(jù)放到數(shù)組備用

  61.         Select Case bytArray(0)                                                   ' 圖片框中的圖片有位圖、圖元文件、增強圖元文件3種類型
  62.         Case 40  '位圖(DIB)
  63.             hGlobal = GlobalAlloc(GMEM_MOVEABLE, UBound(bytArray) + 1)            ' 創(chuàng)建緩沖區(qū)，用于存放DIB數(shù)據(jù)
  64.             lHandle = GlobalLock(hGlobal)                                         ' 獲取緩沖區(qū)讀寫指針，這個指針就是DIB的句柄了
  65.             CopyMemory ByVal lHandle, bytArray(0), UBound(bytArray) + 1           ' 復(fù)制字節(jié)數(shù)組內(nèi)容(DIB數(shù)據(jù))到緩沖區(qū)
  66.             GlobalUnlock hGlobal                                                  ' 解鎖后才能使用
  67.             lRet = SetClipboardData(CF_DIB, lHandle)                              ' 把DIB放入剪貼板
  68.             GlobalFree hGlobal                                                    ' 釋放分配的緩沖區(qū)空間，也可以不釋放，系統(tǒng)會自己處理
  69.             
  70.         Case 3   '圖元文件
  71. '            lHandle = SetMetaFileBitsEx(UBound(bytArray) + 1 - 24, bytArray(24))               ' 創(chuàng)建圖元文件
  72. '            lRet = SetClipboardData(CF_METAFILEPICT, lHandle)                                  ' 把圖元文件放入剪貼板，不成功，不知何故！

  74.             '上面的代碼把圖元文件放入剪貼板不成功，轉(zhuǎn)成增強型圖元文件就可以了
  75.             CopyMemory tMf, bytArray(8), Len(tMf)
  76.             lHandle = SetWinMetaFileBits(UBound(bytArray) + 24 + 1 - 8, bytArray(24), 0&, tMf)   ' 從圖元文件數(shù)據(jù)創(chuàng)建增強型圖元文件
  77.             lRet = SetClipboardData(CF_ENHMETAFILE, lHandle)                                     ' 把增強型圖元文件放入剪貼板

  79.         Case 14  '增強圖元文件
  80.             lHandle = SetEnhMetaFileBits(UBound(bytArray) + 1 - 8, bytArray(8))                  ' 創(chuàng)建增強型圖元文件
  81.             lRet = SetClipboardData(CF_ENHMETAFILE, lHandle)                                     ' 把增強型圖元文件放入剪貼板
  82.         Case Else
  83.         End Select
  84.         
  85.         Call CloseClipboard                                                       ' 必須關(guān)閉剪貼板才能復(fù)制
  86.         
  87.         If lRet Then
  88.             objFrame.SetFocus                                                     ' 把焦點移到Ole對象框
  89.             DoCmd.RunCommand acCmdPaste                                           ' 把上面放到剪貼板中的東東粘貼到Ole對象框中
  90.             Call OpenClipboard(0)                                                 ' 重新打開剪貼板以清空內(nèi)容。也可以保留
  91.             Call EmptyClipboard                                                   ' 清空剪貼板
  92.             Call CloseClipboard                                                   ' 剪貼板用完要關(guān)閉，不然之后程序不能正常復(fù)制
  93.             ImageToObjFrame = True
  94.         End If

  96.     End If
  97. ErrHandle:
  98.    
  99. End Function
復(fù)制代碼
窗體中：
  1. '----------------------------------------------------------------------------------------------------------------------------------
  2. ' 代碼插入圖片到Ole對象框之剪貼板法
  3. ' 原理：請看模塊中的ImageToObjFrame函數(shù)
  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
復(fù)制代碼
示例mdb是少不了的：
游客，如果您要查看本帖隱藏內(nèi)容請回復(fù)




本帖子中包含更多資源

您需要 登錄 才可以下載或查看，沒有帳號？注冊

x

評分

參與人數(shù) 1經(jīng)驗 +10 收起 理由
魚兒游游 + 10 很給力!

查看全部評分

本帖被以下淘專輯推薦:

分享到:  QQ好友和群QQ好友和群 QQ空間QQ空間 騰訊微博騰訊微博 騰訊朋友騰訊朋友
收藏收藏4 分享分享 分享淘帖1 訂閱訂閱

點擊這里給我發(fā)消息
2#
 樓主| 發(fā)表于 2013-7-26 17:47:22 | 只看該作者
坐個沙發(fā)
有圖有真相，兩種方法效果對比

本帖子中包含更多資源

您需要 登錄 才可以下載或查看，沒有帳號？注冊

x

點擊這里給我發(fā)消息
3#
發(fā)表于 2013-7-26 17:58:53 | 只看該作者
謝謝分享!
回復(fù)

使用道具 舉報

點擊這里給我發(fā)消息
4#
發(fā)表于 2013-7-26 18:06:03 | 只看該作者
好東西，板凳一個。
5#
發(fā)表于 2013-7-26 18:23:22 | 只看該作者
謝謝分享!
回復(fù)

使用道具 舉報

點擊這里給我發(fā)消息
6#
發(fā)表于 2013-7-26 22:34:46 | 只看該作者
精彩, 謝謝小寶分享!

點擊這里給我發(fā)消息
7#
發(fā)表于 2013-7-26 22:35:01 | 只看該作者
轉(zhuǎn)播一下
回復(fù)

使用道具 舉報

點擊這里給我發(fā)消息
8#
發(fā)表于 2013-7-27 05:52:32 | 只看該作者
頂一個，呵呵
9#
發(fā)表于 2013-7-29 16:16:10 | 只看該作者
收藏了，謝分享
10#
發(fā)表于 2013-8-26 10:39:07 | 只看該作者
學(xué)習(xí)
回復(fù)

使用道具 舉報

您需要登錄后才可以回帖 登錄 | 注冊

本版積分規(guī)則

QQ|站長郵箱|小黑屋|手機版|Office中國/Access中國 ( 粵ICP備10043721號-1 )  

GMT+8, 2025-7-13 05:28 , Processed in 0.129798 second(s), 37 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回復(fù) 返回頂部 返回列表