Form2.Image 控件显示ADO 读取的二进制图片

Option Explicit

'调用方法 set Image1.Picture=PictureFromByteStream(rstOra.Fields("zp").Value)

'参数 rstOra as adodb.recordset
'将下面的代码放到一个模块文件中

Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (pStream As Any, ByVal lSize As Long, ByVal fRunmode As Long, riid As Any, ppvObj As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As Any) As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Public Function PictureFromByteStream(b() As Byte) As IPicture
Dim hMem As Long
Dim lpMem As Long
Dim LowerBound As Long
Dim ByteCount As Long
Dim IID_IPicture(15)
Dim istm As stdole.IUnknown
LowerBound = LBound(b)
ByteCount = UBound(b) - LowerBound + 1
hMem = GlobalAlloc(&H2, ByteCount)
If hMem <> 0 Then
lpMem = GlobalLock(hMem)
If lpMem <> 0 Then
MoveMemory ByVal lpMem, b(LowerBound), ByteCount
GlobalUnlock hMem
If CreateStreamOnHGlobal(hMem, 1, istm) = 0 Then
If CLSIDFromString(StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), IID_IPicture(0)) = 0 Then
OleLoadPicture ByVal ObjPtr(istm), ByteCount, 0, IID_IPicture(0), PictureFromByteStream
End If
End If
End If
End If
End Function