Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement