保存StdPicture到JPG图片文件的函数

tmtony

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) 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 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
   
        '   Initialize   GDI+
        tSI.GdiPlusVersion = 1
        lRes = GdiplusStartup(lGDIP, tSI)
         
        If lRes = 0 Then
         
              '   Create   the   GDI+   bitmap
              '   from   the   image   handle
              lRes = GdipCreateBitmapFromHBITMAP(pict.Handle, 0, lBitmap)
         
              If lRes = 0 Then
                    Dim tJpgEncoder     As Guid
                    Dim TParams     As EncoderParameters
                     
                    '   Initialize   the   encoder   GUID
                    CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), _
                                                    tJpgEncoder
               
                    '   Initialize   the   encoder   parameters
                    TParams.Count = 1
                    With TParams.Parameter     '   Quality
                          '   Set   the   Quality   GUID
                          CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB3505E7EB}"), .Guid
                          .NumberOfValues = 1
                          .type = 1
                          .Value = VarPtr(quality)
                    End With
                     
                    '   Save   the   image
                    lRes = GdipSaveImageToFile( _
                                      lBitmap, _
                                      StrPtr(FileName), _
                                      tJpgEncoder, _
                                      TParams)
                                                              
                    '   Destroy   the   bitmap
                    GdipDisposeImage lBitmap
                     
              End If
               
              '   Shutdown   GDI+
              GdiplusShutdown lGDIP
   
        End If
         
        If lRes Then
              Err.Raise 5, , "Cannot   save   the   image.   GDI+   Error:" & lRes
        End If
         
  End Sub

tmtony

原帖由 andymark 于 2008-1-19 20:06 发表
汗，用上面的语句居然导出的是image连接的图片
当连接路径失效时就不能导出
上面的语句应该怎样书写才能出导IMAGE控件里的图像

不知要保留成什么格式, 根据原来的格式可保留为 ico 或 bmp

tmtony

原帖由 andymark 于 2008-1-19 21:13 发表
我想把窗体里的IMAGE控件的图像重新保存到硬盘(BMP格式)

原来插入到image是Ico格式还是bmp格式

tmtony

有知有否明白andymark兄的意思,做了个例子
http://www.office-cn.net/vvb/thread-59204-1-1.html

tmtony

不好意思,我会错意思了, 原来是导出image 而非imagelist控件中的图片, 我下午再做一下

tmtony

又做了一个,不知合不合适.
http://www.office-cn.net/vvb/thread-59210-1-1.html