-
Nov 6th, 2020, 07:09 AM
#1
[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>
-
Nov 6th, 2020, 09:05 PM
#2
Fanatic Member
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.
-
Nov 8th, 2020, 09:17 AM
#3
Fanatic Member
Re: [VB6] Convert a picture to PNG byte-array in memory
Originally Posted by wqweto
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?
-
Nov 8th, 2020, 11:09 PM
#4
Fanatic Member
Re: [VB6] Convert a picture to PNG byte-array in memory
Originally Posted by xxdoc123
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
-
Nov 9th, 2020, 02:22 AM
#5
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>
-
Nov 9th, 2020, 03:29 AM
#6
Re: [VB6] Convert a picture to PNG byte-array in memory
Originally Posted by wqweto
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
-
Nov 9th, 2020, 04:13 AM
#7
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>
-
Nov 9th, 2020, 10:34 AM
#8
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.
-
Nov 9th, 2020, 11:33 AM
#9
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
-
Nov 9th, 2020, 12:59 PM
#10
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.
-
Nov 10th, 2020, 10:11 AM
#11
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
-
Nov 10th, 2020, 10:43 AM
#12
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>
-
Nov 10th, 2020, 11:50 AM
#13
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|