Viết ứng dụng giảm dung lượng hình ảnh (Compression Image) sử dụng VB.NET

Hôm nay, mình viết chương trình giảm dung lượng, chất lượng của hình ảnh, ví dụ: bạn có file hình 3MB bạn muốn nén nó xuống vài trăm KB để up lên website hay chạy ứng dụng để giảm tải băng thông...

Chương trình có giao diện như mình demo bên dưới:

Chương trình giảm dung lượng của mình sử dụng hàm EncoderParameter trong thư viện  System.Drawing.Imaging của VB.NET

+ Đầu bạn import thư viện system. drawing . imaging vào:

Imports System.Drawing.Imaging

+ Tiếp theo , mình viết một function GetEncoderInfo() để get mime của hình ảnh:

Private Function GetEncoderInfo(ByVal mimeType As String) As ImageCodecInfo
        Dim j As Integer
        Dim encoders As ImageCodecInfo()
        encoders = ImageCodecInfo.GetImageEncoders()
        For j = 0 To encoders.Length
            If encoders(j).MimeType = mimeType Then
                Return encoders(j)
            End If
        Next j
        Return Nothing
    End Function

+ Tiếp theo, mình viêt hàm SaveJPGWithCompressionSetting() thành file hình khác, sau khi đã tinh chỉnh các thông số cho hình ảnh: 

Private Sub SaveJPGWithCompressionSetting(ByVal image As Image, ByVal szFileName As String, ByVal lCompression As Long)
        On Error GoTo chkErr
        Dim eps As EncoderParameters = New EncoderParameters(1)
        eps.Param(0) = New EncoderParameter(Encoder.Quality, lCompression)
        Dim ici As ImageCodecInfo = GetEncoderInfo("image/jpeg")
        image.Save(szFileName, ici, eps)
        Exit Sub
chkErr: MsgBox("Error: " & Err.Number & " " & Err.Description & vbCrLf & "Choose a different name for file.")
        errOcr = True
        Resume Next

    End Sub

+ Viết sự kiện, khi trackbar scroll để lấy giá trị chất lượng của hình ảnh mình muốn thay đổi, và lấy dung lượng size của hình ảnh:

Private Sub TrackBar1_Scroll(sender As Object, e As EventArgs) Handles TrackBar1.Scroll
        ToolTip1.SetToolTip(TrackBar1, TrackBar1.Value.ToString())
        'Release loaded file temp.jpg
        If Not (pbPic.Image Is Nothing) Then
            pbPic.Image.Dispose()
            pbPic.Image = Nothing
        End If
        '=====
        'Release temp100.jpg after load
        Dim bmi As Bitmap = Image.FromFile(Application.StartupPath & "	emp100.jpg")
        pbPic.Image = bmi
        SaveJPGWithCompressionSetting(pbPic.Image, Application.StartupPath & "	emp.jpg", Val(TrackBar1.Value.ToString()))
        bmi.Dispose()
        '====
        pbPic.Image = Image.FromFile(Application.StartupPath & "	emp.jpg")
        lblCI.Text = TrackBar1.Value.ToString() + "%"
        Dim FileSize As Long
        Dim suffit As String
        FileSize = FileLen(Application.StartupPath & "	emp.jpg")
        If FileSize < 1000 Then
            suffit = " Bytes"
            GoTo showit
        End If
        If FileSize > 1000000 Then
            FileSize = Int(FileSize / 1000000)
            suffit = " Mb"
            GoTo showit
        Else
            FileSize = Int(FileSize / 1000)
            suffit = " Kb"
        End If
showit: lblTemp.Text = FileSize & suffit
    End Sub

+ Viết sự kiện cho nút lưu hình: 

Private Sub Button2_Click(sender As Object, e As EventArgs) Handles btnLuuhinh.Click
        errOcr = False
        fdSaveAs.Title = "Select the image to Save As."
        fdSaveAs.Filter = "Jpeg Images(.jpg)|*.jpg"
        If fdSaveAs.ShowDialog() = DialogResult.OK Then
            'Allow pbPic.Image to be saved to temp.jpg
            Dim bm As Bitmap = Image.FromFile(Application.StartupPath & "	emp100.jpg")
            'Release loaded file temp.jpg
            If Not (pbPic.Image Is Nothing) Then
                pbPic.Image.Dispose()
                pbPic.Image = Nothing
            End If
            '=====
            SaveJPGWithCompressionSetting(bm, fdSaveAs.FileName, Val(TrackBar1.Value.ToString()))
            'Still error if you try to save pbPic.Image to temp100.jpg
            If errOcr Then
                errOcr = False
                pbPic.Image = bm
                Exit Sub
            End If
            bm.Dispose()
            pbPic.Image = Image.FromFile(fdSaveAs.FileName)
        End If
    End Sub

+ Viết sự kiện mở file hình lên: 

Private Sub btnChonhinh_Click(sender As Object, e As EventArgs) Handles btnChonhinh.Click
        OpenFileDialog1.Filter = "Jpeg Images(.jpg)|*.jpg"
        If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
            pbPic.Image = New Bitmap(OpenFileDialog1.FileName)
            Dim FileSize As Long
            Dim suffit As String
            Dim i As Integer

            SaveJPGWithCompressionSetting(pbPic.Image, Application.StartupPath & "	emp100.jpg", 100)
            SaveJPGWithCompressionSetting(pbPic.Image, Application.StartupPath & "	emp.jpg", 100)

            FileSize = FileLen(Application.StartupPath & "	emp.jpg")
            If FileSize < 1000 Then
                suffit = " Bytes"
                GoTo showit
            End If
            If FileSize > 1000000 Then
                FileSize = Int(FileSize / 1000000)
                suffit = " Mb"
                GoTo showit
            Else
                FileSize = Int(FileSize / 1000)
                suffit = " Kb"
            End If
showit:     lbl100.Text = FileSize & suffit
        End If

    End Sub

+ Và cuối cùng là mình viết sự kiện form_closing để ngừng xử lý của chương trình đến file ảnh:

Private Sub Form1_FormClosing(sender As Object, e As FormClosingEventArgs) Handles MyBase.FormClosing
        On Error GoTo chkErr
        'The Kill Function will not work if file is being used in a process
        pbPic.Image.Dispose() 'temp.jpg was in pbPic.Image
        Kill(Application.StartupPath & "	emp.jpg")
        Kill(Application.StartupPath & "	emp100.jpg")
        Exit Sub
chkErr: MsgBox("Error: " & Err.Number & " " & Err.Description & vbCrLf & "File will not be deleted :(")
        Resume Next
    End Sub

Chúc các bạn thành công. 

DOWNLOAD PROJECT