Y'herd thisun? 

“I’m nauseatingly pro-American. It is where great things are possible.”

by Elon Musk

Aspect correct resizing

TaggedCoding, Imaging

You ever have one of those functions that you've created a hundred times in the past and every time you think you'll need it on a new project you say to yourself "I've done that a hundred times, no problem" then when you get around to typing it you sit there and scratch you head and say 'Now ... how do I do that again?" This is ours.

Use this function to resize an image to a specific width or height and keep the aspect ratio correct.

To cut down the "dots", the module or class or form holding the function needs the typical Drawing/Imaging namespaces...

Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.Drawing.Drawing2D

And here's the routine ...


Public Function AspectResizeImage(ByVal sourceImage As Image, _
ByVal maxSize As Integer, _
Optional ByVal ByWidth As Boolean = True) _
As Image
Dim ratio As Single = 1
Dim newWidth, newHeight As Integer
Dim bmpSource As Bitmap
Dim bmpDest As Bitmap
Dim gfx As Graphics
'curb against out of memory issues
'by just keeping things in a realistic range
If maxSize < 1 Or maxSize > 5000 Then
Throw New ArgumentOutOfRangeException("MaxSize", _
MaxSize, _
"Maximum size must be between 1 and 5000 pixels")
End If
bmpSource = New Bitmap(sourceImage)
ratio = CSng(bmpSource.Width / bmpSource.Height)
If ByWidth Then
newWidth = maxSize
newHeight = CInt(maxSize / ratio)
Else 'by height
newWidth = CInt(maxSize * ratio)
newHeight = maxSize
End If
'make bitmap for result
bmpDest = New Bitmap(newWidth, newHeight)
'create Graphics object for final bitmap
gfx = Graphics.FromImage(bmpDest)
gfx.InterpolationMode = InterpolationMode.HighQualityBicubic
'blast the source image into the dest
gfx.DrawImage(bmpSource, 0, 0, bmpDest.Width, bmpDest.Height)
Return DirectCast(bmpDest.Clone, Image)
Catch ex As OutOfMemoryException
Throw ex
Catch ex As ArgumentOutOfRangeException
Throw ex
Catch ex As Exception
'ToDo: remove after complete testing
Throw ex
If Not (sourceImage Is Nothing) Then
sourceImage.Dispose() ' get rid of the old one if it exists.
End If
If Not (bmpSource Is Nothing) Then
bmpSource.Dispose() ' get rid of the old one if it exists.
End If
If Not (bmpDest Is Nothing) Then
bmpDest.Dispose() ' get rid of the old one if it exists.
End If
If Not gfx Is Nothing Then
End If
End Try
End Function


Just pass in the original image and give a MAX value and specify whether that value is for the width or the height (Width is obviosuly the default) and out pops the aspect correct copy.

Generally it's just figuring the relationship between the original width and height then applying that to the correct dimension of the DrawImage resizing.

We use InterpolationMode.HighQualityBicubic because the rule of thumb is that it's the highest quality of all stock mode options, but it's also the most processor intensive. We've never seen it being a big deal on most systems but if you hit a performance drag, try dropping it down to HighQualityLinear. (Some people think Linear is crisper, pick your favorite or even add an InterpolationMode argument and let your users choose)

In our experience it's best to limit the MAX to a realistic range to avoid memory problems, hence the ArgumentOutOfRangeException. Make sure you set traps for exceptions. To reduce overhead, it'd be a good idea to test it out hard under your real needs to discover all of the exact exceptions that your situation could throw and add them to the Catch list then take out the generic Catch-All.

To see it in action, add a picturebox to a form, name it pbDemo. Add a textbox named txtAmount with a default value of 1, and a checkbox named chkUseWidth. Now add three buttons named butGetFile, butReset and butResize. Stick the following code in the button_click events:


Private Sub butGetFile_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles butGetFile.Click
Dim f As New OpenFileDialog
With f
.Filter = "Image Files|*.bmp;*.gif;*.jpg;*.png"
If .ShowDialog = DialogResult.OK Then
 pbDemo.Image = Image.FromFile(.FileName)
 'stick a distinct image object into the tag as a backup
 pbDemo.Tag = Image.FromFile(.FileName)
End If
End With
Catch ex as Exception
If Not f Is Nothing Then
 f = Nothing
End If
End Try
End sub
Private Sub butReset_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles butReset.Click
If Not pbDemo.Tag is Nothing Then 
Dim img As Image = DirectCast(pbDemo.Tag, Image)
img = DirectCast(img.Clone, Image)
pbDemo.Image = img
End If
End sub
Private Sub butResize_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles butResize.Click
If Not pbDemo.Tag is Nothing Then 
Dim img As Image = DirectCast(pbDemo.Tag, Image)
img = DirectCast(img.Clone, Image)
If IsNumeric(txtAmount.Text) Then
 pbDemo.Image = AspectResizeImage(img, _
 Integer.Parse(txtAmount.Text), _
Catch ex As Exception
End Try
End If
End If
End Sub
'oh, and you'll want this too...
Private Sub InitAmountDisplay()
With pbDemo.Image
If chkUseWidth.Checked Then
txtAmount.Text = .Width.ToString
txtAmount.Text = .Height.ToString
End If
End With
End Sub


For this example, we stick a distinct copy of the image into the picturebox tag so you can keep playing with the code over and over based on the original. If you want to base tests on previous settings to see how long it takes to degrade the image just cut the tag support and in/out using picturebox's image object.

There, that's going to save us re-inventing that stupid wheel for the hundred and first time. And if you get use out of it, so much the better. :)

Robert Smith
Kirkland, WA

home     who is smith    contact smith     rss feed π
Since 1997 a place for my stuff, and it if helps you too then all the better