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

[fafalone]

That could become a problem real quick with a thousand different things... But there should be a few basic common libraries it's ok to expect people to have as they're broadly useful for any kind of modern development... RC6, VBCCR/OLEGuids.tlb, oleexp.tlb, and back in the day its predecessor olelib.tlb and for game programming dx8vb. Because there's major tradeoffs. Like simple code that's easy to understand and is easy to relate to Microsoft's documentation, vs code only experts understand. Easy to extend vs requiring much more effort and expertise. Supported vs undocumented functions that can disappear at any time or like undocumented magic numbers change from version to version of Windows.

At least hopefully this can change a bit in twinBASIC where instead of 'go to this page, find the dl link, extract the files, navigate to it in the references file dialog' it has become 'just tick a box in the package server list in settings'.

Also easier to share shorter code.

[anycoder]

I took the liberty and deleted these two extra lines of code. Here is my final version of this code:

You can also remove SHWeakReleaseInterface and it still working, but it's important to understand how the working of SHWeakQueryInterface :
it looks something like this:

if Inner.QueryInterface(..) then
  Outer --
End if

As you can see after detecting the requested interface..The Outer is dereferenced by a step th problem there's no way to be sure it was done on the same object returned by QI ,which is necessary to ensure a balanced operation, in short, SHWeakQueryInterface may attach and detach from different internal instances in the object you pass....alternatively, it is possible to pass, in the Outer, any global object that is not affected by the reference counting and could never be destroyed.

[HackerVlad]

The best code starting from Windows Vista+

Option Explicit
Private Declare Function vbaCastObj Lib "msvbvm60" Alias "__vbaCastObj" (ByVal cObj As Object, pIID As Any) As IUnknown

Public Function SaveAsPng(ByVal pPic As IPicture) As Byte()
    Dim ADOStream As Object
    Dim WIAImageFile As Object
    Dim bIID_IStream(1) As Currency ' IStreamGUID
    
    Do While WIAImageFile Is Nothing
        Set ADOStream = CreateObject("ADODB.Stream")
        
        ADOStream.Type = 1 ' adTypeBinary
        ADOStream.Open
        
        ' Extract an IStream object from an ADODB.Stream object
        bIID_IStream(0) = 0.0012@
        bIID_IStream(1) = 504403158265495.5712@
        
        pPic.SaveAsFile ByVal ObjPtr(vbaCastObj(ADOStream, bIID_IStream(0))), True, 0
        
        If ADOStream.Size > 0 Then
            ADOStream.Position = 0
            
            With CreateObject("WIA.Vector")
                .BinaryData = ADOStream.Read
                
                If pPic.Type <> vbPicTypeBitmap Then
                    Set pPic = .Picture ' This converts pPic to vbPicTypeBitmap subtype
                Else
                    Set WIAImageFile = .ImageFile
                End If
            End With
        Else
            Exit Function
        End If
    Loop
    
    ' Serialize WIA.ImageFile to PNG file format
    With CreateObject("WIA.ImageProcess")
        .Filters.Add .FilterInfos("Convert").FilterID
        .Filters(.Filters.Count).Properties("FormatID").Value = "{B96B3CAF-0728-11D3-9D7B-0000F81EF32E}" ' wiaFormatPNG
        SaveAsPng = .Apply(WIAImageFile).FileData.BinaryData
    End With
End Function

Private Sub Command1_Click()
    Dim FileNo As Integer
    Dim bArray() As Byte
    
    bArray = SaveAsPng(Me.Picture)
    Debug.Print UBound(bArray)
    
    FileNo = FreeFile
    On Error Resume Next: Kill App.Path & "\test.png"
    Open App.Path & "\test.png" For Binary As FileNo
        Put #FileNo, , bArray
    Close FileNo
End Sub

[HackerVlad]

The best code starting from Windows XP+

Option Explicit
Private Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As Any, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token As Long)
Private Declare Function GdipSaveImageToStream Lib "gdiplus" (ByVal image As Long, ByVal stream As IUnknown, clsidEncoder As Any, encoderParams As Any) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As Long, ByVal hpal As Long, bitmap As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As Long
Private Declare Function CreateStreamOnHGlobal Lib "ole32" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ppstm As IUnknown) As Long
Private Declare Function GetHGlobalFromStream Lib "ole32" (ByVal ppstm As IUnknown, hGlobal 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 GlobalSize Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)

Private Function SaveAsPng(ByVal cImage As IPicture) As Byte()
    Dim cBuf(3) As Currency, hToken As Long, hBmp As Long, cStm As IUnknown, hMem As Long, lSize As Long, bData() As Byte
    
    cBuf(0) = 0.0001@: cBuf(2) = 128439892464716.6982@: cBuf(3) = 338308179558612.6746@
    
    If GdiplusStartup(hToken, cBuf(0)) = 0 And CreateStreamOnHGlobal(0, 1, cStm) >= 0 Then
        If GdipCreateBitmapFromHBITMAP(Me.Picture.Handle, 0, hBmp) = 0 Then
            If GdipSaveImageToStream(hBmp, cStm, cBuf(2), ByVal 0&) = 0 Then
                If GetHGlobalFromStream(cStm, hMem) >= 0 Then
                    lSize = GlobalSize(hMem)
                    ReDim bData(lSize - 1)
                    memcpy bData(0), ByVal GlobalLock(hMem), lSize
                    SaveAsPng = bData
                    GlobalUnlock hMem
                End If
            End If
            GdipDisposeImage hBmp
        End If
        GdiplusShutdown hToken
    End If
End Function

Private Sub Command1_Click()
    Dim FileNo As Integer
    Dim bArray() As Byte
    
    bArray = SaveAsPng(Me.Picture)
    Debug.Print UBound(bArray)
    
    FileNo = FreeFile
    On Error Resume Next: Kill App.Path & "\test.png"
    Open App.Path & "\test.png" For Binary As FileNo
        Put #FileNo, , bArray
    Close FileNo
End Sub

[HackerVlad]

I would also like to point out that it is best to use the GDI Plus API code, as it works 10 times faster and works even on old Windows XP, and the output file is the same.

[xiaoyao]

I would also like to point out that it is best to use the GDI Plus API code, as it works 10 times faster and works even on old Windows XP, and the output file is the same.

picturebox,Can it be converted to transparent PNG? If the complex picture?bmp,png,The resulting file is about the same size.JPG takes up less memory space on the hard disk. If you draw it. In the end, the BMP type will probably take up the same amount of memory.

Directly use gdiplus DLL to draw rectangles and ovals, and save them as transparent PNG, which should save memory very much. Can even become WMF, SVG vector format, do not know how to achieve?

In the 2000s, our Internet broadband was only 56 kb, and the modem was connected to the Internet.
The photoshop provides a preview mode to generate 3 to 5 image formats at the same time. JPG, PNG, GIF, by adjusting the sharpness. It allows us to directly see whether it is clear how many kb of memory and hard disk each image takes up.

[xiaoyao]

Or you could, ya know, just have an oleexp.tlb reference...

   Dim Stream As Object 
   Set Stream = CreateObject("ADODB.Stream")
   Dim pis As IStream
   Set pis = Stream

Set is a wrapper for QueryInterface and the above will work without any magic offset, DispCallFunc mess, or undocumented API.

I understand the desire to not have to distribute any additional dependencies with an exe but IDE only dependencies? Don't understand why opposition to them is so widespread. tB is perfect then, because you can define it right there...

[InterfaceId("0c733a30-2a1c-11ce-ade5-00aa0044773d")]
[OleAutomation(False)]
Interface ISequentialStream Extends stdole.IUnknown
    Function Read(pv As Any, ByVal cb As Long) As Long
    Function Write(pv As Any, ByVal cb As Long) As Long
End Interface
[InterfaceId("0000000c-0000-0000-C000-000000000046")]
[OleAutomation(False)]
Interface IStream Extends ISequentialStream
    Function Seek(ByVal dlibMove As LongLong, ByVal dwOrigin As STREAM_SEEK) As LongLong
    Sub SetSize(ByVal libNewSize As LongLong)
    Sub CopyTo(ByVal pStm As IStream, ByVal cb As LongLong, pcbRead As LongLong, pcbWritten As LongLong)
    Sub Commit(ByVal grfCommitFlags As STGC)
    Sub Revert()
    Sub LockRegion(ByVal libOffset As LongLong, ByVal cb As LongLong, ByVal dwLockType As LOCKTYPE)
    Sub UnlockRegion(ByVal libOffset As LongLong, ByVal cb As LongLong, ByVal dwLockType As LOCKTYPE)
    Sub Stat(pstatstg As STATSTG, ByVal grfStatFlag As STATFLAG)
    Function Clone() As IStream
End Interface

[FormDesignerId("DC5AB447-69B4-455D-8176-63CFA5682839")]
[ClassId("F3F8ABBD-23AC-498C-BB03-7903E1DBEBF1")]
[InterfaceId("CB3F5BF1-F472-461F-A573-C78C5D39889D")]
[EventInterfaceId("2A8C3A91-4F1C-41B8-9D97-D629476C061D")]
Class Form1
    Option Explicit
    Private Sub Form_Load() Handles Form.Load
        Dim Stream As Object
        Dim ob As Object
        Set Stream = CreateObject("ADODB.Stream")
        Dim ps As IStream
        Set ps = Stream
    End Sub
End Class

I omitted the enums but I think the point was made for people who'd probably want to avoid checking the box for WinDevLib as a reference too even though it's not an external typelib like oleexp

Just like the need to call the excel. Application, coreldraw. TLB, his hard disk may have occupied up to 3mb, if we copy such a TLB alone, it must be a bit troublesome. There will also be version compatibility issues.

However, only three interfaces are used in our program. We don't need to reference the file of 20,000 interfaces.

This is like calling the javascript9 interface instead of the javascript5, VBScript scripting engine.All we need is a 3 kb TLB file.Maybe twinbasic, no midl. Exe, VC + + generates TLB from IDL file

[HackerVlad]

As far as I know, VBA does not support TLB, which is why I disagree with fafalone.

[xiaoyao]

As far as I know, VBA does not support TLB, which is why I disagree with fafalone.

The VBA supports loading TLB files, and we can even write code to load them dynamically.
But if we provide a 6mb TLB file.
Just to implement a function that extracts the PNG bytes of the picture object image or makes the taskbar display a progress bar.
This is too big.If we extract a small amount of TLB from the source code, many people's technology can not do it.

This is a problem that I often have conflicts with Fa Fa Long.
For example, it is often necessary to compile a 3 kb TLB file ,forusing the istream object. It is very convenient and valuable.

However, the TLB file may also be distinguished from the 32-bit and 64-bit versions. I just doubt it. I don't know if it's true.

[VanGoghGaming]

This is a problem that I often have conflicts with Fa Fa Long.

This nickname is so much better, maybe he will consider changing it! Sounds like a pornstar from the eighties!

[xiaoyao]

This nickname is so much better, maybe he will consider changing it! Sounds like a pornstar from the eighties!

I always thought he was a Chinese, maybe Jackie Chan's brother.