Results 1 to 13 of 13

Thread: [VB6] Convert a picture to PNG byte-array in memory

  1. #1

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,093

    [VB6] Convert a picture to PNG byte-array in memory

    This WIA sample converts an StdPicture to a PNG byte-array without using any temporary disk storage.

    Shows how to use IPicture.SaveAsFile method with plain ADODB.Stream (no CreateStreamOnHGlobal API used).

    Code:
    Option Explicit
    
    Private Sub Form_Load()
        Debug.Print UBound(SaveAsPng(picTab1.Picture))
    End Sub
    
    Public Function SaveAsPng(pPic As IPicture) As Byte()
        Const adTypeBinary As Long = 1
        Const wiaFormatPNG As String = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
        Dim oStream     As Object ' ADODB.Stream
        Dim oImageFile  As Object ' WIA.ImageFile
        
        '--- load pPic in WIA.ImageFile
        Do While oImageFile Is Nothing
            Set oStream = CreateObject("ADODB.Stream")
            oStream.Type = adTypeBinary
            oStream.Open
            Call pPic.SaveAsFile(ByVal ObjPtr(oStream) + 68, True, 0) '--- magic
            If oStream.Size = 0 Then
                GoTo QH
            End If
            oStream.Position = 0
            With CreateObject("WIA.Vector")
                .BinaryData = oStream.Read
                If pPic.Type <> vbPicTypeBitmap Then
                    '--- this converts pPic to vbPicTypeBitmap subtype
                    Set pPic = .Picture
                Else
                    Set oImageFile = .ImageFile
                End If
            End With
        Loop
        '--- serialize WIA.ImageFile to PNG file format
        With CreateObject("WIA.ImageProcess")
            .Filters.Add .FilterInfos("Convert").FilterID
            .Filters(.Filters.Count).Properties("FormatID").Value = wiaFormatPNG
            SaveAsPng = .Apply(oImageFile).FileData.BinaryData
        End With
    QH:
    End Function
    JFYI, the magic offset 68 is the difference between ObjPtr of IUnknown and IStream casts of an ADODB.Stream instance.

    Using Picture property on WIA.Vector converts all StdPicture subtypes (like Enhanced Metafiles or Icons) to vbPicTypeBitmap because WIA's Convert filter fails on anything but a serialized vbPicTypeBitmap 32bbp image it seems.

    cheers,
    </wqw>

  2. #2
    Fanatic Member
    Join Date
    Aug 2016
    Posts
    673

    Re: [VB6] Convert a picture to PNG byte-array in memory

    Good knowledge
    .but

    Code:
     Call pPic.SaveAsFile(ByVal ObjPtr(oStream) + 68, True, 0) '--- magic
    in my system win7 32.china. program crashed .
    Last edited by xxdoc123; Nov 7th, 2020 at 09:39 PM.

  3. #3
    Fanatic Member
    Join Date
    Aug 2016
    Posts
    673

    Re: [VB6] Convert a picture to PNG byte-array in memory

    Quote Originally Posted by wqweto View Post
    This WIA sample converts an StdPicture to a PNG byte-array without using any temporary disk storage.

    Shows how to use IPicture.SaveAsFile method with plain ADODB.Stream (no CreateStreamOnHGlobal API used).

    Code:
    Option Explicit
    
    Private Sub Form_Load()
        Debug.Print UBound(SaveAsPng(picTab1.Picture))
    End Sub
    
    Public Function SaveAsPng(pPic As IPicture) As Byte()
        Const adTypeBinary As Long = 1
        Const wiaFormatPNG As String = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
        Dim oStream     As Object ' ADODB.Stream
        Dim oImageFile  As Object ' WIA.ImageFile
        
        '--- load pPic in WIA.ImageFile
        Do While oImageFile Is Nothing
            Set oStream = CreateObject("ADODB.Stream")
            oStream.Type = adTypeBinary
            oStream.Open
            Call pPic.SaveAsFile(ByVal ObjPtr(oStream) + 68, True, 0) '--- magic
            If oStream.Size = 0 Then
                GoTo QH
            End If
            oStream.Position = 0
            With CreateObject("WIA.Vector")
                .BinaryData = oStream.Read
                If pPic.Type <> vbPicTypeBitmap Then
                    '--- this converts pPic to vbPicTypeBitmap subtype
                    Set pPic = .Picture
                Else
                    Set oImageFile = .ImageFile
                End If
            End With
        Loop
        '--- serialize WIA.ImageFile to PNG file format
        With CreateObject("WIA.ImageProcess")
            .Filters.Add .FilterInfos("Convert").FilterID
            .Filters(.Filters.Count).Properties("FormatID").Value = wiaFormatPNG
            SaveAsPng = .Apply(oImageFile).FileData.BinaryData
        End With
    QH:
    End Function
    JFYI, the magic offset 68 is the difference between ObjPtr of IUnknown and IStream casts of an ADODB.Stream instance.

    Using Picture property on WIA.Vector converts all StdPicture subtypes (like Enhanced Metafiles or Icons) to vbPicTypeBitmap because WIA's Convert filter fails on anything but a serialized vbPicTypeBitmap 32bbp image it seems.

    cheers,
    </wqw>
    can fixed?

  4. #4
    Fanatic Member
    Join Date
    Aug 2016
    Posts
    673

    Re: [VB6] Convert a picture to PNG byte-array in memory

    Quote Originally Posted by xxdoc123 View Post
    Good knowledge
    .but

    Code:
     Call pPic.SaveAsFile(ByVal ObjPtr(oStream) + 68, True, 0) '--- magic
    in my system win7 32.china. program crashed .
    win10 work fine

  5. #5

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,093

    Re: [VB6] Convert a picture to PNG byte-array in memory

    For Win7 the magic offset seems to be 76 which is unfortunate.

    If you need this for serious work just add reference to Microsoft InkEdit Control 1.0 in Components (not References, this is an OCX) and call SaveAsFile method like this instead

    Code:
            Dim pStream As IStream
            Set pStream = oStream
            Call pPic.SaveAsFile(ByVal ObjPtr(pStream), True, 0)
    . . . without any magic offsets.

    These offsets depend on ADO version and probably the compiler version and options used to build the ADO and OS so clearly playing with fire here.

    Another option would be to use DispCallFunc API function to call IUnknown::QueryInterface on oStream for IID_IStream which would save the InkEdit reference but needs an API declare.

    cheers,
    </wqw>

  6. #6
    PowerPoster
    Join Date
    Feb 2015
    Posts
    2,671

    Re: [VB6] Convert a picture to PNG byte-array in memory

    Quote Originally Posted by wqweto View Post
    Another option would be to use DispCallFunc API function to call IUnknown::QueryInterface on oStream for IID_IStream which would save the InkEdit reference but needs an API declare.
    You could use __vbaCastObj function as well:
    Code:
    Option Explicit
    
    Private Declare Function vbaCastObj Lib "msvbvm60" _
                             Alias "__vbaCastObj" ( _
                             ByRef cObj As Any, _
                             ByRef pIID As Any) As Long
    Private Declare Function PutMem4 Lib "msvbvm60" ( _
                             ByRef pDst As Any, _
                             ByVal NewValue As Long) As Long
    
    Private Sub Form_Load()
        Debug.Print UBound(SaveAsPng(Me.Picture))
    End Sub
    
    Public Function SaveAsPng(pPic As IPicture) As Byte()
        Const adTypeBinary As Long = 1
        Const wiaFormatPNG As String = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
        Dim oStream     As Object ' ADODB.Stream
        Dim oImageFile  As Object ' WIA.ImageFile
        Dim cIStream    As IUnknown
        Dim bIID_IStream(3)    As Long
        
        '--- load pPic in WIA.ImageFile
        Do While oImageFile Is Nothing
            Set oStream = CreateObject("ADODB.Stream")
            oStream.Type = adTypeBinary
            oStream.Open
            
            bIID_IStream(0) = &HC
            bIID_IStream(2) = &HC0
            bIID_IStream(3) = &H46000000
            
            CastObj ObjPtr(oStream), VarPtr(bIID_IStream(0)), VarPtr(cIStream)
            
            Call pPic.SaveAsFile(ByVal ObjPtr(cIStream), True, 0)   '--- NO magic
            
            If oStream.Size = 0 Then
                GoTo QH
            End If
            oStream.Position = 0
            With CreateObject("WIA.Vector")
                .BinaryData = oStream.Read
                If pPic.Type <> vbPicTypeBitmap Then
                    '--- this converts pPic to vbPicTypeBitmap subtype
                    Set pPic = .Picture
                Else
                    Set oImageFile = .ImageFile
                End If
            End With
        Loop
        '--- serialize WIA.ImageFile to PNG file format
        With CreateObject("WIA.ImageProcess")
            .Filters.Add .FilterInfos("Convert").FilterID
            .Filters(.Filters.Count).Properties("FormatID").Value = wiaFormatPNG
            SaveAsPng = .Apply(oImageFile).FileData.BinaryData
        End With
    QH:
    End Function
    
    Private Function CastObj( _
                     ByVal pObj As Long, _
                     ByVal pIID As Long, _
                     ByVal ppObj As Long) As Long
        Dim pCast   As Long
        
        On Error GoTo error_handler
        
        pCast = vbaCastObj(ByVal pObj, ByVal pIID)
        PutMem4 ByVal ppObj, pCast
        
        Exit Function
        
    error_handler:
                         
        CastObj = Err.Number
                         
    End Function

  7. #7

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,093

    Re: [VB6] Convert a picture to PNG byte-array in memory

    Here is the DispCallFunc based fix

    Code:
    Option Explicit
    
    Private Declare Function DispCallFunc Lib "oleaut32" (ByVal pvInstance As Long, ByVal oVft As Long, ByVal lCc As Long, ByVal vtReturn As VbVarType, ByVal cActuals As Long, prgVt As Any, prgpVarg As Any, pvargResult As Variant) As Long
    
    Private Sub Form_Load()
        Debug.Print UBound(SaveAsPng(Me.Picture))
    End Sub
    
    Public Function SaveAsPng(pPic As IPicture) As Byte()
        Const adTypeBinary  As Long = 1
        Const wiaFormatPNG  As String = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
        Const CC_STDCALL    As Long = 4
        Dim oStream         As Object ' ADODB.Stream
        Dim oImageFile      As Object ' WIA.ImageFile
        Dim IID_IStream(3)  As Long
        Dim pStream         As IUnknown
        Dim vParams(0 To 1) As Variant
        Dim vType(0 To 1)   As Integer
        Dim vPtr(0 To 1)    As Long
        
        '--- load pPic in WIA.ImageFile
        Do While oImageFile Is Nothing
            Set oStream = CreateObject("ADODB.Stream")
            oStream.Type = adTypeBinary
            oStream.Open
            '--- call IUnknown::QI on oStream for IStream interface and store in pStream
            IID_IStream(0) = &HC
            IID_IStream(2) = &HC0
            IID_IStream(3) = &H46000000
            vParams(0) = VarPtr(IID_IStream(0))
            vParams(1) = VarPtr(pStream)
            vType(0) = VarType(vParams(0))
            vType(1) = VarType(vParams(1))
            vPtr(0) = VarPtr(vParams(0))
            vPtr(1) = VarPtr(vParams(1))
            Call DispCallFunc(ObjPtr(oStream), 0, CC_STDCALL, vbLong, UBound(vParams) + 1, vType(0), vPtr(0), Empty)
            '--- NO magic anymore, only business as usual
            pPic.SaveAsFile ByVal ObjPtr(pStream), True, 0
            If oStream.Size = 0 Then
                GoTo QH
            End If
            oStream.Position = 0
            With CreateObject("WIA.Vector")
                .BinaryData = oStream.Read
                If pPic.Type <> vbPicTypeBitmap Then
                    '--- this converts pPic to vbPicTypeBitmap subtype
                    Set pPic = .Picture
                Else
                    Set oImageFile = .ImageFile
                End If
            End With
        Loop
        '--- serialize WIA.ImageFile to PNG file format
        With CreateObject("WIA.ImageProcess")
            .Filters.Add .FilterInfos("Convert").FilterID
            .Filters(.Filters.Count).Properties("FormatID").Value = wiaFormatPNG
            SaveAsPng = .Apply(oImageFile).FileData.BinaryData
        End With
    QH:
    End Function
    cheers,
    </wqw>

  8. #8
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: [VB6] Convert a picture to PNG byte-array in memory

    You can also use DexterLib.IStream defined in Dexter 1.0 Type Library, qedit.dll, part of DirectShow. This should be a stable typelib shipping in Windows going back a long way to at least Windows 2000.

    I've used it for an IStream definition for other operations but I haven't tried it with this.

  9. #9
    PowerPoster
    Join Date
    Jun 2013
    Posts
    7,207

    Re: [VB6] Convert a picture to PNG byte-array in memory

    And (FWIW), a VB.PropertyBag based variation:

    Code:
    Public Function SaveAsPng(Pic As StdPicture) As Byte()
        Const wiaFormatPNG  As String = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}"
        Dim PB As PropertyBag, oImageFile As Object 'WIA.ImageFile
     
        '--- load pPic in WIA.ImageFile
        Do While oImageFile Is Nothing
           Set PB = New PropertyBag
               PB.WriteProperty "Pic", Pic
           With CreateObject("WIA.Vector")
             .BinaryData = MidB(PB.Contents, 51) '<- "magic" ;-)
             If Pic.Type <> vbPicTypeBitmap Then
               Set Pic = .Picture 'convert Pic to vbPicTypeBitmap
             Else
               Set oImageFile = .ImageFile
             End If
           End With
        Loop
        '--- serialize WIA.ImageFile to PNG file format
        With CreateObject("WIA.ImageProcess")
            .Filters.Add .FilterInfos("Convert").FilterID
            .Filters(.Filters.Count).Properties("FormatID").Value = wiaFormatPNG
            SaveAsPng = .Apply(oImageFile).FileData.BinaryData
        End With
    End Function
    Olaf

  10. #10
    PowerPoster Elroy's Avatar
    Join Date
    Jun 2014
    Location
    Near Nashville TN
    Posts
    9,817

    Re: [VB6] Convert a picture to PNG byte-array in memory

    Maybe this is a bit different, but I just use GdipSaveImageToFile in the GDI+ to get this done.

    Code:
    
    Private Declare Function GdipSaveImageToFile Lib "GdiPlus" (ByVal image As Long, ByVal pFilename As Long, ClsidEncoder As ClassIdType, ByVal pEncoderParams As Any) As Long
    
    
    I use GdipLoadImageFromFile to open them. I'd have to dig it out, but I've used a combination of the GDI and GDI+ to move this stuff between byte arrays, StdPicture, and GDI+ picture. IDK, I guess there are multiple ways to skin this cat.

    ------

    The Targa (TGA) format is another tricky one. I've never found any native Windows support for that one. I've used a combination of Tanner Helland's and LaVolpe's work to get that done.

    ------

    Typically, the only reason I'm messing with either of these is because I'd like to manipulate an image with an alpha channel in it. (Also, many web uploads seem to prefer PNG.) GIFs are fine for alpha masking, but PNG and TGA seem to be best if you want a fully "blendable" alpha channel.
    Any software I post in these forums written by me is provided "AS IS" without warranty of any kind, expressed or implied, and permission is hereby granted, free of charge and without restriction, to any person obtaining a copy. To all, peace and happiness.

  11. #11
    PowerPoster
    Join Date
    Jan 2020
    Posts
    3,742

    Re: [VB6] Convert a picture to PNG byte-array in memory

    how to show Png from byte array?

    this code only support jpg,bmp
    Code:
    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&
    
    'https://blog.csdn.net/miaozk2006/article/details/82417098
    
    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 = Form1.ScaleX(IPic.Width, vbHimetric, vbPixels)
                    PicH = Form1.ScaleY(IPic.Height, vbHimetric, vbPixels)
                    Set ShowPictureFromStream = IPic
                End If
            End If
            Set IStm = Nothing
        End If
        Erase bPic
    End Function
    
    Sub Test9()
        Dim b() As Byte
       
        Open App.Path & "\001.png" For Binary As #1
        b = InputB(LOF(1), 1)
        Close #1
       
        Set Form1.Picture = ShowPictureFromStream(b)
        Erase b
    End Sub

  12. #12

    Thread Starter
    PowerPoster wqweto's Avatar
    Join Date
    May 2011
    Location
    Sofia, Bulgaria
    Posts
    5,093

    Re: [VB6] Convert a picture to PNG byte-array in memory

    Try this

    Code:
    Function ShowPictureFromStream(ByRef bPic() As Byte) As StdPicture
        With CreateObject("WIA.Vector")
            .BinaryData = bPic
            Set ShowPictureFromStream = .Picture
        End With
    End Function
    This understands PNG an TIFF file formats besides standard BMP, GIF, and JPEG.

    cheers,
    </wqw>

  13. #13
    PowerPoster
    Join Date
    Feb 2006
    Posts
    24,482

    Re: [VB6] Convert a picture to PNG byte-array in memory

    WIA 2.0's interfaces have maintained binary compatibility from the beginning. There really isn't any need to rely on late binding and hand-rolled constants like this.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width