这个功能用到的地方很多，GDI+是系统的工具，但是发布较晚，所以没有完全普及。我写这篇文
章应用到他的部分功能，给大家参考参考。

这个函数可以将 StdPicture 对象用 GDI+解码器保存为 JPEG格式文件。 Quality参数是清晰度，越低越模糊，但是压缩更高。

以下是代码

Private Type GUID
   Data1 As Long
   Data2 As Integer
   Data3 As Integer
   Data4(0 To 7) As Byte
End Type

Private Type GdiplusStartupInput
   GdiplusVersion As Long
   DebugEventCallback As Long
   SuppressBackgroundThread As Long
   SuppressExternalCodecs As Long
End Type

Private Type EncoderParameter
   GUID As GUID
   NumberOfValues As Long
   type As Long
   Value As Long
End Type

Private Type EncoderParameters
   Count As Long
   Parameter As EncoderParameter
End Type

Private 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) A
s 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

Public Sub SaveJPG(ByVal pict As StdPicture, ByVal filename As String, _
           Optional ByVal quality As Byte = 80)
   Dim 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+ 图像
      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 Quality
            得到Quality参数的GUID标识
            CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID
            .NumberOfValues = 1
            .type = 4
            .Value = VarPtr(Quality)
         End With
        
         保存图像
         lRes = GdipSaveImageToFile( _
                  lBitmap, _
                  StrPtr(Filename), _
                  tJpgEncoder, _
                  tParams)
                            
         销毁GDI+图像
         GdipDisposeImage lBitmap
        
      End If
     
      销毁 GDI+
      GdiplusShutdown lGDIP

   End If
  
   If lRes Then
      Err.Raise 5, , "不能保存这个图像：" & lRes
   End If
  
End Sub

相同方法还可以保存GIF和TIFF，连PNG都可以，大家好好研究吧。