CODEWITHSUNDEEP
vb.netimage-processinggraphicsbitmapsystem.drawing
Jamie Hartnoll
Jamie Hartnoll

Reputation: 7341

Resizing, compressing and smoothing images with VB.net

I've spent quite a long time Googling this and read various articles but I seem to have run myself round in circles and am now very confused, and don't seem to have managed to get anywhere!

I am trying to get 4 different sized versions of an image, to achieve this, I have an array of sizes and am looping the function below.

This works, and does everything expected, except, the smaller images are very blocky and I can't get the smoothing to achieve the effect I'd expect.

With old-school ASP Classic, I used Persits ASPUpload/jpeg plugin and it did nice, smooth resizing. With .NET I am struggling.

Public Shared Sub ResizeImages(FileName, NewFileName, maxWidth, maxHeight, uploadDir, qualityPercent)

    Dim originalImg As System.Drawing.Image = System.Drawing.Image.FromFile(uploadDir & FileName)

    Dim aspectRatio As Double
    Dim newHeight As Integer
    Dim newWidth As Integer

    '*** Calculate Size ***'
    If originalImg.Width > maxWidth Or originalImg.Height > maxHeight Then
        If originalImg.Width >= originalImg.Height Then ' image is wider than tall
            newWidth = maxWidth
            aspectRatio = originalImg.Width / maxWidth
            newHeight = originalImg.Height / aspectRatio
        Else ' image is taller than wide
            newHeight = maxHeight
            aspectRatio = originalImg.Height / maxHeight
            newWidth = originalImg.Width / aspectRatio
        End If
    Else ' if image is not larger than max then keep original size
        newWidth = originalImg.Width
        newHeight = originalImg.Height
    End If

    Dim newImg As New Bitmap(originalImg, CInt(newWidth), CInt(newHeight)) '' blank canvas
    Dim canvas As Graphics = Graphics.FromImage(newImg) 'graphics element

    '*** compress ***'
    Dim myEncoderParameters As EncoderParameters
    myEncoderParameters = New EncoderParameters(1)
    ' set quality level based on "resolution" variable
    Dim myEncoderParameter = New EncoderParameter(System.Drawing.Imaging.Encoder.Quality, CType(qualityPercent, Int32))
    myEncoderParameters.Param(0) = myEncoderParameter

    '*** Save As  ***'
    canvas.SmoothingMode = Drawing.Drawing2D.SmoothingMode.AntiAlias
    canvas.DrawImage(newImg, New Point(0, 0))
    newImg.Save(uploadDir & NewFileName, getCodec("image/jpeg"), myEncoderParameters)

    '*** Close ***'
    originalImg.Dispose()
    newImg.Dispose()
    '*** Nothing ***'
    newImg = Nothing
    originalImg = Nothing

End Sub

Public Shared Function getCodec(getThis) As Drawing.Imaging.ImageCodecInfo
    Dim output As Drawing.Imaging.ImageCodecInfo
    Dim codecs As Imaging.ImageCodecInfo() = Imaging.ImageCodecInfo.GetImageEncoders
    For Each codec As Imaging.ImageCodecInfo In codecs
        If codec.MimeType = getThis Then
            output = codec
        End If
    Next codec
    Return output
End Function

I feel like I might be mixing up Types here?

I have a System.Drawing.Image, a BitMap and a Graphic object during the course of the function above, and feel that I might be trying to apply to the smoothing to the wrong element, or at the wrong stage of the coding?

The System.Drawing.Image object loads the file that's saved on the server, then I calculate the aspect ratio and new size required, create a new BitMap of this size and save it to a Graphics object.

Is this correct?

What do I need to amend to achieve a smoother resize?

As usual, any help much appreciated.

Upvotes: 0

Views: 21377

Answers (1)

Chachi
Chachi

Reputation: 164

try use InterpolationMode

Private imgSource As System.Drawing.Image
Private imgOutput As System.Drawing.Image
Public Function Resize(ByVal intPercent As Integer, ByVal intType As Integer)
    'resize the image by percent
    Dim intX, intY As Integer
    intX = Int(imgSource.Width / 100 * intPercent)
    intY = Int(imgSource.Height / 100 * intPercent)
    Dim bm As Drawing.Bitmap = New System.Drawing.Bitmap(intX, intY)
    Dim g As System.Drawing.Graphics = Drawing.Graphics.FromImage(bm)

    Select Case intType
        Case 0
            g.InterpolationMode = Drawing.Drawing2D.InterpolationMode.Default
        Case 1
            g.InterpolationMode = Drawing.Drawing2D.InterpolationMode.High
        Case 2
            g.InterpolationMode = Drawing.Drawing2D.InterpolationMode.HighQualityBilinear
        Case 3
            g.InterpolationMode = Drawing.Drawing2D.InterpolationMode.HighQualityBicubic
    End Select

    g.DrawImage(imgSource, 0, 0, intX, intY)
    imgOutput = bm

End Function

Upvotes: 2

Related Questions