Browse DevX
Sign up for e-mail newsletters from DevX

Tip of the Day
Language: VB7
Expertise: Intermediate
Nov 3, 2003



Building the Right Environment to Support AI, Machine Learning and Deep Learning

ResizeImage - Resize an image, and optionally keep the original ratio automatically

' Resize the specified image file - The new dimensions are expressed in 
' percentage of the original size.
' The resized image overwrites the original file.
' Note: requires the GetImageFormat function
' Example:
'    ResizeImage("D:\sample.gif", 50.0, 50.0) ' make the image half the 
' original size
'    ResizeImage("D:\sample.gif", 200.0, 300.0) ' double the width and triple 
' the height

Sub ResizeImage(ByVal imgPath As String, ByVal widthPerc As Double, _
    ByVal heightPerc As Double)
    ' throw an exception if not both arguments are positive values
    If widthPerc <= 0 OrElse heightPerc <= 0 Then
        Throw New ArgumentException("widthPerc AND heightPerc arguments must be " _
            & "positive values")
    End If

    Dim currWidth, currHeight As Integer
    Dim newWidth, newHeight As Integer
    ' get the image's current width/height
    Dim img As System.Drawing.Image = System.Drawing.Image.FromFile(imgPath)
    currWidth = img.Width
    currHeight = img.Height
    ' calculate the new size in pixel
    newWidth = currWidth * widthPerc / 100
    newHeight = currHeight * heightPerc / 100
    ' call the overloaded method that takes explicit width/height in pixels
    ResizeImage(imgPath, newWidth, newHeight)
End Sub

' This overloaded version takes the new width/height in pixel,
'  instead of the percentage of the original size.
' Either the width/height (but not both) can be 0,
'  and the size will be calculate to maintain the ratio of the original image
' Example:
'    ResizeImage("D:\sample.gif", 100, 50) ' resize to 100x50
'    ResizeImage("D:\sample.gif", 100, 0)  ' the height will be calculated 
' according to the new width

Sub ResizeImage(ByVal imgPath As String, ByVal width As Integer, _
    ByVal height As Integer)
    ' throw an exception if both arguments are not positive integers
    If width <= 0 AndAlso height <= 0 Then
        Throw New ArgumentException("Width and/or Height arguments must be " _
            & "positive integers")
    End If

    ' select the format of the image to write according to the current extension
    Dim imgFormat As System.Drawing.imaging.ImageFormat = GetImageFormat _
    ' open the image file
    Dim img As System.Drawing.Image = System.Drawing.Image.FromFile(imgPath)

    ' if either the specified height or width are 0, calculate it to maintain 
    ' the same ratio of the original image
    If width <= 0 OrElse height <= 0 Then
        If width <= 0 Then
            width = img.Width / (img.Height / height)
        ElseIf height <= 0 Then
            height = img.Height / (img.Width / width)
        End If
    End If

    ' create a new empty bitmpat with the specified size
    Dim bmp As New System.Drawing.Bitmap(width, height)
    ' retrieve a canvas object that allows to draw on the empty bitmap
    Dim g As System.Drawing.Graphics = System.Drawing.Graphics.FromImage( _
        DirectCast(bmp, System.Drawing.Image))
    ' copy the original image on the canvas, and thus on the new bitmap,
    '  with the new size
    g.DrawImage(img, 0, 0, width, height)
    ' close the original image
    ' save the new image with the proper format
    bmp.Save(imgPath, imgFormat)
End Sub
Marco Bellinaso
Comment and Contribute






(Maximum characters: 1200). You have 1200 characters left.



Thanks for your registration, follow us on our social networks to keep up-to-date