vb.net修改图片尺寸 vb改变图片大小代码

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

Dim hdc As Long, lngHeight As Long, lngWidth As Long

Dim ctlNew As PictureBox, Frm As Form

lngGdipToken = StartUpGDIPlus(GdiplusVersion)

If lngGdipToken = 0 Then Exit Function

Call GdipLoadImageFromFile(StrPtr(Filename), gdip_pngImage) '读取显示数据图片(包括png)

Call GdipGetImageHeight(gdip_pngImage, lngHeight) '

Call GdipGetImageWidth(gdip_pngImage, lngWidth)

lngWidth = lngWidth * Compress / 100

lngHeight = lngHeight * Compress / 100

'动态创建一个PictureBox控件

Set Frm = GetCurForm

Set ctlNew = Frm.Controls.Add("VB.PictureBox", "ChangePicSize_1_", Frm)

With ctlNew

.BorderStyle = 0

.AutoRedraw = True

.ScaleMode = 3

.Width = lngWidth * Screen.TwipsPerPixelX

.Height = lngHeight * Screen.TwipsPerPixelY

End With

'在控件上绘图

If GdipCreateFromHDC(ctlNew.hdc, gdip_Graphics) = OK Then

Call GdipDrawImageRect(gdip_Graphics, gdip_pngImage, 0, 0, lngWidth, lngHeight)

GdipDisposeImage gdip_pngImage

Set PictureShow = ctlNew.Image

End If

'善后处理

GdipDeleteGraphics gdip_Graphics

GdiplusShutdown lngGdipToken

Frm.Controls.Remove ctlNew

Set ctlNew = Nothing

Set Frm = Nothing

End Function

'把图片按指定缩放比例进行保存

Function PictureSave(ByVal SrcFilename As String, Optional DstFileName As String, Optional ByVal Compress As Byte = 100) As Boolean

Dim lRes As Long, lngGdipToken As Long

Dim lBitmap As Long

Dim i As Integer

Dim Leix As String, Flt As String

Dim lngHeight As Long, lngWidth As Long

Dim pic As StdPicture

Const quality As Byte = 100

Const TIFF_ColorDepth As Long = 24

Const TIFF_Compression As Long = 6

'对参数的合法性进行处理

If SrcFilename = "" Or Dir(SrcFilename) = "" Or DstFileName = "" Then Exit Function

Flt = "bmp|gif|jpg|jpeg|png|tif)|tiff"

i = InStrRev(SrcFilename, ".")

If i = 0 Then Exit Function

Leix = LCase(Mid(SrcFilename, i + 1))

If InStr(1, Flt, Leix, vbTextCompare) = 0 Then Exit Function

'初始化 GDI+

lRes = StartUpGDIPlus(GdiplusVersion)

If lRes = 0 Then Exit Function

Set pic = PictureShow(SrcFilename, Compress)

'从句柄创建 GDI+ 图像

'lRes = GdipCreateBitmapFromFile(StrPtr(SrcFilename), lBitmap)

lRes = GdipCreateBitmapFromHBITMAP(pic.Handle, 0, lBitmap)

Dim tJpgEncoder As GUID

Dim tParams As EncoderParameters

'初始化解码器的GUID标识

Select Case Leix

Case "jpg", "jpeg"

CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder

'设置解码器参数

tParams.Count = 1

With tParams.Parameter(0) ' Quality

'得到Quality参数的GUID标识

CLSIDFromString StrPtr("{1D5BE4B5-FA4A-452D-9CDD-5DB35105E7EB}"), .GUID

.NumberOfValues = 1

.Type = 4

.Value = VarPtr(quality)

End With

Case "png"

CLSIDFromString StrPtr("{557CF406-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder

Case "bmp"

CLSIDFromString StrPtr("{B96B3CAB-0728-11D3-9D7B-0000F81EF32E}"), tJpgEncoder

SavePicture pic, DstFileName

PictureSave = True

Exit Function

Case "gif"

CLSIDFromString StrPtr("{557CF402-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder

Case "tiff"

CLSIDFromString StrPtr("{557CF405-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder

tParams.Count = 2

With tParams.Parameter(0)

.NumberOfValues = 1

.Type = 4

CLSIDFromString StrPtr("{E09D739D-CCD4-44EE-8EBA-3FBF8BE4FC58}"), .GUID

.Value = VarPtr(TIFF_Compression)

End With

With tParams.Parameter(0)

.NumberOfValues = 1

.Type = 4

CLSIDFromString StrPtr("{66087055-AD66-4C7C-9A18-38A2310B8337}"), .GUID

.Value = VarPtr(TIFF_ColorDepth)

End With

End Select

'保存图像

lRes = GdipSaveImageToFile(lBitmap, StrPtr(DstFileName), tJpgEncoder, tParams)

'销毁GDI+图像

GdipDisposeImage lBitmap

GdiplusShutdown lngGdipToken

If lRes Then

PictureSave = False

Else

PictureSave = True

End If

End Function

二、调用举例：

PictureSave "c:\1.bmp", "d:\2.bmp", 50 '表示把c:\1.bmp缩小50%，并保存为d:\2.bmp

求大神指点vb.net 怎么把一张大图 缩放到 和图片框一样大小显示

PictureBox.SizeMode

属性

默认情况下，在

Normal

模式中，Image

置于

PictureBox

的左上角，凡是因过大而不适合

PictureBox

的任何图像部分都将被剪裁掉。

使用

StretchImage

值会使图像拉伸或收缩，以便适合

PictureBox。

使用

Zoom

的值可以使图像被拉伸或收缩以适应

PictureBox；但是仍然保持原始纵横比。

使用

AutoSize

值会使控件调整大小，以便总是适合图像的大小。

使用

CenterImage

值会使图像居于工作区的中心。

vb.net中怎么实现图片缩小和放大

Pegasus的ImagXpress 8.0控件，支持各种格式文件的加载。控件封装了右键局部区域放大的功能，要实现图片的缩放，把AutoResize属性设置为PegasusImaging.WinForms.ImagXpress8.AutoResizeType.CropImage，修改 ZoomFactor的值就可以了。

vb.net如何将JPG文件缩放至不大于指定的字节数

1.我有个思路可以尝试一下：把一张字节数在280-300K的图片用PS打开看看像素大小；

2.定义一个新的位图，指定像素大小为上面得到的数据；

3.读取你需要修改大小的JPG文件，然后按指定大小复制到上面新建的位图，并保存为JPG格式

当前标题：vb.net修改图片尺寸 vb改变图片大小代码
网页网址：http://scjbc.cn/article/dosgdoj.html