Private Sub Resizing()
Dim ThumbWidth As Double = 150
Dim ThumbHeight As Double = 200
Dim ThumbFolder As String = "myfolder goes here"
Dim inp As New IntPtr
Try
For Each picFile In IO.Directory.GetFiles("my image folder goes here")
Dim fileEXT As String = IO.Path.GetExtension(picFile)
If fileEXT = ".jpg" Then
Dim FileUseName As String = IO.Path.GetFileName(picFile)
Dim ThumbPicture As String = ThumbFolder & FileUseName
Dim Bigfileinfo As Image = Image.FromFile(picFile)
Dim NewFileThumb As Image = Nothing
If Bigfileinfo.Height > Bigfileinfo.Width Then
NewFileThumb = ResizeImage(Bigfileinfo, ThumbWidth, ThumbHeight)
NewFileThumb.Save(ThumbPicture)
Else
NewFileThumb = ResizeImage(Bigfileinfo, ThumbHeight, ThumbWidth)
NewFileThumb.Save(ThumbPicture)
End If
End If
Next
MessageBox.Show("Done")
Catch ex As Exception
MessageBox.Show(ex.Message, "Error resizing pictures" _
, MessageBoxButtons.OK _
, MessageBoxIcon.Information)
End Try
End Sub
Public Shared Function ResizeImage(ByVal originalImage As System.Drawing.Image, ByVal width As Integer, ByVal height As Integer) As System.Drawing.Image
Dim finalImage As System.Drawing.Image = New Bitmap(width, height)
Dim graphic As Graphics = Graphics.FromImage(finalImage)
graphic.CompositingQuality = System.Drawing.Drawing2D.CompositingQuality.HighQuality
graphic.SmoothingMode = System.Drawing.Drawing2D.SmoothingMode.HighQuality
graphic.InterpolationMode = System.Drawing.Drawing2D.InterpolationMode.HighQualityBicubic
Dim rectangle As New Rectangle(0, 0, width, height)
graphic.DrawImage(originalImage, rectangle)
Return finalImage
End Function
|