The problem is that the resizing quality never really looked that great, and to maintain proportions it would calculate which is larger, the width or height, and calculate the difference in the smaller dimension which would result in an image that was no more than the width or height specified in the parameters, but the smaller dimension would be ignored. That's fine and all but I really would rather it use the actual width and height specified by the person calling the function, without contorting the image, adding whitespace to the smaller dimension, the equivalent of using both Image Size and then Canvas Size in Photoshop. So I finally got around to making it better! The System.Drawing.Graphics namespace has a ton of features to get the job done, and it's all using the standard .NET libraries.
Here is the final product:
Function ResizeImage(ByVal sFilename As String, ByVal iMaxW As Integer, ByVal iMaxH As Integer) As String
Dim imgPhoto As System.Drawing.Image = Drawing.Image.FromFile(sFilename)
Dim x, y, x2, y2, x3, y3 As Integer
Dim xD, yD As Double
x = imgPhoto.Width
y = imgPhoto.Height
xD = x / iMaxW
yD = y / iMaxH
If xD > yD Then
x2 = iMaxW
y2 = y * (iMaxW / x)
Else
y2 = iMaxH
x2 = x * (iMaxH / y)
End If
Dim imgOutput As New System.Drawing.Bitmap(x2, y2)
Dim g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage(imgOutput)
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
g.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
g.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
g.CompositingQuality = Drawing2D.CompositingQuality.HighQuality
g.DrawImage(imgPhoto, 0, 0, x2, y2)
Dim imgExact As New Bitmap(iMaxW, iMaxH)
Dim gE As Graphics = Graphics.FromImage(imgExact)
gE.Clear(Color.FromArgb(-1))
x3 = (iMaxW / 2) - (imgOutput.Width / 2)
y3 = (iMaxH / 2) - (imgOutput.Height / 2)
Dim rDest As New Rectangle(x3, y3, imgOutput.Width, imgOutput.Height)
gE.DrawImage(imgOutput, rDest, 0, 0, imgOutput.Width, imgOutput.Height, Drawing.GraphicsUnit.Pixel)
Dim sExt As String = Path.GetExtension(sFilename).ToLower
Dim sNewFilename As String = Replace(sFilename.ToLower, sExt, "_" & iMaxW & "x" & iMaxH & sExt)
Select Case sExt
Case ".jpg"
Dim info() As ImageCodecInfo = ImageCodecInfo.GetImageEncoders()
Dim enc As EncoderParameters = New EncoderParameters(1)
enc.Param(0) = New EncoderParameter(Encoder.Quality, 100L)
imgExact.Save(sNewFilename, info(1), enc)
Case ".gif"
imgExact.Save(sNewFilename, Drawing.Imaging.ImageFormat.Gif)
Case ".png"
imgExact.Save(sNewFilename, Drawing.Imaging.ImageFormat.Png)
End Select
imgOutput.Dispose()
imgPhoto.Dispose()
imgExact.Dispose()
imgPhoto = Nothing
imgOutput = Nothing
imgExact = Nothing
Return sNewFilename
End Function
