バイナリ画像データを直接PictureBoxにロードするには？ (ID:78415)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

先々週、某メーリングリストに投稿したサンプルです。参考になれば。

Option Explicit

Private Const S_OK As Long = 0&

Private Type UUID
   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, _
    ByRef ppstm As Any) As Long

Private Declare Function OleLoadPicture Lib "olepro32" _
   (ByVal pStream As Long, _
    ByVal lSize As Long, _
    ByVal fRunmode As Long, _
    ByRef riid As UUID, _
    ByRef ppvObj As Any) As Long

Private Const GMEM_MOVEABLE As Long = &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 RtlMoveMemory Lib "kernel32" _
   (ByVal pDest As Long, _
    ByRef pSource As Byte, _
    ByVal dwLength As Long)

Public Function BytesToPicture(ByRef PicBin() As Byte) As Picture
    Dim Low As Long, High As Long, Size As Long
    Dim IID_IPicture As UUID
    Dim oPicture As IPicture

Low = LBound(PicBin)
    High = UBound(PicBin)
    Size = High - Low + 1

'{7BF80980-BF32-101A-8BBB-00AA00300CAB}
    With IID_IPicture
        .Data1 = &H7BF80980
        .Data2 = &HBF32
        .Data3 = &H101A
        .Data4(0) = &H8B
        .Data4(1) = &HBB
        .Data4(3) = &HAA
        .Data4(5) = &H30
        .Data4(6) = &HC
        .Data4(7) = &HAB
    End With

Dim hMem As Long
    Dim lpMem As Long
    Dim lRet As Long
    Dim Stm As IUnknown

hMem = GlobalAlloc(GMEM_MOVEABLE, Size)
    If hMem = 0 Then
        Exit Function
    End If

lpMem = GlobalLock(hMem)
    If lpMem <> 0 Then
        RtlMoveMemory ByVal lpMem, PicBin(Low), Size
        GlobalUnlock hMem
        lRet = CreateStreamOnHGlobal(hMem, 1, Stm)
        If lRet = S_OK Then
            OleLoadPicture ObjPtr(Stm), Size, 0, IID_IPicture, oPicture
        End If
        GlobalFree hMem
    End If
    Set BytesToPicture = oPicture
    Set oPicture = Nothing
End Function

←解決時は質問者本人がここをチェックしてください。

戻る