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
Try
'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
Finally
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
gfx.Dispose()
End If
End Try
End FunctionJust 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
Try
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)
InitAmountDisplay()
End If
End With
Catch ex as Exception
Msgbox(Ex.Tostring)
Finally
If Not f Is Nothing Then
f.Dispose()
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
InitAmountDisplay()
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
Try
pbDemo.Image = AspectResizeImage(img, _
Integer.Parse(txtAmount.Text), _
chkUseWidth.Checked)
Catch ex As Exception
MsgBox(ex.ToString)
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
'width
txtAmount.Text = .Width.ToString
Else
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 added to smithvoice january 2005 | 