Saving images to JPG using GDI+This function saves a StdPicture object to a file with JPG format using the GDI+ encoder. Just call the function passing the image object, the filename and, optionally, the image quality (from 1 to 100) .' ----==== API Declarations ====----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 LongPrivate Declare Function GdiplusShutdown Lib "GDIPlus" ( _
ByVal token As Long) As LongPrivate Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" ( _
ByVal hbm As Long, _
ByVal hpal As Long, _
Bitmap As Long) As LongPrivate Declare Function GdipDisposeImage Lib "GDIPlus" ( _
ByVal Image As Long) As LongPrivate Declare Function GdipSaveImageToFile Lib "GDIPlus" ( _
ByVal Image As Long, _
ByVal Filename As Long, _
clsidEncoder As GUID, _
encoderParams As Any) As LongPrivate 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 SubAuthor:Edanmo
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 LongPrivate Declare Function GdiplusShutdown Lib "GDIPlus" ( _
ByVal token As Long) As LongPrivate Declare Function GdipCreateBitmapFromHBITMAP Lib "GDIPlus" ( _
ByVal hbm As Long, _
ByVal hpal As Long, _
Bitmap As Long) As LongPrivate Declare Function GdipDisposeImage Lib "GDIPlus" ( _
ByVal Image As Long) As LongPrivate Declare Function GdipSaveImageToFile Lib "GDIPlus" ( _
ByVal Image As Long, _
ByVal Filename As Long, _
clsidEncoder As GUID, _
encoderParams As Any) As LongPrivate 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 SubAuthor:Edanmo
第一步完成80%了,已经能保存灰度JPEG
由于AC系数直接做EOB处理,所以有方格效应