'Coded by vinay
Imports System.Drawing.Imaging
Public Class BatchImageResizer
Dim mypicturefolder As String
Private Sub ListBox1_DragEnter(ByVal sender As Object, ByVal e As _
System.Windows.Forms.DragEventArgs) Handles ListBox1.DragEnter
If e.Data.GetDataPresent(DataFormats.FileDrop) Then
e.Effect = DragDropEffects.Move
End If
End Sub
Private Sub ListBox1_DragDrop(ByVal sender As Object, ByVal e As _
System.Windows.Forms.DragEventArgs) Handles ListBox1.DragDrop
If e.Data.GetDataPresent(DataFormats.FileDrop) Then
Dim MyFiles() As String, flag As Boolean = False
Dim i As Integer, j As Integer
' Assign the files to an array.
MyFiles = e.Data.GetData(DataFormats.FileDrop)
' Loop through the array and add the files to the list.
For i = 0 To MyFiles.Length - 1
Dim extensionchk As String = Mid(MyFiles(i), Len(MyFiles(i)) - 2, 3)
If StrComp(extensionchk, "jpg", CompareMethod.Text) = 0 Or StrComp(extensionchk, "png", CompareMethod.Text) = 0 _
Or StrComp(extensionchk, "bmp", CompareMethod.Text) = 0 Or StrComp(extensionchk, "gif", CompareMethod.Text) = 0 Or StrComp(extensionchk, "ico", CompareMethod.Text) = 0 Then 'check for image file
If ListBox1.Items.Count <> 0 Then 'if listbox1 is not empty
For j = 0 To ListBox1.Items.Count - 1
If ListBox1.Items(j) = MyFiles(i) Then 'check if file is already added the skip
flag = True
Exit For
Else
flag = False
End If
Next
If flag = False Then 'if file is not already present then add to the list
ListBox1.Items.Add(MyFiles(i))
End If
Else
ListBox1.Items.Add(MyFiles(i)) 'for first item in the list
End If
End If
Next 'closing of outer loop
End If
End Sub
Private Sub vinay_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
On Error Resume Next
regaccessfortemp() ' get the 'My picture' folder and create directory for resized images
PictureBox7_MouseLeave(sender, e) 'set image to the picture box7
BackgroundImage = Image.FromFile(Application.StartupPath & "\pic\bak1.png").Clone
PictureBox1.Image = Image.FromFile(Application.StartupPath & "\pic\resize1.png")
PictureBox2.Image = Image.FromFile(Application.StartupPath & "\pic\info.png")
TextBox1.Text = 0
TextBox2.Text = 0
End Sub
Private Sub BatchImageResizerfun(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(TextBox2.Text) 'image width.
Dim height As Integer = Integer.Parse(TextBox1.Text) 'image height
Dim thumb As New Bitmap(width, height)
Dim g As Graphics = Graphics.FromImage(thumb)
g.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
g.DrawImage(bm, New Rectangle(0, 0, width, height), New Rectangle(0, 0, bm.Width, bm.Height), GraphicsUnit.Pixel)
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 "tiff"
thumb.Save(bmname & ".tiff", 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
Private Sub regaccessfortemp()
Dim rk1 As Microsoft.Win32.RegistryKey
Dim getval As String
mypicturefolder = ""
rk1 = Microsoft.Win32.Registry.CurrentUser.OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", False)
getval = rk1.GetValue("My Pictures", "NULL")
rk1.Close()
If getval = "NULL" Then
MsgBox("Didn't find the path of the 'My Pictures' folder", MsgBoxStyle.Critical + MsgBoxStyle.OkOnly, "Folder not found")
Exit Sub
End If
mypicturefolder = getval & "\Wallpaperchanger\BIR\" & Now.Day & Now.Month & Now.Year
Microsoft.VisualBasic.FileIO.FileSystem.CreateDirectory(mypicturefolder) 'create folder named as current date
End Sub
Private Sub BatchImageResizer_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
formpaint()
End Sub
Private Sub PictureBox7_MouseHover(ByVal sender As Object, ByVal e As System.EventArgs) Handles PictureBox7.MouseHover
PictureBox7.Image = Image.FromFile(Application.StartupPath & "\pic\close_hover.png")
End Sub
Private Sub PictureBox7_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles PictureBox7.MouseLeave
PictureBox7.Image = Image.FromFile(Application.StartupPath & "\pic\close_normal.png")
End Sub
Private Sub PictureBox7_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PictureBox7.Click
PictureBox7.Image = Image.FromFile(Application.StartupPath & "\pic\close_pressed.png")
Me.Close()
End Sub
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim i As Integer
If ListBox1.Items.Count = 0 Or Int16.Parse(TextBox1.Text) = 0 Or Int16.Parse(TextBox2.Text) = 0 Then
Exit Sub
End If
CheckedListBox1.Items.Clear()
For i = 0 To ListBox1.Items.Count - 1
BatchImageResizerfun(ListBox1.Items(i))
Next
ListBox1.Items.Clear()
CheckedListBox1_Click(sender, e)
End Sub
Private Sub TextBox2_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles TextBox2.KeyPress
If e.KeyChar = vbBack Then
Exit Sub
ElseIf e.KeyChar = " " Or (e.KeyChar < Chr(48) Or e.KeyChar > Chr(57)) Then
e.KeyChar = Chr(0)
End If
End Sub
Private Sub TextBox2_LostFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox2.LostFocus
If TextBox2.Text = "" Then
TextBox2.Text = 0
End If
End Sub
Private Sub TextBox1_KeyPress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs) Handles TextBox1.KeyPress
If e.KeyChar = vbBack Then
Exit Sub
ElseIf e.KeyChar = " " Or (e.KeyChar < Chr(48) Or e.KeyChar > Chr(57)) Then
e.KeyChar = Chr(0)
End If
End Sub
Private Sub TextBox1_LostFocus(ByVal sender As Object, ByVal e As System.EventArgs) Handles TextBox1.LostFocus
If TextBox1.Text = "" Then
TextBox1.Text = 0
End If
End Sub
Private Sub TextBox2_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox2.TextChanged
Label5.Text = TextBox2.Text
End Sub
Private Sub TextBox1_TextChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles TextBox1.TextChanged
Label7.Text = TextBox1.Text
End Sub
Private Sub CheckedListBox1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles CheckedListBox1.Click
Shell("explorer " & mypicturefolder, AppWinStyle.MaximizedFocus)
End Sub
Private Sub ListBox1_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles ListBox1.MouseEnter
ToolTip1.Show("Drag and Drop files that you want to resize them", ListBox1)
End Sub
Private Sub CheckedListBox1_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles CheckedListBox1.MouseEnter
ToolTip1.Show("Click to open the destination folder", CheckedListBox1)
End Sub
Public Sub formpaint()
Dim gp As New System.Drawing.Drawing2D.GraphicsPath
Dim r1 As New Rectangle(0, Me.Height - 10, 10, 10)
Dim r2 As New Rectangle(Me.Width - 11, Me.Height - 10, 10, 10)
'creating the upper Arc
gp.AddArc(0, 0, 10, 10, 180, 90)
gp.AddArc(Me.Width - 11, 0, 10, 10, 270, 90)
'Creating the Body
gp.AddRectangle(New Rectangle(0, 5, Me.Width, Me.Height - 10))
'creating the lower Arc
gp.AddArc(r1, -270, 90)
gp.AddArc(r2, 360, 90)
Me.Region = New Region(gp)
End Sub
Private Sub ToolStripMenuItem2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ToolStripMenuItem2.Click
If ListBox1.SelectedIndex >= 0 Then
ListBox1.Items.Remove(ListBox1.Items(ListBox1.SelectedIndex))
End If
End Sub
Private Sub PictureBox2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PictureBox2.Click
Dim f As New about
f.Show()
End Sub
Private Sub PictureBox2_MouseHover(ByVal sender As Object, ByVal e As System.EventArgs) Handles PictureBox2.MouseHover
PictureBox2.Image = Image.FromFile(Application.StartupPath & "\pic\info1.png")
End Sub
Private Sub PictureBox2_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles PictureBox2.MouseLeave
PictureBox2.Image = Image.FromFile(Application.StartupPath & "\pic\info.png")
End Sub
End Class
We use cookies to provide and improve our services. By using our site, you consent to our Cookies Policy. Accept Learn more
