1. Create blank EMF using desktop DC: GdipRecordMetafileStream
2. Get EMF graphics: GdipGetImageGraphicsContext
3. [added] Get previously created Region object & apply to graphics: GdipSetClipRegion
4. Draw 24bpp source to EMF: GdipDrawImageRectRect
5. Convert EMF to windows EMF: GdipGetHemfFromMetafile
6. Convert EMF bits to WMF: GdipEmfToWmfBits
7. Write bits to file & clean up
maybe i will do some work at the base of dilettante's demo...
question resolved.
Last edited by loquat; Nov 20th, 2016 at 05:45 AM.
Reason: Resolved by dilettante
Re: How can I change by EMF byte array to jpeg file?
There are (at least) three kinds of "EMF" images: plain EMF (GDI), EMF+ Only (GDI+), and EMF+ Dual (GDI and GDI+). Use GDI+ if you want to handle all of those.
EMF images are really drawing macros. Some have fixed dimensions while others do not. You have to render them onto a bitmap canvas, so you must decide what to draw them onto (a specific solid color fill, pattern fill, background image, etc.) unless they draw a solid filled result.
After rendering you can convert the bitmap to JPEG format using GDI+ or a 3rd party library.
There should be examples in the CodeBank for dealing with most of this.
Re: How can I change by EMF byte array to jpeg file?
Originally Posted by dilettante
There are (at least) three kinds of "EMF" images: plain EMF (GDI), EMF+ Only (GDI+), and EMF+ Dual (GDI and GDI+). Use GDI+ if you want to handle all of those.
EMF images are really drawing macros. Some have fixed dimensions while others do not. You have to render them onto a bitmap canvas, so you must decide what to draw them onto (a specific solid color fill, pattern fill, background image, etc.) unless they draw a solid filled result.
After rendering you can convert the bitmap to JPEG format using GDI+ or a 3rd party library.
There should be examples in the CodeBank for dealing with most of this.
Thank you for sharing information.
I do not know there are three kind of EMF images before.
My original problem is:
I can get a byte array of a ms word page by using vba method document.windows(1).Panes(1).Pages(1).EnhMetaFileBits
I wanna change this array to jpeg stream.
Long time ago, I have tried drawing this array to memoryDC for converting to jpeg, but failed then.
I had searching in google for many times, using key words like "vb6 emf to jpg" "vb6 emf convert" and so on
and I can hardly find useful examples for me in google as well as in CodeBank.
maybe I will try much more efforts in searching CodeBank later.
Thanks again.
--loquat tang
Last edited by loquat; Nov 17th, 2016 at 11:47 PM.
Reason: fix some expression
Re: How can I change by EMF byte array to jpeg file?
If you have the byte array you can load it into an IStream:
Code:
Public Function pvStreamFromArray(ArrayPtr As Long, Length As Long) As IUnknown 'stdole.IUnknown
' Purpose: Create an IStream-compatible IUnknown interface containing the
' passed byte aray. This IUnknown interface can be passed to GDI+ functions
' that expect an IStream interface -- neat hack
Dim o_hMem As Long
Dim o_lpMem As Long
On Error GoTo e0
If ArrayPtr = 0& Then
CreateStreamOnHGlobal ByVal 0&, 1&, pvStreamFromArray
ElseIf Length <> 0& Then
o_hMem = GlobalAlloc(&H2&, Length)
If o_hMem <> 0 Then
o_lpMem = GlobalLock(o_hMem)
If o_lpMem <> 0 Then
CopyMemory ByVal o_lpMem, ByVal ArrayPtr, Length
Call GlobalUnlock(o_hMem)
Call CreateStreamOnHGlobal(ByVal o_hMem, 1&, pvStreamFromArray)
End If
End If
End If
On Error GoTo 0
Exit Function
e0:
Debug.Print "GDIP.pvStreamFromArray.Error->" & Err.Description & " (" & Err.Number & ")"
End Function
Which is called like
Code:
Dim IStream As IUnknown
Set IStream = pvStreamFromArray(VarPtr(stream(0)), UBound(stream) + 1&)
If Not IStream Is Nothing Then
If GdipLoadImageFromStream(IStream, hBitmap) = 0& Then
where stream() is your byte array.
Then you can call the normal save-to-jpg routine for a gdi+ hbitmap.
Last edited by fafalone; Nov 18th, 2016 at 07:07 AM.
Re: How can I change by EMF byte array to jpeg file?
Originally Posted by fafalone
If you have the byte array you can load it into an IStream:
Code:
Public Function pvStreamFromArray(ArrayPtr As Long, Length As Long) As IUnknown 'stdole.IUnknown
' Purpose: Create an IStream-compatible IUnknown interface containing the
' passed byte aray. This IUnknown interface can be passed to GDI+ functions
' that expect an IStream interface -- neat hack
Dim o_hMem As Long
Dim o_lpMem As Long
On Error GoTo e0
If ArrayPtr = 0& Then
CreateStreamOnHGlobal ByVal 0&, 1&, pvStreamFromArray
ElseIf Length <> 0& Then
o_hMem = GlobalAlloc(&H2&, Length)
If o_hMem <> 0 Then
o_lpMem = GlobalLock(o_hMem)
If o_lpMem <> 0 Then
CopyMemory ByVal o_lpMem, ByVal ArrayPtr, Length
Call GlobalUnlock(o_hMem)
Call CreateStreamOnHGlobal(ByVal o_hMem, 1&, pvStreamFromArray)
End If
End If
End If
On Error GoTo 0
Exit Function
e0:
Debug.Print "GDIP.pvStreamFromArray.Error->" & Err.Description & " (" & Err.Number & ")"
End Function
Which is called like
Code:
Dim IStream As IUnknown
Set IStream = pvStreamFromArray(VarPtr(stream(0)), UBound(stream) + 1&)
If Not IStream Is Nothing Then
If GdipLoadImageFromStream(IStream, hBitmap) = 0& Then
where stream() is your byte array.
Then you can call the normal save-to-jpg routine for a gdi+ hbitmap.
I Change hBitmap to StdPicture like below
Code:
Dim tPictDesc As PICTDESC
Dim IID_IPicture As IID
Dim oPicture As IPicture
With tPictDesc
.cbSizeOfStruct = Len(tPictDesc)
.picType = 1 'vbPicTypeBitmap
.hgdiObj = hBitmap
.hPalOrXYExt = 0
End With
' 初始化IPicture
With IID_IPicture
.Data1 = &H7BF80981
.Data2 = &HBF32
.Data3 = &H101A
.Data4(0) = &H8B
.Data4(1) = &HBB
.Data4(3) = &HAA
.Data4(5) = &H30
.Data4(6) = &HC
.Data4(7) = &HAB
End With
Call OleCreatePictureIndirect(tPictDesc, IID_IPicture, True, oPicture)
Dim StreamToPicture As StdPicture
it succeed, then i convert StdPicture to JPG File
I used one module from laviewpbt that has a function SaveStdPicToFile
Code:
Public Function SaveStdPicToFile(Stdpic As StdPicture, ByVal FileName As String, _
Optional ByVal FileFormat As ImageFileFormat = Jpg, _
Optional ByVal JpgQuality As Long = 80, _
Optional Resolution As Single) As Boolean
until when i find it cannot create bitmap object
GdipCreateBitmapFromHBITMAP Stdpic.Handle, Stdpic.hPal, Bitmap 'After this line, Bitmap is 0.
i do not know where is the problem.
i upload my demo here, hope for your further help.
Re: How can I change by EMF byte array to jpeg file?
Why would you go through StdPicture?
Code:
Public Sub EmfStreamToJpg(bEMF() As Byte, sSaveTo As String)
'this doesn't have to be EMF by the way, you could load any image type
'that GDI+ supports into the byte array without any other changes
Dim pStrm As IUnknown
Dim hEMF As Long
Set pStrm = pvStreamFromArray(VarPtr(bEMF(0)), UBound(bEMF) + 1)
Call GdipLoadImageFromStream(pStrm, hEMF)
If hEMF Then
Call gdipImgToFileJPG(hEMF, sSaveTo)
GdipDisposeImage hEMF
End If
End Sub
Public Function gdipImgToFileJPG(hImg As Long, sOut As String) As Long
Dim encoderCLSID As CLSIDG
Call GetEncoderClsid("image/jpeg", encoderCLSID) 'can also substitute any other supported codec, like image/png or image/bmp
GdipSaveImageToFile hImg, StrConv(sOut, vbUnicode), encoderCLSID, ByVal 0&
End Function
'
'generic support declares/funcs:
Public Type CLSIDG
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Public Type ImageCodecInfo
ClassID As CLSIDG
FormatID As CLSIDG
CodecName As Long ' String Pointer; const WCHAR*
DllName As Long ' String Pointer; const WCHAR*
FormatDescription As Long ' String Pointer; const WCHAR*
FilenameExtension As Long ' String Pointer; const WCHAR*
MimeType As Long ' String Pointer; const WCHAR*
Flags As Long 'ImageCodecFlags ' Should be a Long equivalent
Version As Long
SigCount As Long
SigSize As Long
SigPattern As Long ' Byte Array Pointer; BYTE*
SigMask As Long ' Byte Array Pointer; BYTE*
End Type
Public Function GetEncoderClsid(strMimeType As String, ClassID As CLSIDG)
Dim num As Long, SIZE As Long, i As Long
Dim ICI() As ImageCodecInfo
Dim Buffer() As Byte
On Error GoTo e0
GetEncoderClsid = -1 'Failure flag
' Get the encoder array size
Call GdipGetImageEncodersSize(num, SIZE)
If SIZE = 0 Then Exit Function ' Failed!
' Allocate room for the arrays dynamically
ReDim ICI(1 To num) As ImageCodecInfo
ReDim Buffer(1 To SIZE) As Byte
' Get the array and string data
Call GdipGetImageEncoders(num, SIZE, Buffer(1))
' Copy the class headers
Call CopyMemory(ICI(1), Buffer(1), (Len(ICI(1)) * num))
' Loop through all the codecs
For i = 1 To num
' Must convert the pointer into a usable string
If StrComp(PtrToStrW(ICI(i).MimeType), strMimeType, vbTextCompare) = 0 Then
ClassID = ICI(i).ClassID ' Save the class id
GetEncoderClsid = i ' return the index number for success
Exit For
End If
Next
' Free the memory
Erase ICI
Erase Buffer
Exit Function
e0:
Debug.Print "GetEncoderCLSID.Error->" & Err.Description
End Function
Private Function PtrToStrW(ByVal lpsz As Long) As String
Dim sOut As String
Dim lLen As Long
lLen = lstrlenW(lpsz)
If (lLen > 0) Then
sOut = StrConv(String$(lLen, vbNullChar), vbUnicode)
Call CopyMemory(ByVal sOut, ByVal lpsz, lLen * 2)
PtrToStrW = StrConv(sOut, vbFromUnicode)
End If
End Function
---------------
Note: If you're a fan of my typelib and/or want to do more advanced stuff with the IStream, you can simply replace IUnknown in EmfStreamToJpg and pvStreamFromArray with oleexp3.IStream to get a real IStream object.
----
PS- I can't find much in the way of sample files or programs that can convert; but doesn't EMF+ store the image as PNG or JPEG? Wouldn't that then support transparency, which would be lost with a normal StdPicture object?
Last edited by fafalone; Nov 18th, 2016 at 12:48 PM.
Re: How can I change by EMF byte array to jpeg file?
Originally Posted by fafalone
Why would you go through StdPicture?
Code:
Public Sub EmfStreamToJpg(bEMF() As Byte, sSaveTo As String)
'this doesn't have to be EMF by the way, you could load any image type
'that GDI+ supports into the byte array without any other changes
Dim pStrm As IUnknown
Dim hEMF As Long
Set pStrm = pvStreamFromArray(VarPtr(bEMF(0)), UBound(bEMF) + 1)
Call GdipLoadImageFromStream(pStrm, hEMF)
If hEMF Then
Call gdipImgToFileJPG(hEMF, sSaveTo)
GdipDisposeImage hEMF
End If
End Sub
Public Function gdipImgToFileJPG(hImg As Long, sOut As String) As Long
Dim encoderCLSID As CLSIDG
Call GetEncoderClsid("image/jpeg", encoderCLSID) 'can also substitute any other supported codec, like image/png or image/bmp
GdipSaveImageToFile hImg, StrConv(sOut, vbUnicode), encoderCLSID, ByVal 0&
End Function
'
'generic support declares/funcs:
Public Type CLSIDG
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Public Type ImageCodecInfo
ClassID As CLSIDG
FormatID As CLSIDG
CodecName As Long ' String Pointer; const WCHAR*
DllName As Long ' String Pointer; const WCHAR*
FormatDescription As Long ' String Pointer; const WCHAR*
FilenameExtension As Long ' String Pointer; const WCHAR*
MimeType As Long ' String Pointer; const WCHAR*
Flags As Long 'ImageCodecFlags ' Should be a Long equivalent
Version As Long
SigCount As Long
SigSize As Long
SigPattern As Long ' Byte Array Pointer; BYTE*
SigMask As Long ' Byte Array Pointer; BYTE*
End Type
Public Function GetEncoderClsid(strMimeType As String, ClassID As CLSIDG)
Dim num As Long, SIZE As Long, i As Long
Dim ICI() As ImageCodecInfo
Dim Buffer() As Byte
On Error GoTo e0
GetEncoderClsid = -1 'Failure flag
' Get the encoder array size
Call GdipGetImageEncodersSize(num, SIZE)
If SIZE = 0 Then Exit Function ' Failed!
' Allocate room for the arrays dynamically
ReDim ICI(1 To num) As ImageCodecInfo
ReDim Buffer(1 To SIZE) As Byte
' Get the array and string data
Call GdipGetImageEncoders(num, SIZE, Buffer(1))
' Copy the class headers
Call CopyMemory(ICI(1), Buffer(1), (Len(ICI(1)) * num))
' Loop through all the codecs
For i = 1 To num
' Must convert the pointer into a usable string
If StrComp(PtrToStrW(ICI(i).MimeType), strMimeType, vbTextCompare) = 0 Then
ClassID = ICI(i).ClassID ' Save the class id
GetEncoderClsid = i ' return the index number for success
Exit For
End If
Next
' Free the memory
Erase ICI
Erase Buffer
Exit Function
e0:
Debug.Print "GetEncoderCLSID.Error->" & Err.Description
End Function
Private Function PtrToStrW(ByVal lpsz As Long) As String
Dim sOut As String
Dim lLen As Long
lLen = lstrlenW(lpsz)
If (lLen > 0) Then
sOut = StrConv(String$(lLen, vbNullChar), vbUnicode)
Call CopyMemory(ByVal sOut, ByVal lpsz, lLen * 2)
PtrToStrW = StrConv(sOut, vbFromUnicode)
End If
End Function
---------------
Note: If you're a fan of my typelib and/or want to do more advanced stuff with the IStream, you can simply replace IUnknown in EmfStreamToJpg and pvStreamFromArray with oleexp3.IStream to get a real IStream object.
----
PS- I can't find much in the way of sample files or programs that can convert; but doesn't EMF+ store the image as PNG or JPEG? Wouldn't that then support transparency, which would be lost with a normal StdPicture object?
of course, i m a fan of your typelib oleexp, it s wonderful as well as respecting work of u.
for this time, i change your code a little, and it can execute successfully.
Code:
Option Explicit
Private Declare Function GdipLoadImageFromStream Lib "gdiplus" (ByVal Stream As IUnknown, Image As Long) As Long
Private Declare Function GdipGetImageEncodersSize Lib "gdiplus" (numEncoders As Long, SIZE As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Long
Private Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal hImage As Long, ByVal sFilename As Long, clsidEncoder As Any, encoderParams As Any) As Long
Private Declare Sub CreateStreamOnHGlobal Lib "ole32.dll" (ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, ByRef ppstm As Any)
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 Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Public Type CLSIDG
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Public Type ImageCodecInfo
ClassID As CLSIDG
FormatID As CLSIDG
CodecName As Long ' String Pointer; const WCHAR*
DllName As Long ' String Pointer; const WCHAR*
FormatDescription As Long ' String Pointer; const WCHAR*
FilenameExtension As Long ' String Pointer; const WCHAR*
MimeType As Long ' String Pointer; const WCHAR*
Flags As Long 'ImageCodecFlags ' Should be a Long equivalent
Version As Long
SigCount As Long
SigSize As Long
SigPattern As Long ' Byte Array Pointer; BYTE*
SigMask As Long ' Byte Array Pointer; BYTE*
End Type
Public Function GetEncoderClsid(strMimeType As String, ClassID As CLSIDG)
Dim num As Long, SIZE As Long, i As Long
Dim ICI() As ImageCodecInfo
Dim Buffer() As Byte
On Error GoTo e0
GetEncoderClsid = -1 'Failure flag
' Get the encoder array size
Call GdipGetImageEncodersSize(num, SIZE)
If SIZE = 0 Then Exit Function ' Failed!
' Allocate room for the arrays dynamically
ReDim ICI(1 To num) As ImageCodecInfo
ReDim Buffer(1 To SIZE) As Byte
' Get the array and string data
Call GdipGetImageEncoders(num, SIZE, Buffer(1))
' Copy the class headers
Call CopyMemory(ICI(1), Buffer(1), (Len(ICI(1)) * num))
' Loop through all the codecs
For i = 1 To num
' Must convert the pointer into a usable string
If StrComp(PtrToStrW(ICI(i).MimeType), strMimeType, vbTextCompare) = 0 Then
ClassID = ICI(i).ClassID ' Save the class id
GetEncoderClsid = i ' return the index number for success
Exit For
End If
Next
' Free the memory
Erase ICI
Erase Buffer
Exit Function
e0:
Debug.Print "GetEncoderCLSID.Error->" & Err.Description
End Function
Private Function PtrToStrW(ByVal lpsz As Long) As String
Dim sOut As String
Dim lLen As Long
lLen = lstrlenW(lpsz)
If (lLen > 0) Then
sOut = StrConv(String$(lLen, vbNullChar), vbUnicode)
Call CopyMemory(ByVal sOut, ByVal lpsz, lLen * 2)
PtrToStrW = StrConv(sOut, vbFromUnicode)
End If
End Function
Public Function pvStreamFromArray(ArrayPtr As Long, Length As Long) As IUnknown 'stdole.IUnknown
' Purpose: Create an IStream-compatible IUnknown interface containing the
' passed byte aray. This IUnknown interface can be passed to GDI+ functions
' that expect an IStream interface -- neat hack
Dim o_hMem As Long
Dim o_lpMem As Long
On Error GoTo e0
If ArrayPtr = 0& Then
CreateStreamOnHGlobal ByVal 0&, 1&, pvStreamFromArray
ElseIf Length <> 0& Then
o_hMem = GlobalAlloc(&H2&, Length)
If o_hMem <> 0 Then
o_lpMem = GlobalLock(o_hMem)
If o_lpMem <> 0 Then
CopyMemory ByVal o_lpMem, ByVal ArrayPtr, Length
Call GlobalUnlock(o_hMem)
Call CreateStreamOnHGlobal(ByVal o_hMem, 1&, pvStreamFromArray)
End If
End If
End If
On Error GoTo 0
Exit Function
e0:
Debug.Print "GDIP.pvStreamFromArray.Error->" & Err.Description & " (" & Err.Number & ")"
End Function
Public Sub EmfStreamToJpg(bEMF() As Byte, sSaveTo As String)
'this doesn't have to be EMF by the way, you could load any image type
'that GDI+ supports into the byte array without any other changes
Dim pStrm As IUnknown
Dim hEMF As Long
Set pStrm = pvStreamFromArray(VarPtr(bEMF(0)), UBound(bEMF) + 1)
Call GdipLoadImageFromStream(pStrm, hEMF)
If hEMF Then
Call gdipImgToFileJPG(hEMF, sSaveTo)
GdipDisposeImage hEMF
End If
End Sub
Public Function gdipImgToFileJPG(hImg As Long, sOut As String) As Long
Dim encoderCLSID As CLSIDG
Call GetEncoderClsid("image/jpeg", encoderCLSID) 'can also substitute any other supported codec, like image/png or image/bmp
GdipSaveImageToFile hImg, sOut, encoderCLSID, ByVal 0&
End Function
Sub Main()
Dim arrStream() As Byte
'Read Word File Page
Dim wdApp As Object
Set wdApp = CreateObject("Word.Application")
Dim wdDoc As Object
Set wdDoc = wdApp.Documents.Add
wdDoc.Content.Text = "MY TEST"
arrStream = wdDoc.Windows(1).Panes(1).Pages(1).EnhMetaFileBits
wdDoc.Close False
wdApp.Quit False
Set wdDoc = Nothing
Set wdApp = Nothing
EmfStreamToJpg arrStream, "c:\demo.jpg"
End Sub
the previous problem is demo.jpg but totally black any mistaking of my using?
Re: How can I change by EMF byte array to jpeg file?
If it's all black my best guess would be an issue with source of byte array. I'm not really familiar with Office automation- how is the emf image getting on the page, or is that supposed to be an image of the page itself? Can you dump it to a .emf file and view it in a normal image viewer?
Code:
Dim hFile As Long
hFile = FreeFile
Open "C:\temp\image.emf" For Binary As #hFile
Put #hFile, 1, bytEMF
Close #hFile
I've tested the code I posted with actual .emf images as the source and it worked right.
-----------
Update: GDI+ can't seem to read the image produced by Word. It produced a .emf file I could read in other image viewers, but converting this file had the same results. Maybe it has to be drawn onto a graphics object first? I'll keep playing with it. LaVolpe would probably know.
Last edited by fafalone; Nov 19th, 2016 at 03:06 AM.
Re: How can I change by EMF byte array to jpeg file?
For those who prefer using Cairo instead of GDI+ ... here's the appropriate RC5-version:
Code:
Private Sub Form_Load()
Dim Srf As cCairoSurface, B() As Byte
With CreateObject("Word.Application").Documents.Open("c:\temp\dok1.docx")
Set Srf = WPemfToSrf(.Windows(1).Panes(1).Pages(1), 512, vbWhite)
.Application.Quit 'close Word
End With
Srf.WriteContentToJpgByteArray B
' Srf.WriteContentToPngByteArray B
Set Picture = Srf.Picture 'visualize the retrieved Surface on the form
End Sub
Private Function WPemfToSrf(WP As Object, PxlWidth, Optional ByVal BGColor& = -1) As cCairoSurface
Set WPemfToSrf = Cairo.CreateWin32Surface(PxlWidth, PxlWidth * WP.Height / WP.Width)
If BGColor <> -1 Then WPemfToSrf.CreateContext.Paint , Cairo.CreateSolidPatternLng(BGColor)
With New_c.ReportPage
.EMFContent = WP.EnhMetaFileBits
.RenderTo WPemfToSrf.GetDC, 0, 0, WPemfToSrf.Width, WPemfToSrf.Height
End With
End Function
Private Sub Form_Terminate()
If Forms.Count = 0 Then New_c.CleanupRichClientDll
End Sub
Re: How can I change by EMF byte array to jpeg file?
I have the same test just like you did
Code:
Dim bStream() As Byte
bStream = ActiveDocument.Windows(1).Panes(1).Pages(1).EnhMetaFileBits
Dim aFileNum&: aFileNum = FreeFile()
Open "c:\demo.emf" For Binary As #aFileNum
Put aFileNum, 1, bStream
Close #aFileNum
demo.emf can be view normally in mspaint.exe but cannot view by system image viewer.
I do not know why either
Re: How can I change by EMF byte array to jpeg file?
Without going into the nightmare that is Word Automation and its funky object model too much...
Here is a simple demo that will Automate a reasonably recent version of Word (2000 or newer?) and extract the "page 1" EMF and save it as a disk file in JPEG format after rendering it on top of a white backdrop.
You need Word installed, but there is no other external dependency aside from GDI+ which should already be installed as part of Windows unless you are still running Win9x or something. Sample document included.
I chose to ignore margins, which is another factor that results in a somewhat distorted result.
As far as I could tell from trying a few things there can be many complications such as Sections, Headers and Footers, and probably even more if the document contains tables. Ack, ptui! Word is quite a minefield.
Re: How can I change by EMF byte array to jpeg file?
Originally Posted by dilettante
Without going into the nightmare that is Word Automation and its funky object model too much...
Here is a simple demo that will Automate a reasonably recent version of Word (2000 or newer?) and extract the "page 1" EMF and save it as a disk file in JPEG format after rendering it on top of a white backdrop.
You need Word installed, but there is no other external dependency aside from GDI+ which should already be installed as part of Windows unless you are still running Win9x or something. Sample document included.
I chose to ignore margins, which is another factor that results in a somewhat distorted result.
As far as I could tell from trying a few things there can be many complications such as Sections, Headers and Footers, and probably even more if the document contains tables. Ack, ptui! Word is quite a minefield.
Re: How can I change by EMF byte array to jpeg file?
The invisible PictureBox is easy to use in VB6, and just a couple of GDI+ calls are needed to encode into the lossy JPEG format. I can't think of any reason why you can't do the entire thing using a series of GDI+ calls.
Re: How can I change by EMF byte array to jpeg file?
Well the code I posted earlier with the flat api works for every EMF file I've found except for those produced by Word. Any idea why it would output all black from a .emf source that other apps view fine? (and all black in the correct dimensions too)
Re: How can I change by EMF byte array to jpeg file?
I suspect that all of them you tried contain a filled backdrop, which most do not. The Word EMF, like most, is some drawing against a background. If you draw black text on a black background you get... black. If you leave the result transparent then what you see depends on the backdrop used by your viewer. If the viewer backdrop is black, black text on black gives... black. But you probably effectively rendered it on black because a JPEG has no transparency.
As I said you can use the GDI+ flat API but it will take a number of calls to get the desired result. You need to create an image filled with a desired "paper" color such as white and then render the EMF onto that.
Re: How can I change by EMF byte array to jpeg file?
For all emf's except Word's, it was only a few lines:
Code:
Public Function gdipImgToFileJPG(hImg As Long, sOut As String) As Long
Dim encoderCLSID As CLSIDG
Call GetEncoderClsid("image/jpeg", encoderCLSID)
Debug.Print "encoder clsid data1=" & Hex$(encoderCLSID.Data1)
GdipSaveImageToFile hImg, StrConv(sOut, vbUnicode), encoderCLSID, ByVal 0&
End Function
Public Sub EmfStreamToJpg(bEMF() As Byte, sSaveTo As String)
Dim pStrm As oleexp3.IStream
Dim hemf As Long
Set pStrm = pvStreamFromArrayB(VarPtr(bEMF(0)), UBound(bEMF) + 1)
Call GdipLoadImageFromStream(pStrm, hemf)
If hemf Then
Call gdipImgToFileJPG(hemf, sSaveTo)
GdipDisposeImage hemf
End If
End Sub
That's it. How would I set what color it draws to?
Re: How can I change by EMF byte array to jpeg file?
Originally Posted by fafalone
How would I set what color it draws to?
EMF/WMF images are drawing macros. They package up a series of GDI and/or GDI+ drawing operations that can be "played back" into a bitmap. If they don't contain an operation that creates a filled backdrop then you have no filled backdrop, which means they will draw "transparently" against whatever backdrop you have.
The text of a Word document page is normally black. If you leave the backdrop black you are painting black text on a black "canvas," and the result is a black bitmap.
So if you want the "page" EMF painted on a white paper backdrop you must first create a white backdrop of the desired dimensions and then "play back" (render) the EMF onto this backdrop bitmap.
Re: How can I change by EMF byte array to jpeg file?
And if everything else it opened in also showed black, there'd be no confusion here. But in every image viewer application, it shows the correct black text on white background. GDI+ doesn't.
Forgive my ignorance, but my issue isn't that I don't understand that it needs to be manually instructed to not do what it's doing, it's that I don't know how to accomplish that, especially in a way that wouldn't override the currently correct rendering of all .emf files not originating from MS Office.
Re: How can I change by EMF byte array to jpeg file?
Originally Posted by fafalone
And if everything else it opened in also showed black, there'd be no confusion here. But in every image viewer application, it shows the correct black text on white background. GDI+ doesn't.
GDI+ does it "right" IMO, because it's an API, which leaves you with the freedom to
render a (potentially transparent) content onto any background you choose (be that
an image/bitmap-Background or one filled with only a solid color.
You (as the developer) are under the obligation to ensure one, on the thingy you render the emf-content to.
The reason that "it works on several image-viewers" is, that their developers did exactly that (they ensured a background).
And the reason "a few other emfs work" (without ensuring a background on the target-area) is, that the emf itself then
already contains a recorded GDI-call to FillRect or something (those are "non-transparent emfs" if you want to label them).
It is the same with GIFs or PNGs - some don't contain transparent areas - but most do
(with the same effects, when you render them onto a non-initialized, usually black surface).
Originally Posted by fafalone
Forgive my ignorance, but my issue isn't that I don't understand that it needs to be manually instructed to not do what it's doing, it's that I don't know how to accomplish that, especially in a way that wouldn't override the currently correct rendering of all .emf files not originating from MS Office.
Well, seems that "documentation per code-example" *does* hold value (over reading a "formal one"). ( SCNR, )
Ok - the following doesn't bother with GDI+, since the GDI is simple enough for
"Visualizing transparent EMF in a VB-PictureBox" - and saving from there over a StdPicture
(from Picture1.Image) to a PNG or JPG is well-covered in the meantime:
The example needs a Picture1 on Form1, nothing else otherwise... note the optional
BGColor-Param in WPemfToPBox - if you leave it out, you can render a transparent
EMF even over a BackGround-Picture of a PictureBox, in case you applied one over Picture1.Picture
Code:
Private Declare Function SetEnhMetaFileBits& Lib "gdi32" (ByVal DLen&, pData As Any)
Private Declare Function PlayEnhMetaFile& Lib "gdi32" (ByVal hDC&, ByVal hEMF&, pRect As Any)
Private Declare Function DeleteEnhMetaFile& Lib "gdi32" (ByVal Hdl&)
Private Sub Form_Load()
With CreateObject("Word.Application").Documents.Open("c:\temp\dok1.docx")
WPemfToPBox .Windows(1).Panes(1).Pages(1), Picture1 ', vbWhite
.Application.Quit 'close Word
End With
End Sub
Private Sub WPemfToPBox(WP As Object, PBox As PictureBox, Optional ByVal BGColor& = -1)
PBox.Cls: PBox.AutoRedraw = True: PBox.ScaleMode = vbPixels
PBox.Move PBox.Left, PBox.Top, ScaleX(WP.Width, vbPoints), ScaleY(WP.Height, vbPoints)
If BGColor <> -1 Then PBox.Line (0, 0)-(ScaleWidth, ScaleHeight), BGColor, BF
Dim Rct(0 To 3) As Long, B() As Byte, hEMF As Long
Rct(2) = PBox.ScaleWidth: Rct(3) = PBox.ScaleHeight
B = WP.EnhMetaFileBits
hEMF = SetEnhMetaFileBits(UBound(B) + 1, B(0))
If hEMF Then PlayEnhMetaFile PBox.hDC, hEMF, Rct(0)
If hEMF Then DeleteEnhMetaFile hEMF
End Sub