Convertir un wmf en emf

Commenter

Contenu du snippet

Voici du code que j'ai trouvé sur le net et qui sert, comme le titre l'indique, à convertir un fichier WMF en EMF.
Le seul problème c'est que je ne sais pas comment l'utiliser :o(

Je fais donc appel à toute personne qui pourrait mettre un projet (qui utilise ce code) dans lequel on sélectionne un fichier WMF, le prog le transforme, et l'enregistre en EMF.

Je pense que ce code pourra être utile à certains d'entre vous (et je l'espère).

Merci d'avance.

Source / Exemple : 


Private Const MM_ANISOTROPIC = 8
'...
Private Type SMALL_RECT
Left As Integer
Top As Integer
Right As Integer
Bottom As Integer
End Type
'...
Private Type METAHEADER
   mtType As Integer
   mtHeaderSize As Integer
   mtVersion As Integer
   mtSize As Long
   mtNoObjects As Integer
   mtMaxRecord As Long
   mtNoParameters As Integer
End Type

Private Type APMHEADER
dwKey As Long
hMF As Integer
rcBounds As SMALL_RECT
wInch As Integer
dwReserved As Long
wChecksum As Integer
End Type
Private Const SIZEOF_APMHEADER = 22
Private Const APMHEADER_KEY = &H9AC6CDD7
'...
Private Type METAFILEPICT
mm As Long
xExt As Long
yExt As Long
hMF As Long
End Type
'...
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function SetWinMetaFileBits Lib "gdi32" (ByVal cbBuffer As Long, lpbBuffer As Byte, ByVal hdcRef As Long, lpmfp As METAFILEPICT) As Long
'...
Private Function OpenAPM(ByVal Path As String) As Long ' Returns an EMF handle
On Error GoTo Err_OpenAPM

Dim hEmf As Long
hEmf = 0

Dim hDC As Long
hDC = 0

Dim lBytes As Long, aBytes() As Byte, lBase

' TODO: Read the file into aBytes()
'...
' Open the file for binary access
Dim hFile As Long

   Dim Hdra As METAHEADER
   Dim mtSize As Long
   Dim hMF As Long
   hFile = FreeFile
   Dim FileName As String
   FileName = "c:\carte.wmf"
   Open FileName For Binary Access Read As #hFile

   ' Scan past APMFILEHEADER (22 bytes), and
   ' grab METAHEADER.
   Get #hFile, 23, Hdra

   ' The size field contains number of WORDs
   ' in metafile,we need to double for number
   ' of bytes.
   Hdra.mtSize = Hdra.mtSize * 2

   ' Grab actual metafile data. Need to back
   ' up to beginning of header.
   ReDim aBytes(1 To Hdra.mtSize) As Byte
   Get #hFile, 23, aBytes

   ' Done with file now.
   Close hFile

lBase = LBound(aBytes)
lBytes = UBound(aBytes) - LBound(aBytes) + 1

Dim Hdr As APMHEADER
If lBytes >= SIZEOF_APMHEADER Then
CopyMemory Hdr, aBytes(lBase), SIZEOF_APMHEADER
End If
If Hdr.dwKey = APMHEADER_KEY Then
Dim mfp As METAFILEPICT
With mfp
.mm = MM_ANISOTROPIC
.xExt = Hdr.rcBounds.Right - Hdr.rcBounds.Left
If .xExt < 0 Then .xExt = -1 * .xExt
.xExt = (2540 / Hdr.wInch) * .xExt

.yExt = Hdr.rcBounds.Bottom - Hdr.rcBounds.Top
If .yExt < 0 Then .yExt = -1 * .yExt
.yExt = (2540 / Hdr.wInch) * .yExt
End With

hDC = GetDC(0)
If 0 <> hDC Then
hEmf = SetWinMetaFileBits(lBytes - SIZEOF_APMHEADER, aBytes(lBase + SIZEOF_APMHEADER), hDC, mfp)
End If
End If

OpenAPM = hEmf
GoTo Exit_OpenAPM

Err_OpenAPM:
GoTo Exit_OpenAPM

Exit_OpenAPM:
If (0 <> hDC) Then
ReleaseDC 0, hDC
End If
End Function

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.