'声明略
Public Function ResizePic(ByVal sFromFile As String, ByVal sSaveToFile As String, Optional ByVal Quality As Byte = 80) As Boolean
Dim tSI As GdiplusStartupInput
Dim lRes As Long
Dim lGDIP As Long
Dim lBitmap As Long
Dim img As Long '初始化 GDI+
tSI.GdiplusVersion = 1
lRes = GdiplusStartup(lGDIP, tSI, 0) If lRes = 0 Then
'从文件创建 GDI+ 图像
GdipLoadImageFromFile StrPtr(sFromFile), lBitmap If lRes = 0 Then
Dim graphics As Long
GdipCreateFromHDC frmMain!picSmall.hDC, graphics
'运行完下面的这句代码后,在窗体中可以看到picSmall中成功绘制了缩小的图片
GdipDrawImageRect graphics, lBitmap, 0, 0, frmMain!picSmall.ScaleWidth, frmMain!picSmall.ScaleHeight
GdipCreateBitmapFromGraphics frmMain!picSmall.ScaleWidth, frmMain!picSmall.ScaleHeight, graphics, img
GdipDrawImageRectI graphics, lBitmap, 0, 0, frmMain!picSmall.ScaleWidth, frmMain!picSmall.ScaleHeight
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(img, StrPtr(sSaveToFile), tJpgEncoder, tParams) '销毁GDI+图像
GdipDisposeImage lBitmap
GdipDisposeImage img
GdipDeleteGraphics graphics '释放graphics占用的内存
End If '销毁 GDI+
GdiplusShutdown lGDIP
End If If lRes Then
ResizePic = False
Else
ResizePic = True
End If
End Function
用上面的函数无法保存调整大小后的图片,即只能保存一张全黑的图片,我对GDI+基本一窍不通,今下午研究了老半天了也没头绪,请朋友们指点一下迷津,谢谢!
解决方案 »
- 关于数组的问题
- 大家帮忙看看这样的错误提示是什么意思呢?
- MSCOMM串口通讯问题
- 请问各位高手:在VB窗体中如何给水晶报表的参数字段赋值
- vb下,用access数据库,并设置了密码,能经过编译,但打好包,安装到机子上的时候,竟然要求输入,数据源,用户,密码..的窗口??这是那个地方不对
- 用API函数OpenPrinter打开指定的打印机,但在和打印机断线后,使用函数还能返回正确打开打印机。
- 关于mshflexgrid的一个简单问题************在线等候答对给分******
- 谁有vb写的屏保原程序?
- 怎么做帮助文件?
- 如何通过编程动态改变command对象的属性?
- vbscript和浏览器的兼容问题
- vb 报表DataReport内容居中
Public Sub ResizePic(pic As PictureBox, ByVal sFromFile As String, ByVal sSaveToFile As String, Optional ByVal Quality As Byte = 100)
Dim tSI As GdiplusStartupInput
Dim lRes As Long
Dim lGDIP As Long
Dim lBitmap As Long
Dim img As Long
'初始化 GDI+
tSI.GdiplusVersion = 1
lRes = GdiplusStartup(lGDIP, tSI, 0) If lRes = 0 Then
'创建 GDI+ 图像
GdipLoadImageFromFile StrPtr(sFromFile), lBitmap If lRes = 0 Then
Dim graphics As Long
'GdipCreateFromHWND pic.Image.Handle, graphics
GdipCreateFromHDC pic.hDC, graphics
GdipDrawImageRect graphics, lBitmap, 0, 0, pic.ScaleWidth, pic.ScaleHeight
GdipCreateBitmapFromHBITMAP pic.Image.Handle, 0, img
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(img, StrPtr(sSaveToFile), tJpgEncoder, tParams) '销毁GDI+图像
GdipDisposeImage lBitmap
GdipDisposeImage img
GdipDeleteGraphics graphics '释放graphics占用的内存
End If '销毁 GDI+
GdiplusShutdown lGDIP
End IfEnd Sub