少妇熟女高潮流白浆,吃奶摸下娇喘好爽免费视频

' 示例: 演示代碼插入圖片到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直接創(chuàng)建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) ' 創(chuàng)建緩沖區(qū)，用于存放DIB數據
lHandle = GlobalLock(hGlobal) ' 獲取緩沖區(qū)讀寫指針，這個指針就是DIB的句柄了
CopyMemory ByVal lHandle, bytArray(0), UBound(bytArray) + 1 ' 復制字節(jié)數組內容(DIB數據)到緩沖區(qū)
GlobalUnlock hGlobal ' 解鎖后才能使用
lRet = SetClipboardData(CF_DIB, lHandle) ' 把DIB放入剪貼板
GlobalFree hGlobal ' 釋放分配的緩沖區(qū)空間，也可以不釋放，系統(tǒng)會自己處理
Case 3 '圖元文件
' lHandle = SetMetaFileBitsEx(UBound(bytArray) + 1 - 24, bytArray(24)) ' 創(chuàng)建圖元文件
' lRet = SetClipboardData(CF_METAFILEPICT, lHandle) ' 把圖元文件放入剪貼板，不成功，不知何故！
'上面的代碼把圖元文件放入剪貼板不成功，轉成增強型圖元文件就可以了
CopyMemory tMf, bytArray(8), Len(tMf)
lHandle = SetWinMetaFileBits(UBound(bytArray) + 24 + 1 - 8, bytArray(24), 0&, tMf) ' 從圖元文件數據創(chuàng)建增強型圖元文件
lRet = SetClipboardData(CF_ENHMETAFILE, lHandle) ' 把增強型圖元文件放入剪貼板
Case 14 '增強圖元文件
lHandle = SetEnhMetaFileBits(UBound(bytArray) + 1 - 8, bytArray(8)) ' 創(chuàng)建增強型圖元文件
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

復制代碼

Office中國論壇/Access中國論壇