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
解决方案 »
- 帮我把这句操作翻译下
- 我想编一个上海耀华XK3190-D9与计算机通信的程序
- 子程序运行结束,画面关闭,但进程不结束?
- [求助]如何用VB实现矢量图的制作并能区分图层?
- 如何设定vb中的默认字体大小呀?比如文本框,标签的字体。
- 我的VB怎么缺少很多控件的?
- 真诚求教:字符—日期转换函数的相关问题?
- 能介绍几本好书吗?
- 如何把两个图片叠放?也就是要放置透明的图片
- 如何验证客户有没有改系统时间?分在http://www.csdn.net/expert/topic/342/342098.shtm中,马上给分!
- 关于Msgbox提示框的问题2
- 调用EXCEL时提示"自动化错误",为什么??急急急!!!
第一步完成80%了,已经能保存灰度JPEG
由于AC系数直接做EOB处理,所以有方格效应