An Updated Batch Image Resize Tool

• Download BatchResizeImageWF.zip - 21.3 KB

Introduction

This tool is modified from Hassanoor's Batch Image Resizer. http://www.codeproject.com/Articles/208738/Batch-Image-Resizer . The original article didn't provide the design and the project files. I added those back in. I also added the "Resize Canvas Only' function. So if the source image is smaller than the destination image, it will place it in the center. If the source image is larger, then it will be cropped. I need this function for my job.

Using the code

The following function is the new capability I added to resize the canvas only, the rest is similar to the original article.

Private Sub BatchImageResizeCanvasOnly(ByVal strr As String)
        'following code resizes picture to fit
        Dim bm As New Bitmap(strr)
        Dim i As Integer

        Dim str11 As String = Mid(strr, Len(strr) - 2, 3)

        Dim bmname As String = ""
        Dim c As Char = Nothing

        For i = 4 To Len(strr)
            c = Mid(strr, Len(strr) - i, 1)
            If c = Char.Parse("\") Then
                Exit For
            End If
            bmname = bmname + c
        Next

        bmname = mypicturefolder & "\" & StrReverse(bmname)

        Dim width As Integer = Integer.Parse(TextBox1.Text)  'image width. 
        Dim height As Integer = Integer.Parse(TextBox2.Text)   'image height

        Dim thumb As New Bitmap(width, height)
        Dim g As Graphics = Graphics.FromImage(thumb)

        Dim sx = Math.Abs(width - bm.Width) >> 1
        Dim sy = Math.Abs(height - bm.Height) >> 1

        g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
        If (width >= bm.Width And height >= bm.Height) Then
            g.DrawImage(bm, New Rectangle(sx, sy, bm.Width, bm.Height), New Rectangle(0, 0, bm.Width, bm.Height), GraphicsUnit.Pixel)
        ElseIf (width <= bm.Width And height <= bm.Height) Then
            g.DrawImage(bm, New Rectangle(0, 0, width, height), New Rectangle(sx, sy, width, height), GraphicsUnit.Pixel)
        ElseIf (width >= bm.Width And height <= bm.Height) Then
            g.DrawImage(bm, New Rectangle(sx, 0, bm.Width, height), New Rectangle(0, sy, bm.Width, height), GraphicsUnit.Pixel)
        Else
            g.DrawImage(bm, New Rectangle(0, sy, width, bm.Height), New Rectangle(sx, 0, width, bm.Height), GraphicsUnit.Pixel)
        End If
        g.Dispose()

        Try
            Select Case Strings.LCase(str11) 'save the file to their correspoding format after resize
                Case ""
                    Exit Sub
                Case "bmp"
                    thumb.Save(bmname & ".bmp", Imaging.ImageFormat.Bmp)
                Case "jpg"
                    thumb.Save(bmname & ".jpg", Imaging.ImageFormat.Jpeg)
                Case "gif"
                    thumb.Save(bmname & ".gif", Imaging.ImageFormat.Gif)
                Case "ico"
                    thumb.Save(bmname & ".ico", Imaging.ImageFormat.Icon)
                Case "png"
                    thumb.Save(bmname & ".png", Imaging.ImageFormat.Png)
                Case "tif"
                    thumb.Save(bmname & ".tif", Imaging.ImageFormat.Tiff)
                Case "wmf"
                    thumb.Save(bmname & ".wmf", Imaging.ImageFormat.Wmf)
            End Select
            CheckedListBox1.Items.Add(bmname & "." & str11, True) 'the file is resized
        Catch ex As Exception
            '   MsgBox(ex.Message, MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "Warning!!")
            CheckedListBox1.Items.Add(bmname & "." & str11, False) 'the file is not resized
        End Try


        bm.Dispose()
        thumb.Dispose()

    End Sub

Points of Interest

History