Hello,
Wanting to create a thumbnail of an image, i'm using the following piece of
code :
Public Sub Reduction(ByVal Source As String, ByVal Destination As String,
ByVal TailleX As String, ByVal TailleY As String, ByVal Resolution As
Integer, ByVal Fond As Boolean, ByVal ConserverRatio As Boolean, ByVal
PixelFormat As System.Drawing.Imaging.PixelFormat, ByVal ImageFormat As
System.Drawing.Imaging.ImageFormat, ByVal R As Integer, ByVal V As Integer,
ByVal B As Integer)
'Declarations des variables recevant les dimensions proportionnelles
Ă* l'original
Dim Width_Out As Integer 'largeur proportionnelle original
Dim Height_Out As Integer 'hauteur proportionnelle original
'Declarations des variables recevant les dimensions de sortie
souhaitées
Dim Final_X As Integer 'largeur de sortie
Dim Final_Y As Integer 'hauteur de sortie
'Déclaration du Bitmap d'entrée
Dim Bitmap_In As Bitmap
'Chargement de l'image source dans le bitmap d'entrée
Bitmap_In = Image.FromFile(Source)
'Conservation du Ratio (OUI/NON)
If ConserverRatio Then
'Calcul des dimensions de la miniature du bitmap d'entrée
'si Largeur fixe
If TailleY = "" And TailleX <> "" Then
'DĂ©finition de la taille proprtionnelle
Width_Out = CInt(TailleX)
Height_Out = CInt(TailleX) * Bitmap_In.Height /
Bitmap_In.Width
'Définition de la taille souhaitée
Final_X = TailleX
Final_Y = Height_Out
Else
'si Hauteur fixe
If TailleX = "" And TailleY <> "" Then
'DĂ©finition de la taille proprtionnelle
Height_Out = CInt(TailleY)
Width_Out = CInt(TailleY) * Bitmap_In.Width /
Bitmap_In.Height
'Définition de la taille souhaitée
Final_X = Width_Out
Final_Y = TailleY
Else
If Bitmap_In.Width >= Bitmap_In.Height Then
'DĂ©finition de la taille proprtionnelle
'si orientation = paysage
Width_Out = CInt(TailleX)
Height_Out = CInt(TailleX) * Bitmap_In.Height /
Bitmap_In.Width
Else
'DĂ©finition de la taille proprtionnelle
'si orientation = portrait
Height_Out = CInt(TailleY)
Width_Out = CInt(TailleY) * Bitmap_In.Width /
Bitmap_In.Height
End If
'Verification si la taille de la miniature est
compatible avec la taille souhaitée
'si Width_Out > TailleX
If Width_Out > TailleX Then
Width_Out = CInt(TailleX)
Height_Out = CInt(TailleX) * Bitmap_In.Height /
Bitmap_In.Width
End If
'si Height_Out > TailleY
If Height_Out > TailleY Then
Height_Out = CInt(TailleY)
Width_Out = CInt(TailleY) * Bitmap_In.Width /
Bitmap_In.Height
End If
'Définition de la taille souhaitée
Final_X = TailleX
Final_Y = TailleY
End If
End If
Else
'DĂ©finition de la taille proprtionnelle
Width_Out = CInt(TailleX)
Height_Out = CInt(TailleY)
'Définition de la taille souhaitée
Final_X = TailleX
Final_Y = TailleY
End If
'DĂ©claration du Bitmap de sortie
Dim Bitmap_Temp As New Bitmap(Width_Out, Height_Out, PixelFormat)
'Déclaration de la surface de dessin du bitmap d'entrée
Dim MyGraphics_Temp As Graphics = Graphics.FromImage(Bitmap_Temp)
'Modification de la surface de dessin du bitmap d'entrée en
respectant les proptions
MyGraphics_Temp.DrawImage(Bitmap_In, 0, 0, Width_Out, Height_Out)
'Liberation de la mémoire des éléments concernat le Bitmap d'entrée
Bitmap_In.Dispose()
Bitmap_In = Nothing
'DĂ©claration du Bitmap de sortie
Dim Bitmap_Out As Bitmap
'CrĂ©ation d'un fond Ă* l'image (OUI/NON)
If Fond Then
'Instanciation du Bitmap de sortie
Bitmap_Out = New Bitmap(CInt(Final_X), CInt(Final_Y), PixelFormat)
'DĂ©claration de la surface de dessin du bitmap de sortie
Dim MyGraphics_out As Graphics = Graphics.FromImage(Bitmap_Out)
'Definition de la couleur d'arrière-plan
Dim Couleur As Color = Color.FromArgb(255, R, V, B)
Dim MyBackground As New SolidBrush(Couleur)
'Calcul des décalages Haut et gauche pour centrer de l'image
Dim Top As Integer = (Bitmap_Out.Height - Bitmap_Temp.Height) / 2
Dim Left As Integer = (Bitmap_Out.Width - Bitmap_Temp.Width) / 2
'Definition de la resolution (dpi)
Bitmap_Out.SetResolution(Resolution, Resolution)
'Remplissage de tout les pixels de la couleur du fond
MyGraphics_Out.FillRectangle(MyBackground, 0, 0,
Bitmap_Out.Width, Bitmap_Out.Height)
'Recopie du bitmap d'entrée en position centrée
MyGraphics_Out.DrawImageUnscaled(Bitmap_Temp, Left, Top,
Bitmap_Temp.Width, Bitmap_Temp.Height)
'Sauvegarde du bitmap de sortie
Bitmap_Out.Save(Destination, ImageFormat.Jpeg)
'Liberation de la mémoire
MyGraphics_out.dispose()
MyGraphics_out = Nothing
Bitmap_Out.Dispose()
Bitmap_Out = Nothing
Else
'Instanciation du Bitmap de sortie
Bitmap_Out = New Bitmap(CInt(Width_Out), CInt(Height_Out),
PixelFormat)
'DĂ©claration de la surface de dessin du bitmap de sortie
Dim MyGraphics_out As Graphics = Graphics.FromImage(Bitmap_Out)
'Recopie du bitmap d'entrée
MyGraphics_Out.DrawImageUnscaled(Bitmap_Temp, 0, 0,
Bitmap_Temp.Width, Bitmap_Temp.Height)
'Sauvegarde du bitmap de sortie
Bitmap_Out.Save(Destination, ImageFormat.Jpeg)
'Liberation de la mémoire
MyGraphics_out.dispose()
MyGraphics_out = Nothing
Bitmap_Out.Dispose()
Bitmap_Out = Nothing
End If
MyGraphics_Temp.Dispose()
MyGraphics_Temp = Nothing
Bitmap_Temp.Dispose()
Bitmap_Temp = Nothing
End Sub
and calling it with the following one :
Reduction(Src, Dest, 221, 142, 72, True, True, PixelFormat.Format24bppRgb,
ImageFormat.Jpeg, 255, 255, 255)
Meanwhile, the quality of the generated thumbnail is not as good as i could
expect. Could this piece of code be optimised, in order to improve the
rendering quality.
Thanks