1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
|
Imports System.Drawing
(...)
Private Function GetEncoderInfo(ByVal sMimeType As String) As Imaging.ImageCodecInfo
Dim _Nb As Int32 'Compteur d'éléments du codec
Dim _Codecs() As Imaging.ImageCodecInfo = Imaging.ImageCodecInfo.GetImageEncoders
For _Nb = 0 To _Codecs.GetUpperBound(0)
If _Codecs(_Nb).MimeType = sMimeType Then
'On a trouvé le type recherché, sortie
Return _Codecs(_Nb)
Exit Function
End If
Next
End Function
Public Function SauverImage(ByVal B As Bitmap, _
ByVal NomFichier As String, _
ByVal FormatSortie As Imaging.ImageFormat, _
Optional ByVal Remplacer As Boolean = False, _
Optional ByVal Qualite As Int32 = 50) As Boolean
'Recherche du nom de fichier adapté
Dim _NomFinal As String = CréerNomFichier(NomFichier, Remplacer)
Dim _Qualité As Int32 = Qualite 'la qualité doit être passée ByRef sinon ça ne marche pas
Try
If FormatSortie Is Imaging.ImageFormat.Jpeg Then
'----- Cas spécifique du JPEG
'Définition des encodeurs pour la gestion du niveau de qualité
Dim MyJPEGEncoder As Imaging.ImageCodecInfo = GetEncoderInfo("image/jpeg") 'Lecture des codecs JPEG
Dim MyQualityEncoder As Imaging.Encoder = Imaging.Encoder.Quality 'Spécification de la qualité
Dim MyParamEncoder As Imaging.EncoderParameter = _
New Imaging.EncoderParameter(MyQualityEncoder, _Qualité) 'Qualité choisie
Dim MyParamsEncoder As Imaging.EncoderParameters = New Imaging.EncoderParameters(1)
MyParamsEncoder.Param(0) = MyParamEncoder
'Création du bitmap en prenant en compte ces éléments
Dim oB As New Bitmap(B)
oB.Save(_NomFinal, MyJPEGEncoder, MyParamsEncoder)
'Libération des ressources
oB.Dispose()
MyParamEncoder.Dispose()
MyParamsEncoder.Dispose()
Else
'----- Autres formats
Dim oB As New Bitmap(B)
oB.Save(_NomFinal, FormatSortie)
oB.Dispose()
End If
'Opération réussie
Return True
Catch
'Erreur, retour négatif
Try
'On efface l'éventuel fichier vide généré
File.Delete(_NomFinal)
Catch
End Try
Return False
End Try
B.Dispose()
End Function |
Partager