Imports System.Drawing.Imaging
Imports System.Drawing.Drawing2D
 
Module resize
 
    Sub main()
 
        Dim Quelldatei As String = "bild.jpg"   'Dateiname des Herkunftsbildes
        Dim Zieldatei As String = "bild_1.jpg" 'Dateiname des zu 
        ' konvertierenden Bildes
        Dim Kantenlänge As Integer = 250        'die maximale Kantenlänge der 
        ' neuen Bildes
        Dim Qualität As Long = 80               'die Kompressionsrate 100 = 
        ' keine, 1 = maximale Kompression
 
        ' ImageCodecInfo-Objekt erstellen, das dem JPEG-Codec entspricht.
        Dim JpegCodec As ImageCodecInfo = GetEncoderInfo("image/jpeg")
 
        ' Array erstellen, das alle Encoding-Parameter beinhaltet,
        ' in diesem Fall beinhaltet es nur den Quality-Parameter.
        Dim Kompression As New EncoderParameters(1)
        Kompression.Param(0) = New EncoderParameter(Encoder.Quality, Qualität)
 
        'das Originalbild laden
        Dim Originalbild As Image = Originalbild.FromFile(Quelldatei, True)
 
        'proportionale Berechnung des neuen Bildes
        Dim ResampleBreite As Integer
        Dim ResampleHöhe As Integer
 
        If Originalbild.Width > Originalbild.Height Then
            ResampleBreite = Kantenlänge
            ResampleHöhe = CInt((Kantenlänge / Originalbild.Width) * _
              Originalbild.Height)
        Else
            ResampleHöhe = Kantenlänge
            ResampleBreite = CInt((Kantenlänge / Originalbild.Height) * _
              Originalbild.Width)
        End If
 
        'ein neues Bitmap-Objekt mit den errechneten Maßen erstellen
        Dim KonvertiertesBild As New Bitmap(ResampleBreite, ResampleHöhe)
 
        'ein neues Grafikobjekt erstellen
        Dim Grafik As Graphics = Graphics.FromImage(KonvertiertesBild)
 
        'die Qualität des Resamplings festlegen
        Grafik.InterpolationMode = InterpolationMode.High
 
        'das neue Bild zeichnen
        Grafik.DrawImage(Originalbild, 0, 0, ResampleBreite, ResampleHöhe)
 
        'das konvertierte Bild speichern
        KonvertiertesBild.Save(Zieldatei, JpegCodec, Kompression)
 
        End
 
    End Sub
 
    Private Function GetEncoderInfo(ByVal mimeType As String) As ImageCodecInfo
        Dim i As Integer
        Dim Encoders() As ImageCodecInfo = ImageCodecInfo.GetImageEncoders()
        For i = 0 To Encoders.Length - 1
            If Encoders(i).MimeType = mimeType Then
                Return Encoders(i)
            End If
        Next
        Return Nothing
    End Function
 
End Module