[求助]关于byte数组转stdpicture问题 高手来 谢谢了
如题
如果用open语句打开一个binary的位图文件,并将数据存在一个byte()数组内
怎么能使这个byte()直接转化为stdpicture或直接在picturebox内输出而不生成临时文件
知道的帮帮小弟啦 在这谢过了
[最优解释]
5L你真有心啊,呵呵,这样的确是对的,但是你写的太啰嗦了。。。
下面的代码就行了。。。
Public Function BytToPic(ByRef BytesIn() As Byte) As iPicture
Dim Stream As IUnknown, ID As GUID
CreateStreamOnHGlobal BytesIn(0), 0, Stream
CLSIDFromString StrConv("{7BF80980-BF32-101A-8BBB-00AA00300CAB}", vbUnicode), ID
OleLoadPicture Stream, UBound(BytesIn) + 1, 0, ID, BytToPic
End Function
[其他解释]
IUnknown和GUID
然后OleLoadPicture生成StdPicture
[其他解释]
Option Explicit
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 Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Const GMEM_ZEROINIT = &H40
Private Function GetPictureFromByteStream(bImageData() As Byte) As IPicture
Dim lngByteCount As Long
Dim hMem As Long
Dim lpMem As Long
Dim IID_IPicture(15)
Dim IStream As stdole.IUnknown
On Error GoTo Err_Init
lngByteCount = UBound(bImageData) + 1 ' 计算数组大小
hMem = GlobalAlloc(&H2 Or GMEM_ZEROINIT, lngByteCount) ' 按数组大小分配一块内存空间
If hMem <> 0 Then ' 若分配内存成功
lpMem = GlobalLock(hMem) ' 锁定内存, 返回第一块的指针
If lpMem <> 0 Then
CopyMemory ByVal lpMem, bImageData(0), lngByteCount
Call GlobalUnlock(hMem)
If CreateStreamOnHGlobal(hMem, 1, IStream) = 0 Then
If CLSIDFromString(StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), IID_IPicture(0)) = 0 Then
Call OleLoadPicture(ByVal ObjPtr(IStream), lngByteCount, 0, IID_IPicture(0), GetPictureFromByteStream)
End If
End If
End If
End If
GlobalFree hMem
Exit Function
Err_Init:
MsgBox Err.Number & " - " & Err.Description
End Function
Private Sub Command1_Click()
Dim bytData() As Byte
Dim f As String
Dim Fn As Integer
f = "d:\p1.jpg"
If Dir(f) = "" Then
MsgBox "File not found"
Exit Sub
End If
Fn = FreeFile
Open f For Binary As #Fn
ReDim bytData(LOF(1) - 1)
Get #Fn, , bytData
Close #Fn
Set Picture1.Picture = GetPictureFromByteStream(bytData())
End Sub