Attribute VB_Name = "ModPictureFromBits"
Option Explicit
'本模块可以从一个字节数组直接得到IPicture对象
'从阿杰处得来
'
'BY 嗷嗷叫的老马
'
'2008-05-11
'
'http://www.m5home.com/
'http://www.vbasm.com/
'http://www.vb-asm.com/

Public Enum CBoolean
    CFalse = 0
    CTrue = 1
End Enum

Private Const S_OK = 0
Private Declare Function CreateStreamOnHGlobal Lib "ole32" _
    (ByVal hGlobal As Long, _
    ByVal fDeleteOnRelease As CBoolean, _
    ppstm As Any) As Long
Private Declare Function OleLoadPicture Lib "olepro32" _
    (pStream As Any, _
    ByVal lSize As Long, _
    ByVal fRunmode As CBoolean, _
    riid As GUID, _
    ppvObj As Any) As Long

Public Type GUID
    dwData1 As Long
    wData2 As Integer
    wData3 As Integer
    abData4(7) As Byte
End Type

Private Declare Function CLSIDFromString Lib "ole32" (ByVal lpsz As Any, pclsid As GUID) As Long
Private Const sIID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Private Const GMEM_MOVEABLE = &H2
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 MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)

Public Function PictureFromBits(abPic() As Byte) As IPicture
    Dim nLow As Long
    Dim cbMem As Long
    Dim hMem As Long
    Dim lpMem As Long
    Dim IID_IPicture As GUID
    Dim istm As stdole.IUnknown
    Dim ipic As IPicture
    On Error GoTo Out
    nLow = LBound(abPic)
    On Error GoTo 0
    cbMem = (UBound(abPic) - nLow) + 1
    hMem = GlobalAlloc(GMEM_MOVEABLE, cbMem)
    If hMem Then
        lpMem = GlobalLock(hMem)
        If lpMem Then
            MoveMemory ByVal lpMem, abPic(nLow), cbMem
            Call GlobalUnlock(hMem)
            If (CreateStreamOnHGlobal(hMem, CTrue, istm) = S_OK) Then
                If (CLSIDFromString(StrPtr(sIID_IPicture), IID_IPicture) = S_OK) Then
                    Call OleLoadPicture(ByVal ObjPtr(istm), cbMem, CFalse, IID_IPicture, PictureFromBits)
                End If
            End If
        End If
    End If
Out:
End Function