有熟悉图形的吗？如何保存为JPG文件

Question

Public Function BrightnessBits(ByVal Pic As PictureBox, ByVal Value As Long) As Boolean
    Dim MyhDC As Long
    Dim MyBMIH As BitMapInfoHeader
    Dim MyhDIB As Long
    Dim MyPtr As Long
    Dim hOldMap As Long
    Dim MapData() As Byte
    Dim TempValue As Long
    Dim BrightTable(255) As Byte
    Dim I As Long
    Dim MaxI As Long
     
    With MyBMIH
        .biSize = Len(MyBMIH)
        .biWidth = Pic.ScaleWidth
        .biHeight = Pic.ScaleHeight
        .biPlanes = 1
        .biBitCount = 24
        .biSizeImage = ((.biWidth * 3 + 3) And &HFFFFFFFC) * .biHeight
    End With
    MyhDC = CreateCompatibleDC(0)
    MyhDIB = CreateDIBSection(MyhDC, MyBMIH, 0, MyPtr, 0, 0)
    If MyhDIB Then
        hOldMap = SelectObject(MyhDC, MyhDIB)
    Else
        DeleteObject MyhDC
        Exit Function
    End If
    
    BitBlt MyhDC, 0, 0, MyBMIH.biWidth, MyBMIH.biHeight, Pic.hDC, 0, 0, vbSrcCopy
    
    MaxI = MyBMIH.biSizeImage - 1
    ReDim MapData(0 To MaxI)
    Debug.Print "GetBitmapBits:", GetBitmapBits(MyhDIB, MyBMIH.biSizeImage, MapData(0))
    
    For I = 0 To 255
        TempValue = I * Value / 100
        If TempValue > 255 Then
            BrightTable(I) = 255
        Else
            BrightTable(I) = TempValue
        End If
    Next I
    
    For I = 0 To MaxI
        MapData(I) = BrightTable(MapData(I))
    Next I
    
    call SetBitmapBits(MyhDIB, MyBMIH.biSizeImage, MapData(0))
    
    BitBlt Pic.hDC, 0, 0, MyBMIH.biWidth, MyBMIH.biHeight, MyhDC, 0, 0, vbSrcCopy
    If hOldMap Then DeleteObject SelectObject(MyhDC, hOldMap)
    DeleteObject MyhDC
    BrightnessBits = True
End FunctionPrivate Sub CmdStart_Click()
    PicView2.Width = PicView1.Width
    PicView2.Height = PicView1.Height
    Me.MousePointer = vbHourglass
    DoEvents
    BitBlt PicView2.hDC, 0, 0, PicView1.ScaleWidth, PicView1.ScaleHeight, PicView1.hDC, 0, 0, vbSrcCopy
    BrightnessBits PicView2, 200
    PicView2.Refresh
    ScrollSize
    Me.MousePointer = vbDefault
End Sub
Private Sub CmdSave_Click()
    On Error GoTo ErrSave
    CDlgSave.ShowSave
    SavePicture PicView2.Image, CDlgSave.FileName
    On Error GoTo 0
    Exit Sub
    
ErrSave:
    If Err.Number = cdlCancel Then
    Else
        MsgBox Err.Description, vbCritical, Err.Number
    End If
End Sub现在只能保存为BMP，能否告知如何直接保存为JPG文件？用ijl11.dll或者ImageEdit都可以，谢谢

Answer 1

'************************************************************************
'**
'**  使用 GDI+ 方法将图片保存为 JPG 格式
'**  注意：需要将 GDIPLUS.DLL 放在系统 system/system32 下。
'**        该文件默认在 C:\Program Files\Common Files\Microsoft Shared\INK 目录下
'**
'**  函数名：SaveJpg
'**  参  数：pict As StdPicture  欲转换的图片，可以是 picturebox.picture 等
'**          filename As String  欲存储的 jpg 图片的文件名
'**          quality As Byte     图片的质量 0～100 ，默认为 80
'**  返回值：as string           错误说明，如果该值为空则在存储过程中没有错误。
'**
'**
'************************************************************************' ******** API 声明 ********Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End TypePrivate Type GdiplusStartupInput
   GdiplusVersion As Long
   DebugEventCallback As Long
   SuppressBackgroundThread As Long
   SuppressExternalCodecs As Long
End TypePrivate Type EncoderParameter
   GUID As GUID
   NumberOfValues As Long
   type As Long
   Value As Long
End TypePrivate Type EncoderParameters
   Count As Long
   Parameter As EncoderParameter
End TypePrivate Declare Function GdiplusStartup Lib "GDIPlus" (token As Long, inputbuf As GdiplusStartupInput, Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdiplusShutdown Lib "GDIPlus" (ByVal token As Long) As Long
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" (ByVal hbm As Long, ByVal hpal As Long, Bitmap As Long) As Long
Private Declare Function GdipDisposeImage Lib "GDIPlus" (ByVal Image As Long) As Long
Private Declare Function GdipSaveImageToFile Lib "GDIPlus" (ByVal Image As Long, ByVal filename As Long, clsidEncoder As GUID, encoderParams As Any) As Long
Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, id As GUID) As Long' ******** SaveJPG ********
Public Function SaveJPG(ByVal pict As StdPicture, ByVal filename As String, Optional ByVal quality As Byte = 80) As StringDim tSI As GdiplusStartupInput
Dim lRes As Long
Dim lGDIP As Long
Dim lBitmap As Long   ' 初始化 GDI+
   tSI.GdiplusVersion = 1
   lRes = GdiplusStartup(lGDIP, tSI)
   
   If lRes = 0 Then
   
      ' 从指定的图片句柄中建立 GDI+ bitmap
      lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)
   
      If lRes = 0 Then
         Dim tJpgEncoder As GUID
         Dim tParams As EncoderParameters
         
         ' 初始化 GUID 编码器
         CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
      
         ' 初始化参数编码器
         tParams.Count = 1
         With tParams.Parameter ' 压缩质量
            ' 设置 GUID 的图片质量
            CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB3505E7EB}"), .GUID
            .NumberOfValues = 1
            .type = 1
            .Value = VarPtr(quality)
         End With
         
         ' 保存图片
         lRes = GdipSaveImageToFile(lBitmap, StrPtr(filename), tJpgEncoder, tParams)
                             
         ' 注销 bitmap
         GdipDisposeImage lBitmap
         
      End If
      
      ' 关闭 GDI+
      GdiplusShutdown lGDIP   End If
   
   If lRes Then
      '发生错误后将 SaveJpg 存放错误说明
      SaveJPG = "无法存储图片！ GDI+ 错误：" & lRes
   End If
   
End Function

Answer 2

请问用什么方法可以修改图片质量？我不管怎么修改最后一个参数，似乎保存的图片都一样
Call SaveJPG(PicView2.Image, "D:\3.JPG", 100)

Answer 3

不会的丫，我这里都可以啊，你试着用picturebox放一个bmp或gif的图片然后很明显的call savejpa（picture1.picture，“d:\test.jpg",20)看看。肯定有差别的，不过如果你原来的图片就是jpg的，那么本来就是压缩过了的，可能不会太明显。

Answer 4

Dim ErrString As String
            ErrString = SaveJPG(imgMovie_picture.Picture, imgFile)
            If ErrString <> "" Then
                '出错的话
                msgbox ErrString
            End If

Answer 5

http://www.showyou.net/mycode/CodeView/CodeView_2163.html
项目：JPEG图片压缩程序(1/5)
作者：zyl910
E-Mail:[email protected]

Answer 6

http://www.aivisoft.net/Zyl910/SaveJPEG2.rar
绝对精典项目：JPEG图片压缩程序
作者：zyl910
E-Mail:[email protected]