Option Explicit
'* ******************************************************* *
'*    模块名称：frmTest.frm
'*    模块功能：直接显示图像数据
'*    作者：lyserver
'*    联系方式：http://blog.csdn.net/lyserver
'* ******************************************************* *
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As stdole.IUnknown) As Long
Private Declare Function OleLoadPicture Lib "olepro32" (ByVal pStream As Long, ByVal lSize As Long, ByVal fRunmode As Long, riid As Any, ppvObj As stdole.IUnknown) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpwsz As Long, pclsid As Any) As Long
Private Const ERROR_SUCCESS = 0&

Function ShowPictureFromStream(ByRef bPic() As Byte) As StdPicture
    Dim IID_IPicture As GUID
    Dim IStm As stdole.IUnknown, IPic As IPicture
    Dim PicW As Long, PicH As Long
   
    If CreateStreamOnHGlobal(VarPtr(bPic(0)), 1, IStm) = ERROR_SUCCESS Then
        If CLSIDFromString(StrPtr("{7BF80980-BF32-101A-8BBB-00AA00300CAB}"), IID_IPicture) = ERROR_SUCCESS Then
            If OleLoadPicture(ByVal ObjPtr(IStm), UBound(bPic) + 1, 0, IID_IPicture, IPic) = ERROR_SUCCESS Then
                PicW = Me.ScaleX(IPic.Width, vbHimetric, vbPixels)
                PicH = Me.ScaleY(IPic.Height, vbHimetric, vbPixels)
                Set ShowPictureFromStream = IPic
            End If
        End If
        Set IStm = Nothing
    End If
    Erase bPic
End Function

Private Sub Command1_Click()
    Dim b() As Byte
   
    Open "c:/temp2.jpg" For Binary As #1
    b = InputB(LOF(1), 1)
    Close #1
   
    Set Me.Picture = ShowPictureFromStream(b)
    Erase b
End Sub