VB6.0 GDI 保存JPG图片质量差问题

'*************************************************************************

'** 函 数 名 ： funSaveImgToFile

'** 输 入    ： pic(StdPicture) - 图象句柄

'**          ： FileName(String) - 保存路径

'**          ： Quality(Byte) - JPG图象质量

'**          ： TIFF_ColorDepth(Long) - TTF格式的颜色深度

'**          ： TIFF_Compression(Long) - TTF格式的压缩比

'**    输 出 ： 成功与否

'** 功能描述 ： 把图象保存为JPG、TIFF、PNG、GIF、BMP格式

'*************************************************************************

Public Function funSaveImgToFile(ByVal pict As StdPicture, ByVal FileName As String, ByVal PicType As String, _

                   Optional ByVal Quality As Byte = 100, _

                   Optional ByVal TIFF_ColorDepth As Long = 24, _

                   Optional ByVal TIFF_Compression As Long = 6) As Boolean

    Dim tSI As GdiplusStartupInput

    Dim lRes As Long

    Dim lGDIP As Long

    Dim lBitmap As Long

    Dim aEncParams() As Byte

    

    ' 初始化 GDI+

    tSI.GdiplusVersion = 1

    lRes = GdiplusStartup(lGDIP, tSI, 0)

    If lRes = 0 Then ' 从句柄创建 GDI+ 图像

        lRes = GdipCreateBitmapFromHBITMAP(pict.handle, 0, lBitmap)

        If lRes = 0 Then

            Dim tJpgEncoder As GUID

            Dim tParams As EncoderParameters '初始化解码器的GUID标识

            Select Case LCase(PicType) '防止前面写文件格式是把小写搞成大写,如果是就转为小写字

                Case "jpg"

                    CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder

                    tParams.Count = 1 ' 设置解码器参数

                    With tParams.Parameter ' Quality

                        CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID ' 得到Quality参数的GUID标识

                        .NumberOfValues = 1

                        .type = 4

                        .Value = VarPtr(Quality)

                    End With

                    ReDim aEncParams(1 To Len(tParams))

                    Call CopyMemory(aEncParams(1), tParams, Len(tParams))

                Case "png"

                    CLSIDFromString StrPtr("{557CF406-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder

                    ReDim aEncParams(1 To Len(tParams))

                Case "gif"

                    CLSIDFromString StrPtr("{557CF402-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder

                    ReDim aEncParams(1 To Len(tParams))

                Case "tiff"

                    CLSIDFromString StrPtr("{557CF405-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder

                    tParams.Count = 2

                    ReDim aEncParams(1 To Len(tParams) + Len(tParams.Parameter))

                    With tParams.Parameter

                        .NumberOfValues = 1

                        .type = 4

                        CLSIDFromString StrPtr("{E09D739D-CCD4-44EE-8EBA-3FBF8BE4FC58}"), .GUID ' 得到ColorDepth参数的GUID标识

                        .Value = VarPtr(TIFF_Compression)

                    End With

                    Call CopyMemory(aEncParams(1), tParams, Len(tParams))

                    With tParams.Parameter

                        .NumberOfValues = 1

                        .type = 4

                        CLSIDFromString StrPtr("{66087055-AD66-4C7C-9A18-38A2310B8337}"), .GUID ' 得到Compression参数的GUID标识

                        .Value = VarPtr(TIFF_ColorDepth)

                    End With

                    Call CopyMemory(aEncParams(Len(tParams) + 1), tParams.Parameter, Len(tParams.Parameter))

            End Select

            lRes = GdipSaveImageToFile(lBitmap, StrPtr(FileName), tJpgEncoder, aEncParams(1)) '保存图像

            GdipDisposeImage lBitmap ' 销毁GDI+图像

        End If

        GdiplusShutdown lGDIP '销毁 GDI+

    End If

    Erase aEncParams

    If lRes Then

        funSaveImgToFile = False

    Else

        funSaveImgToFile = True

    End If

    Exit Function

End Function