Imports System.IO
Imports System.Drawing
Imports System.Windows.Forms
Module Module1
Private items As New List(Of String)
Private ItemCount As Integer
Private processors As New List(Of Imager)
Private QualityOn As Boolean = False
Private BenchmarkOn As Boolean = False
Private Mode As String = String.Empty
Private CustomThreads As Integer = 0
Sub Main()
If My.Application.CommandLineArgs.Count = 0 Then
Console.WriteLine(
"Usage : Drag image files or folders" & vbCrLf & _
"That contain images onto the executable." & vbCrLf & vbCrLf & _
"To benchmark add """ & "-bench""" & " without quotes" & vbCrLf & _
"to the end of this execuable file name" & vbCrLf & vbCrLf & _
"To process in HighQuality add """ & "-q""" & " without quotes" & vbCrLf & _
"to the end of this execuable file name" & vbCrLf & vbCrLf & _
"To specify number of threads add """ & "-thread=""" & " followed by" & vbCrLf & _
"the number of threads to use (no spaces, without quotes)" & vbCrLf & _
"to the end of this execuable file name")
Console.ReadKey()
Exit Sub
End If
Dim appPath As String = Application.ExecutablePath
Dim appNameStartIndex As Integer = appPath.LastIndexOf("\\")
Dim appName As String = _
appPath.Substring(appNameStartIndex + 1, appPath.Length - appNameStartIndex - 1) _
.ToLower.Replace(".exe", String.Empty)
If appName.Contains("-bench") Then
BenchmarkOn = True
Mode &= " Benchmark"
Else
Mode &= " Normal"
End If
If appName.Contains("-q") Then
QualityOn = True
Mode &= " HighQuality"
Else
Mode &= " HighSpeed"
End If
If appName.Contains("-thread=") Then
Dim nameparts() As String = appName.Split("-")
For Each part As String In nameparts
If part.StartsWith("thread=") Then
CustomThreads = part.Split("=")(1)
Exit For
End If
Next
If CustomThreads = 0 Then Mode &= " DefaultThread" Else Mode &= " SetThread=" & CustomThreads
Else
Mode &= " DefaultThread"
End If
For Each arg As String In My.Application.CommandLineArgs
Dim attr As FileAttributes = File.GetAttributes(arg)
If (attr And FileAttributes.Directory) = FileAttributes.Directory _
Then checkSubDirs(arg) Else CheckExt(arg)
Next
ItemCount = items.Count
If items.Count > 0 Then
Dim ItemsCount As Integer = items.Count
Dim PerThreadMinimal As Integer
If CustomThreads > 0 Then PerThreadMinimal = CustomThreads Else PerThreadMinimal = _
If(ItemsCount >= Environment.ProcessorCount, Environment.ProcessorCount, ItemsCount)
For i = 1 To PerThreadMinimal
Dim temp As New Imager(i, QualityOn, BenchmarkOn)
For x = 1 To Math.Floor(ItemsCount / PerThreadMinimal)
temp.Items.Add(items(0))
items.RemoveAt(0)
Next
processors.Add(temp)
Next
For Each imageproc As Imager In processors
If items.Count > 0 Then
imageproc.Items.Add(items(0))
items.RemoveAt(0)
End If
Next
Console.WriteLine("Mode :" & Mode & vbCrLf & _
"Images to process : " & ItemsCount & vbCrLf & _
"Threads used for processing : " & processors.Count & vbCrLf & _
"Processing please wait...")
For Each imgproc As Imager In processors : imgproc.Start() : Next
End If
If BenchmarkOn Then Console.ReadKey()
End Sub
Private Sub checkSubDirs(input As String)
For Each file As String In My.Computer.FileSystem.GetFiles(input) : CheckExt(file) : Next
For Each dir As String In My.Computer.FileSystem.GetDirectories(input) : checkSubDirs(dir) : Next
End Sub
Private Sub CheckExt(input As String)
Dim imageExt As Integer = input.LastIndexOf(".")
Dim Ext As String = input.Substring(imageExt, input.Length - imageExt).ToLower
Select Case Ext
Case ".jpg", ".jpeg", ".bmp", ".tiff", ".png", ".gif"
items.Add(input)
End Select
End Sub
End Module
Public Class Imager
Public Items As New List(Of String)
Public ThreadNbr As Integer = 0
Private NbrProc As Integer = 0
Private ThreadTimer As Stopwatch
Private Quality_On As Boolean = False
Private Benchmark_On As Boolean = False
Public Sub Start()
Dim WorkThread As New Threading.Thread(AddressOf Work)
WorkThread.Start()
End Sub
Private Sub Work()
If Items.Count > 0 Then
Dim tempbitmap As New Bitmap(460, 215)
Dim tempgfx As Graphics
Dim pathParts() As String
Dim SavePath As String = String.Empty
Dim finalPath As String = String.Empty
Dim indexCount As Integer = 0
Dim skip As Boolean = False
tempgfx = Graphics.FromImage(tempbitmap)
If Quality_On Then
tempgfx.InterpolationMode = Drawing2D.InterpolationMode.HighQualityBicubic
tempgfx.SmoothingMode = Drawing2D.SmoothingMode.HighQuality
tempgfx.PixelOffsetMode = Drawing2D.PixelOffsetMode.HighQuality
tempgfx.CompositingQuality = Drawing2D.CompositingQuality.HighQuality
Else
tempgfx.InterpolationMode = Drawing2D.InterpolationMode.Low
tempgfx.SmoothingMode = Drawing2D.SmoothingMode.None
tempgfx.PixelOffsetMode = Drawing2D.PixelOffsetMode.None
tempgfx.CompositingQuality = Drawing2D.CompositingQuality.HighSpeed
End If
If Benchmark_On Then ThreadTimer = Stopwatch.StartNew
For i = 0 To Items.Count - 1
On Error Resume Next
indexCount = 0
SavePath = String.Empty
pathParts = Items(i).Split("\\")
For x = 0 To pathParts.Length - 2 : SavePath &= pathParts(x) & "\\" : Next
Dim sourceImage = New Bitmap(Items(i))
tempgfx.DrawImage(sourceImage, New Rectangle(0, 0, 460, 215))
finalPath = SavePath & pathParts(pathParts.Length - 1).Split(".")(0) & " - Resized.png"
Do While IO.File.Exists(finalPath)
indexCount += 1
finalPath = SavePath & pathParts(pathParts.Length - 1).Split(".")(0) & _
" - Resized (" & indexCount.ToString & ").png"
Loop
tempbitmap.Save(finalPath, Imaging.ImageFormat.Png)
sourceImage.Dispose()
NbrProc += 1
System.GC.Collect()
Next
ThreadTimer.Stop()
If Benchmark_On Then _
Console.WriteLine("Thread " & ThreadNbr & " : " & NbrProc & " in " & _
ThreadTimer.Elapsed.TotalSeconds & " seconds")
Else
Console.WriteLine("Thread " & ThreadNbr & " : N/A")
End If
End Sub
Public Sub New(Thread_Number As Integer, QualityOn As Boolean, benchmarkOn As Boolean)
ThreadNbr = Thread_Number
Quality_On = QualityOn
Benchmark_On = benchmarkOn
End Sub
End Class