Ứng dụng resize ảnh hàng loạt VB.NET

Bài viết này mình sẽ giới thiệu đến các bạn một ứng dụng khá hay do mình sưu tầm được, ứng dụng này có chức năng cho phép resize dung lượng file hình ảnh hàng loạt.

Trước tiên bạn khai Class có tên là ConfigOpt.vb, tại lớp này mình sẽ thiết lập các thuộc tính cho chương trình.

Imports System.IO

' Class for managing configuration persistence
Public Class ConfigOpt

  ' This DataSet is used as a memory data structure to hold config key/value pairs
  ' Inside this DataSet, a single DataTable named ConfigValues is created
  Private Shared DSoptions As DataSet
  ' This is the filename for the DataSet XML serialization
  Private Shared mConfigFileName As String

  ' This property is read-only, because it is set through Initialize or Store methods
  Public Shared ReadOnly Property ConfigFileName() As String
    Get
      Return mConfigFileName
    End Get
  End Property

  ' This method has to be invoked before using any other method of ConfigOpt class
  ' ConfigFile parameter is the name of the config file to be read
  ' (if that file doesn't exists, the method simply initialize the data structure
  ' and the ConfigFileName property)
  Public Shared Sub Initialize(ByVal ConfigFile As String)
    mConfigFileName = ConfigFile
    DSoptions = New DataSet("ConfigOpt")
    If File.Exists(ConfigFile) Then
      ' If the specified config file exists, it is read to populate the DataSet
      DSoptions.ReadXml(ConfigFile)
    Else
      ' If the specified config file doesn't exists, 
      ' the DataSet is simply initialized (and left empty):
      ' the ConfigValues DataTable is created with two fields (to hold key/values pairs)
      Dim dt As New DataTable("ConfigValues")
      dt.Columns.Add("OptionName", System.Type.GetType("System.String"))
      dt.Columns.Add("OptionValue", System.Type.GetType("System.String"))
      DSoptions.Tables.Add(dt)
    End If
  End Sub

  ' This method serializes the memory data structure holding the config parameters
  ' The filename used is the one defined calling Initialize method
  Public Shared Sub Store()
    Store(mConfigFileName)
  End Sub

  ' Same as Store() method, but with the ability to serialize on a different filename
  Public Shared Sub Store(ByVal ConfigFile As String)
    mConfigFileName = ConfigFile
    DSoptions.WriteXml(ConfigFile)
  End Sub

  ' Read a configuration Value (aka OptionValue), given its Key (aka OptionName)
  ' If the Key is not defined, an empty string is returned
  Public Shared Function GetOption(ByVal OptionName As String) As String
    Dim dv As DataView = DSoptions.Tables("ConfigValues").DefaultView
    dv.RowFilter = "OptionName='" & OptionName & "'"
    If dv.Count > 0 Then
      Return CStr(dv.Item(0).Item("OptionValue"))
    Else
      Return ""
    End If
  End Function

  ' Write in the memory data structure a Key/Value pair for a configuration setting
  ' If the Key already exists, the Value is simply updated, else the Key/Value pair is added
  ' Warning: to update the written Key/Value pair on the config file, you need to call Store
  Public Shared Sub SetOption(ByVal OptionName As String, ByVal OptionValue As String)
    Dim dv As DataView = DSoptions.Tables("ConfigValues").DefaultView
    dv.RowFilter = "OptionName='" & OptionName & "'"
    If dv.Count > 0 Then
      dv.Item(0).Item("OptionValue") = OptionValue
    Else
      Dim dr As DataRow = DSoptions.Tables("ConfigValues").NewRow()
      dr("OptionName") = OptionName
      dr("OptionValue") = OptionValue
      DSoptions.Tables("ConfigValues").Rows.Add(dr)
    End If
  End Sub

End Class

Ta viết cho sự kiên Input path (đường dẫn đến thư mục chứa hình ảnh) như sau:

Private Sub btnINpath_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnINpath.Click
    Dim fBFF As New BrowseForFolder()
    fBFF.Description = "Select the folder containing the pictures to be reduced (input folder):"
    If fBFF.ShowDialog() = DialogResult.OK Then
      txtINpath.Text = fBFF.Path
    End If
End Sub

Tiếp theo cho sự kiện Output path (nơi lưu lại các file ảnh sau khi xử lý):

Private Sub btnOUTpath_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnOUTpath.Click
    Dim fBFF As New BrowseForFolder()
    fBFF.Description = "Select the target folder for the reduced pictured (output folder):"
    If fBFF.ShowDialog() = DialogResult.OK Then
      txtOUTpath.Text = fBFF.Path
    End If
End Sub

- Cái quan trọng nhất trong hàm dể resize ta viết như sau:

Private Sub Reduce(ByVal factor As Double)
    img = New Bitmap(img, New Size(img.Size.Width * factor, img.Size.Height * factor))
    picPhoto.Image = img

    Dim SizeKb As String
    ' To compute: size in Kb
    Dim ms As New MemoryStream()
    img.Save(ms, Imaging.ImageFormat.Jpeg)
    SizeKb = (ms.Length  1024).ToString() & "Kb "

    lblCurrentSize.Text = "Current Size: " & SizeKb & "(" & img.Width & "x" & img.Height & ") [" & img.Width / img.Height & "]"
End Sub

- Hàm xử lý lấy thư mục chứa hình ảnh

Private Sub ToFile(ByVal filename As String)
    Dim ms As New MemoryStream()
    img.Save(ms, Imaging.ImageFormat.Jpeg)
    Dim imgData(ms.Length - 1) As Byte
    ms.Position = 0
    ms.Read(imgData, 0, ms.Length)
    Dim fs As New FileStream(filename, FileMode.Create, FileAccess.Write)
    fs.Write(imgData, 0, UBound(imgData))
    fs.Close()
End Sub

- Hàm xử lý chưa hình ảnh sau khi xử lý

Private Sub FromFile(ByVal filename As String)
    Dim fs As New FileStream(filename, FileMode.Open, FileAccess.Read)
    Dim imgData(fs.Length) As Byte
    fs.Read(imgData, 0, fs.Length)
    fs.Close()

    Try
      img = Image.FromStream(New MemoryStream(imgData))
      imgFormat = img.RawFormat
      picPhoto.Image = img
      lblCurrentSize.Text = "Current Size: " & UBound(imgData)  1024 & "Kb (" & img.Width & "x" & img.Height & ") [" & img.Width / img.Height & "]"
    Catch
      lblCurrentSize.Text = "Error"
    End Try
End Sub

- Hàm sự lý sự kiện xử lý chức năng resize ảnh:

Private Sub btnGo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnGo.Click
    If Not Directory.Exists(txtINpath.Text) Or Not Directory.Exists(txtOUTpath.Text) Then
      MessageBox.Show("The folder you specified as input and/or output path does not exist. Please, check it and retry.", "Error", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
      Exit Sub
    End If
    Dim fs As String() = Directory.GetFiles(txtINpath.Text, "*.jpg")
    Dim Ffull, Fshort As String
    For Each Ffull In fs
      FromFile(Ffull)
      Application.DoEvents()
      Fshort = Ffull.Substring(Ffull.LastIndexOf("") + 1)
      lblName.Text = Fshort
      Application.DoEvents()
      Dim dr As DialogResult
      If chkBatchProc.Checked Then
        dr = DialogResult.Yes
      Else
        dr = MessageBox.Show("Convert?", Fshort, MessageBoxButtons.YesNoCancel)
      End If
      If dr = DialogResult.Cancel Then
        Exit For
      ElseIf dr = DialogResult.Yes Then
        Reduce(Double.Parse(txtRedFactor.Text, New System.Globalization.CultureInfo("EN-us")))
        Application.DoEvents()
        ToFile(txtOUTpath.Text & "" & Fshort)
      End If
    Next
 End Sub

Bây giờ bạn thử code để thuowgr thức thành quả của mình xem nào, nếu ai lười quá thì download link bên dưới nhé.

Download Project