VB如何将BYTE类型的数组转换成图片!

Question

RT

Answer 1

Option ExplicitPrivate Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private 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 LongPrivate Const PictureID = &H746C&Private Type PictureHeader
    Magic As Long
    Size As Long
End TypePublic Function Array2Picture(aBytes() As Byte) As IPicture
    Dim oIPS As IPersistStream
    Dim oStream As IStream
    Dim hGlobal As Long
    Dim LPTR As Long
    Dim lSize As Long
    Dim Hdr As PictureHeader
    
    
    
    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)
        Set Array2Picture = New StdPicture
        Set oIPS = Array2Picture
        oIPS.Load oStream
        Set oStream = Nothing
        
    End If
End Function记得要引用olelib.tlb

Answer 2

抢劫!!!HOHO~~~我这个应该更好些吧,不用引用啥东东....嘿嘿Option ExplicitPublic Enum CBoolean
    CFalse = 0
    CTrue = 1
End EnumPublic Type GUID
    dwData1 As Long
    wData2 As Integer
    wData3 As Integer
    abData4(7) As Byte
End TypePrivate Const S_OK = 0
Private Const sIID_IPicture = "{7BF80980-BF32-101A-8BBB-00AA00300CAB}"
Private Const GMEM_MOVEABLE = &H2Private 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
Private Declare Sub CLSIDFromString Lib "ole32.dll" ( _
     ByVal lpsz As String, _
     ByVal pclsid As Long)
Private Declare Function GlobalAlloc Lib "kernel32.dll" ( _
     ByVal wFlags As Long, _
     ByVal dwBytes As Long) As Long
Private Declare Function GlobalLock Lib "kernel32.dll" ( _
     ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32.dll" ( _
     ByVal hMem As Long) As Long
Private Declare Function GlobalFree Lib "kernel32.dll" ( _
     ByVal hMem As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
     ByRef Destination As Any, _
     ByRef Source As Any, _
     ByVal Length 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
就一个函数调用,自己看着办.....

Answer 3

- -!!!老马...其实我不想打击你的...你的代码明显用了olelib.tlb.....只不过那个库VB是默认引用的....IPicture...IUnknown....都是那个库的类.....不过谢谢你和Modest的代码~~~学习+收藏了~~~~