VB 改变图片尺寸和文件大小 。给你一个模块,简单调用即可:
一、新建一个模块,复制下面代码
Option Explicit
'常量声明
Private Const GdiplusVersion As Long = 1
'结构声明
Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
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(15) As EncoderParameter
End Type
Private Type GdiplusStartupInput
GdiplusVersion As Long
DebugEventCallback As Long
SuppressBackgroundThread As Long
SuppressExternalCodecs As Long
End Type
Private Type GdiplusStartupOutput
NotificationHook As Long
NotificationUnhook As Long
End Type
'枚举声明
Private Enum Status
OK = 0
GenericError = 1
InvalidParameter = 2
OutOfMemory = 3
ObjectBusy = 4
InsufficientBuffer = 5
NotImplemented = 6
Win32Error = 7
WrongState = 8
Aborted = 9
FileNotFound = 10
ValueOverflow = 11
AccessDenied = 12
UnknownImageFormat = 13
FontFamilyNotFound = 14
FontStyleNotFound = 15
NotTrueTypeFont = 16
UnsupportedGdiplusVersion = 17
GdiplusNotInitialized = 18
PropertyNotFound = 19
PropertyNotSupported = 20
ProfileNotFound = 21
End Enum
'API声明
Private Declare Function GdipCreateFromHDC Lib "gdiplus" (ByVal hdc As Long, graphics As Long) As Status
Private Declare Function GdipCreateBitmapFromHBITMAP Lib "gdiplus" (ByVal hbm As Long, ByVal hPal As Long, ByRef BITMAP As Long) As Status
Private Declare Function GdipDisposeImage Lib "gdiplus" (ByVal Image As Long) As Status
Private Declare Function GdipLoadImageFromFile Lib "gdiplus" (ByVal Filename As Long, Image As Long) As Status
Private Declare Function GdipGetImageWidth Lib "gdiplus" (ByVal Image As Long, Width As Long) As Status
Private Declare Function GdipGetImageHeight Lib "gdiplus" (ByVal Image As Long, Height As Long) As Status
Private Declare Function GdiplusShutdown Lib "gdiplus" (ByVal token As Long) As Status
Private Declare Function GdiplusStartup Lib "gdiplus" (ByRef token As Long, ByRef lpInput As GdiplusStartupInput, ByRef lpOutput As GdiplusStartupOutput) As Status
Private Declare Function GdipDrawImageRect Lib "gdiplus" (ByVal graphics As Long, ByVal Image As Long, ByVal x As Single, ByVal y As Single, ByVal Width As Single, ByVal Height As Single) As Status
Private Declare Function GdipDeleteGraphics Lib "gdiplus" (ByVal graphics As Long) As Status
Private Declare Function CLSIDFromString Lib "ole32" (ByVal str As Long, ByRef id As GUID) As Long
Private Declare Function GdipSaveImageToFile Lib "gdiplus" (ByVal Image As Long, ByVal Filename As Long, clsidEncoder As GUID, encoderParams As Any) As Long
'By Modest
'根据版本初始化GDI+
Private Function StartUpGDIPlus(ByVal GdipVersion As Long) As Long
Dim GdipToken As Long
Dim GdipStartupInput As GdiplusStartupInput
Dim GdipStartupOutput As GdiplusStartupOutput
GdipStartupInput.GdiplusVersion = GdipVersion
If GdiplusStartup(GdipToken, GdipStartupInput, GdipStartupOutput) = OK Then
StartUpGDIPlus = GdipToken
End If
End Function
'获取当前窗体(作为临时控件的寄存之处)
Function GetCurForm() As Form
'获取当前可用窗体
For Each GetCurForm In Forms
Exit For
Next
End Function
'图片按指定缩放比例进行显示
Public Function PictureShow(Filename As String, Optional ByVal Compress As Byte = 100)
Dim Stream As IUnknown
Dim lngGdipToken As Long, gdip_Graphics As Long, gdip_pngImage As Long
推荐阅读
- phpcms正删改查,php增删改查心得
- 马伊俐文章分享故事公众号,马伊俐代表作
- 魔法冒险小游戏,魔法冒险小说推荐
- 网红直播都用几个手机看,网红直播为啥都用几个手机
- linux命令行换颜色 linux终端怎么换颜色
- c语言485发送程序,c# 485教程
- word文档怎么删除,word文档怎么删除多余的页面
- 虾皮直播obs教程,虾皮直播软件
- mysql5.1怎么备份 mysql数据库怎么备份数据库