Voici une source qui prend un fichier image, qui change la propriété Width du fichier et garde les proportion sur Height.
Le resultat est enregistré dans un autre fichier.
PathOrigine -> Fichier d?origine
PathDestination -> Fichier de destination
Int_Width -> Width en pixels
Source / Exemple :
Private Function Redim_Image(ByVal vStr_PathOrigine As String, ByVal vStr_PathDestination As String, ByVal vInt_Width As Integer) As String
Try
'test si fichier existe
If Not IO.File.Exists(vStr_PathOrigine) Then
Return "Le fichier [" & vStr_PathOrigine & "] n'existe pas."
Exit Function
End If
'test le type image
Dim F As New IO.FileInfo(vStr_PathOrigine)
Select Case F.Extension.ToLower
Case ".gif", ".jpg", "jpeg", ".bmp"
'ras c bon
Case Else
Return "Les fichier image d'origne doit avoir l'extension [.gif], [.jpg], [jpeg] ou [.bmp]"
Exit Function
End Select
F = Nothing
'effacer destination
If IO.File.Exists(vStr_PathDestination) Then IO.File.Delete(vStr_PathDestination)
'charge image d'origine
Dim Img As Drawing.Image
Img = Drawing.Image.FromFile(vStr_PathOrigine)
Dim Int_Height As Integer = vInt_Width * Img.Height / Img.Width
Dim B As New Bitmap(vInt_Width, Int_Height)
Dim G As Graphics = Graphics.FromImage(B)
G.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBilinear
G.DrawImage(Img, 0, 0, vInt_Width, Int_Height)
B.Save(vStr_PathDestination, Drawing.Imaging.ImageFormat.Jpeg)
Return String.Empty
Catch ex As Exception
Return ex.Message
End Try
End Function
Conclusion :
Return string.Empty si tout est bon, si non return message d'erreur
Merci de me signaler tt bug
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.