从ACCESS中读出的长二进制数据（图片），怎样写入image空间

[king27]

我将图片以二进制形式，写入了数据库中。
现在我要读出它，用getChunk读出；
请问怎样才能直接让imsge控件接收它，
而不是先写成图片文件，再用loadpicture（）让image控件接收！

大虾们请指教！

[「已注销」]

怎么没有人啊？是不是必须要把它存为本地文件才行啊？

[flyingZFX]

直接读就行了。

[Abyss-Xu]

用=

[rainstormmaster]

//怎么没有人啊？是不是必须要把它存为本地文件才行啊？

不是

'利用IPersistStream接口和IStream接口实现的例子
'可以从http://www.mvps.org/emorcillo/vb6/tlb/tl_ole.zip下载文件，下载后解压，并注册、引用olelib.tlb

Option Explicit

Const GMEM_MOVEABLE = &H2
Const GMEM_ZEROINIT = &H40
Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem 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

Const PictureID = &H746C&

Private Type PictureHeader
Magic As Long
Size As Long
End Type


Public Sub Picture2Array(ByVal oObj As StdPicture, aBytes() As Byte)
Dim oIPS As IPersistStream
Dim oStream As IStream
Dim hGlobal As Long
Dim lPtr As Long
Dim lSize As Long
Dim Hdr As PictureHeader
Set oIPS = oObj
Set oStream = CreateStreamOnHGlobal(0, True)
oIPS.Save oStream, True
hGlobal = GetHGlobalFromStream(oStream)
lSize = GlobalSize(hGlobal)
lPtr = GlobalLock(hGlobal)
If lPtr Then
lSize = lSize - Len(Hdr)
ReDim aBytes(0 To lSize - 1)
MoveMemory aBytes(0), ByVal lPtr + Len(Hdr), lSize
End If
GlobalUnlock hGlobal
Set oStream = Nothing

End Sub


Public Function Array2Picture(aBytes() As Byte) As StdPicture
Dim oIPS As IPersistStream
Dim oStream As IStream
Dim hGlobal As Long
Dim lPtr As Long
Dim lSize As Long
Dim Hdr As PictureHeader
Set Array2Picture = New StdPicture
Set oIPS = Array2Picture
lSize = UBound(aBytes) - LBound(aBytes) + 1
hGlobal = GlobalAlloc(GHND, lSize + Len(Hdr))
If hGlobal Then
lPtr = GlobalLock(hGlobal)
Hdr.Magic = PictureID
Hdr.Size = lSize
MoveMemory ByVal lPtr, Hdr, Len(Hdr)
MoveMemory ByVal lPtr + Len(Hdr), aBytes(0), lSize
GlobalUnlock hGlobal
Set oStream = CreateStreamOnHGlobal(hGlobal, True)
oIPS.Load oStream
Set oStream = Nothing
End If
End Function


Private Sub Command1_Click()
Dim buff() As Byte
Picture2Array Picture1.Picture, buff
'测试
Set Picture2.Picture = Array2Picture(buff)
End Sub

调用时，先用getChunk读出数据到byte数组（假设数组名为buff),然后：

set image1.picture=Array2Picture(buff)

[rainstormmaster]

这个例子没有用IPersistStream接口和IStream接口，一样可以达到目的：
Option Explicit

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Private Declare Function CreateStreamOnHGlobal Lib "ole32.dll" (ByRef hGlobal As Any, ByVal fDeleteOnResume As Long, ByRef ppstr As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32.dll" (ByVal lpStream As IUnknown, ByVal lSize As Long, ByVal fRunMode As Long, ByRef riid As GUID, ByRef lplpObj As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByRef pclsid As GUID) As Long

' HKEY_CLASSES_ROOT\Interface\{7BF80980-BF32-101A-8BBB-00AA00300CAB} = IPicture
Private Const SIPICTURE As String = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"

' convert a byte array to IPicture
Public Function PictureFromRes(ByRef b() As Byte) As IPicture
On Error GoTo errorhandler

Dim istrm As IUnknown
Dim tGuid As GUID

If Not CreateStreamOnHGlobal(b(LBound(b)), False, istrm) Then
CLSIDFromString StrPtr(SIPICTURE), tGuid
OleLoadPicture istrm, UBound(b) - LBound(b) + 1, False, tGuid, PictureFromRes
End If

Set istrm = Nothing
Exit Function
errorhandler:
Debug.Print "Could not convert to IPicture!"
End Function


调用时，先用getChunk读出数据到byte数组（假设数组名为buff),然后：

set image1.picture=PictureFromRes(buff)

[「已注销」]

rainstormmaster(暴风雨 v2.0) OK!非常感谢你，我用了你的第二个方案。成功了！谢谢，也感谢捧场的人！