Conversion images BMP/JPG/PNG avec GDI+

Commenter

Contenu du snippet 

'// à mettre dans un Module
Public Enum GpStatus
   Ok = 0
   GenericError = 1
   InvalidParameter = 2
   OutOfMemory = 3
   ObjectBusy = 4
   InsufficientBuffer = 5
   NotImplemented = 6
   Win32Error = 7
   WrongState = 8
   Aborted = 9
   FileNotFound = 10
   ValueOverflow = 11
   AccessDenied = 12
   UnknownImageFormat = 13
   FontFamilyNotFound = 14
   FontStyleNotFound = 15
   NotTrueTypeFont = 16
   UnsupportedGdiplusVersion = 17
   GdiplusNotInitialized = 18
   PropertyNotFound = 19
   PropertyNotSupported = 20
End Enum
Public Enum EncoderParameterValueType
   EncoderParameterValueTypeByte = 1
   EncoderParameterValueTypeASCII = 2
   EncoderParameterValueTypeShort = 3
   EncoderParameterValueTypeLong = 4
   EncoderParameterValueTypeRational = 5
   EncoderParameterValueTypeLongRange = 6
   EncoderParameterValueTypeUndefined = 7
   EncoderParameterValueTypeRationalRange = 8
End Enum
Public Enum ImageCodecFlags
   ImageCodecFlagsEncoder = &H1
   ImageCodecFlagsDecoder = &H2
   ImageCodecFlagsSupportBitmap = &H4
   ImageCodecFlagsSupportVector = &H8
   ImageCodecFlagsSeekableEncode = &H10
   ImageCodecFlagsBlockingDecode = &H20
   ImageCodecFlagsBuiltin = &H10000
   ImageCodecFlagsSystem = &H20000
   ImageCodecFlagsUser = &H40000
End Enum
Public Type GdiplusStartupInput
   GdiplusVersion           As Long
   DebugEventCallback       As Long
   SuppressBackgroundThread As Long
   SuppressExternalCodecs   As Long
End Type
Public Type CLSID
   Data1             As Long
   Data2             As Integer
   Data3             As Integer
   Data4(0 To 7)     As Byte
End Type
Public Type ImageCodecInfo
   ClassID           As CLSID
   FormatID          As CLSID
   CodecName         As Long
   DllName           As Long
   FormatDescription As Long
   FilenameExtension As Long
   MimeType          As Long
   flags             As ImageCodecFlags
   Version           As Long
   SigCount          As Long
   SigSize           As Long
   SigPattern        As Long
   SigMask           As Long
End Type
Public Type EncoderParameter
   GUID              As CLSID
   NumberOfValues    As Long
   type              As EncoderParameterValueType
   value             As Long
End Type
Public Type EncoderParameters
   count             As Long
   Parameter         As EncoderParameter
End Type
Public Const EncoderQuality As String = "{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"
Public Declare Function GdiplusStartup Lib "gdiplus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As GpStatus
Public Declare Sub GdiplusShutdown Lib "gdiplus" (ByVal token As Long)
Public Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal filename As String, image As Long) As GpStatus
Public Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal image As Long, ByVal filename As String, clsidEncoder As CLSID, encoderParams As Any) As GpStatus
Public Declare Function GdipGetImageEncodersSize Lib "gdiplus" (numEncoders As Long, size As Long) As GpStatus
Public Declare Function GdipGetImageEncoders Lib "gdiplus" (ByVal numEncoders As Long, ByVal size As Long, encoders As Any) As GpStatus
Public Declare Function GdipDisposeImage Lib "gdiplus" (ByVal image As Long) As GpStatus
Private Declare Function CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Src As Any, ByVal cb As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal psString As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32.dll" (ByVal lpszProgID As Long, pCLSID As CLSID) As Long
Public Function GetEncoderClsid(strMimeType As String, ClassID As CLSID)
   Dim num           As Long
   Dim size          As Long
   Dim I             As Long
   Dim ICI()         As ImageCodecInfo
   Dim buffer()      As Byte
   
   GetEncoderClsid = -1
   Call GdipGetImageEncodersSize(num, size)
   If size = 0 Then Exit Function
   ReDim ICI(1 To num)
   ReDim buffer(1 To size)
   Call GdipGetImageEncoders(num, size, buffer(1))
   Call CopyMemory(ICI(1), buffer(1), (Len(ICI(1)) * num))
   For I = 1 To num
       If StrComp(PtrToStrW(ICI(I).MimeType), strMimeType, vbTextCompare) = 0 Then
          ClassID = ICI(I).ClassID
          GetEncoderClsid = I
          Exit For
          End If
       Next
   Erase ICI
   Erase buffer
End Function 
Public 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 DEFINE_GUID(ByVal sGuid As String) As CLSID
   Call CLSIDFromString(StrPtr(sGuid), DEFINE_GUID)
End Function 
'// à mettre sur une Forme
Dim token         As Long
Dim img           As Long
Dim encoderCLSID  As CLSID
Dim stat          As GpStatus
Private Sub Form_Load()
   Dim GpInput  As GdiplusStartupInput
   GpInput.GdiplusVersion = 1
   If GdiplusStartup(token, GpInput) <> Ok Then
      MsgBox "Erreur chargement GDI+!", vbCritical
      Unload Me
      End If
End Sub 
Private Sub ConvertImage(Source As String, Destination As String, MimeType As Integer, Optional Quality As Integer = 75)
   Dim encoderParams As EncoderParameters
   Dim lngQuality    As Long
   Dim strMimeType   As String
   
   Call GdipLoadImageFromFile(StrConv(Source, vbUnicode), img)
   
   If MimeType = 1 Then strMimeType = "image/bmp"
   If MimeType = 2 Then strMimeType = "image/jpeg"
   If MimeType = 3 Then strMimeType = "image/png"
   Call GetEncoderClsid(strMimeType, encoderCLSID)
   
   If MimeType = 2 Then
      If Quality < 0 Or Quality > 100 Then
         lngQuality = 75
         Else
         lngQuality = Quality
         End If
      encoderParams.count = 1
      With encoderParams.Parameter
          .NumberOfValues = 1
          .type = EncoderParameterValueTypeLong
          .GUID = DEFINE_GUID(EncoderQuality)
          .value = VarPtr(lngQuality)
           End With
      stat = GdipSaveImageToFile(img, StrConv(Destination, vbUnicode), encoderCLSID, encoderParams)
      Else
      stat = GdipSaveImageToFile(img, StrConv(Destination, vbUnicode), encoderCLSID, ByVal 0)
      End If
   
   Call GdipDisposeImage(img)
   If stat = Ok Then
      MsgBox "la conversion s'est terminée avec succès !", vbInformation
      Else
      MsgBox "il y a eu erreur pendant la conversion ! Status Code= " & stat, vbCritical
      End If
End Sub 
Private Sub JPGtoBMP(Source As String, Destination As String)
    Call ConvertImage(Source, Destination, 1)
End Sub 
Private Sub PNGtoBMP(Source As String, Destination As String)
    Call ConvertImage(Source, Destination, 1)
End Sub 
Private Sub BMPtoJPG(Source As String, Destination As String, Quality As Integer)
    Call ConvertImage(Source, Destination, 2, Quality)
End Sub 
Private Sub PNGtoJPG(Source As String, Destination As String, Quality As Integer)
    Call ConvertImage(Source, Destination, 2, Quality)
End Sub 
Private Sub BMPtoPNG(Source As String, Destination As String)
    Call ConvertImage(Source, Destination, 3)
End Sub 
Private Sub JPGtoPNG(Source As String, Destination As String)
    Call ConvertImage(Source, Destination, 3)
End Sub 
Private Sub Form_Unload(Cancel As Integer)
   Call GdiplusShutdown(token)
End Sub 
'// les conversions possible:
'   Call BMPtoJPG(chemin_image_source.bmp, chemin_image_destination.jpg, 90)
'   Call BMPtoPNG(chemin_image_source.bmp, chemin_image_destination.png)
'   Call PNGtoJPG(chemin_image_source.png, chemin_image_destination.jpg, 90)
'   Call PNGtoBMP(chemin_image_source.png, chemin_image_destination.bmp)
'   Call JPGtoBMP(chemin_image_source.jpg, chemin_image_destination.bmp)
'   Call JPGtoPNG(chemin_image_source.jpg, chemin_image_destination.png)

Compatibilité : VB6

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.

Du même auteur (Gobillot)