直接显示二进制图片

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}”
Private Mstream As Object '二进制转换对象
Private Const adTypeBinary = 1 '二进制模式
Dim B() As Byte

Private Sub Form_Load()
Set Mstream = CreateObject(“ADODB.Stream”)
With Mstream
.Open '打开"ADODB.Stream"对象
.Type = adTypeBinary '二进制模式
.LoadFromFile App.Path & “\1.jpg” '图片路径
End With
B = Mstream.Read '将转好的二进制图片赋予BYTE值
Mstream.Close '关闭Mstream对象
End Sub

’ 将字节数组转换为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:
MsgBox “无法转换为IPicture!”
End Function

Private Sub Command1_Click()
Set Me.Picture = PictureFromRes(B)
End Sub