一个可保存JPG图像的类源码

微凉

上网掏到了一个JPEG类，可以将图像保存成JPEG，图素质量可调。
顺便做了一个测试程序。贡献给大家。
Option Explicit

Private Sub mnuExit_Click()
    Unload Me
    End
End Sub

Private Sub mnuOpen_Click()
    Dim strFile As String
    strFile = GetOpenFile(hwnd)
    If Len(strFile) > 0 Then
        picMain.Picture = LoadPicture(strFile)
    End If
End Sub

Private Sub mnuSaveAsBMP_Click()
    Dim strFile As String
    strFile = GetSaveFile(hwnd)
    If Len(strFile) = 0 Then Exit Sub
    strFile = CheckExt(strFile, ".bmp")
    SavePicture picMain.Picture, strFile
End Sub

Private Sub mnuSaveAsJPG_Click()
    Dim strFile As String
    strFile = GetSaveFile(hwnd, "JPG")
    strFile = CheckExt(strFile, ".jpg")
    Dim intQ As Integer
    intQ = Val(InputBox("请输入图像质量(1-100):", "JPEG图像质量", 90))
    '检查图像质量
    If intQ < 1 Then
        intQ = 1
    ElseIf intQ > 100 Then
        intQ = 100
    End If
    SaveJPEG strFile, picMain, True, CByte(intQ)
End Sub

Private Function SaveJPEG(ByVal Filename As String, Pic As PictureBox, Optional ByVal Overwrite As Boolean = True, Optional ByVal Quality As Byte = 90) As Boolean
    Dim JPEGclass As New ClsJPEG
    Dim m_Picture As IPictureDisp
    Dim m_DC As Long
    Dim m_Millimeter As Single
    m_Millimeter = ScaleX(100, vbPixels, vbMillimeters)
    Set m_Picture = Pic
    m_DC = Pic.hDC
    '检查文件名及图像
    If m_DC <> 0 And LenB(Filename) > 0 Then
        JPEGclass.Quality = Quality
        '全颜色保存
        JPEGclass.SetSamplingFrequencies 1, 1, 1, 1, 1, 1
        '从hDC拷贝图像
        If JPEGclass.SampleHDC(m_DC, CLng(m_Picture.Width / m_Millimeter), CLng(m_Picture.Height / m_Millimeter)) = 0 Then
            '如果设置覆盖模式且指定文件存在则删除原文件
            If Overwrite And LenB(Dir$(Filename)) > 0 Then Kill Filename
            '保存文件,成功返回True
            SaveJPEG = JPEGclass.SaveFile(Filename) = 0
        End If
    End If
    '释放空间
    Set JPEGclass = Nothing
End Function

'检查扩展名
Private Function CheckExt(Filename As String, ext As String) As String
    Dim i As Integer
    i = InStrRev(Filename, ".")
    If i <= 0 Then
        CheckExt = Filename & ext
    Else
        CheckExt = Left$(Filename, i - 1) & ext
    End If
End Function

类模块
'////////////////////////////////////////////////////
'
'                 JPEG Encoder Class
'      Written by John Korejwa <korejwa@tiac.net>
'
'////////////////////////////////////////////////////
Option Explicit

Option Base 0

'霍夫曼码