Resize all of the graphic files in a directory in Visual Basic 2005

[nandagopal]

Next the code creates a Graphics object associated with the scaled bitmap. It sets the Graphics object's InterpolationMode property to HighQualityBicubic so the image is resized smoothly. It draws the original image onto the Graphics object, using the original and scaled Rectangles to resize the image.

Finally the program composes a new file name and saves the file in an appropriate format.

Code Select Expand

Private Sub btnGo_Click(ByVal sender As System.Object, _
    ByVal e As System.EventArgs) Handles btnGo.Click
    Dim scale As Single = Val(txtScale.Text)
    If scale = 0 Then
        MessageBox.Show("Scale must not be zero.", "Invalid " & _
            "Scale", MessageBoxButtons.OK, _
            MessageBoxIcon.Error)
        Exit Sub
    End If

    Me.Cursor = Cursors.WaitCursor
    Me.Refresh()

    Dim dir_info As New _
        System.IO.DirectoryInfo(txtDirectory.Text)
    For Each file_info As System.IO.FileInfo In _
        dir_info.GetFiles()
        Try
            Dim ext As String = _
                file_info.Extension.ToLower()
            If ext = ".bmp" OrElse ext = ".gif" OrElse ext _
                = ".jpg" OrElse ext = ".jpeg" Then
                Dim bm As New Bitmap(file_info.FullName)
                picWorking.Image = bm
                Me.Text = "howto_2005_resize_pics - " & _
                    file_info.Name
                Application.DoEvents()

                Dim from_rect As New Rectangle(0, 0, _
                    bm.Width, bm.Height)

                Dim bm2 As New Bitmap(CInt(scale * _
                    bm.Width), CInt(scale * bm.Height))
                Dim dest_rect As New Rectangle(0, 0, _
                    CInt(scale * bm.Width), CInt(scale * _
                    bm.Height))
                Using gr As Graphics = _
                    Graphics.FromImage(bm2)
                    gr.InterpolationMode = _
                        Drawing2D.InterpolationMode.HighQualityBicubic
                    gr.DrawImage(bm, dest_rect, from_rect, _
                        GraphicsUnit.Pixel)
                End Using

                Dim new_name As String = file_info.FullName
                new_name = new_name.Substring(0, _
                    new_name.Length - ext.Length)
                new_name &= "s" & ext
                Select Case ext
                    Case ".bmp"
                        bm2.Save(new_name, _
                            System.Drawing.Imaging.ImageFormat.Bmp)
                    Case ".gif"
                        bm2.Save(new_name, _
                            System.Drawing.Imaging.ImageFormat.Gif)
                    Case ".jpg", "jpeg"
                        bm2.Save(new_name, _
                            System.Drawing.Imaging.ImageFormat.Jpeg)
                End Select
            End If
        Catch ex As Exception
            MessageBox.Show("Error processing file '" & _
                file_info.Name & "'" & vbCrLf & ex.Message, _
                    _
                "Error", _
                MessageBoxButtons.OK, _
                MessageBoxIcon.Error)
        End Try
    Next file_info

    picWorking.Image = Nothing
    Me.Text = "howto_2005_resize_pics"
    Me.Cursor = Cursors.Default
End Sub