锐客网

  1. 首页 > 生活百科 > it技术 > >

vb.net修改图片尺寸 vb中如何改变图片的大小( 二 )

IT技术修改


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 = https://www.04ip.com/post/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 = https://www.04ip.com/post/VarPtr(TIFF_Compression)
End With
With tParams.Parameter(0)
.NumberOfValues = 1
.Type = 4
CLSIDFromString StrPtr("{66087055-AD66-4C7C-9A18-38A2310B8337}"), .GUID
.Value = https://www.04ip.com/post/VarPtr(TIFF_ColorDepth)

推荐阅读


上一篇：马伊俐文章分享故事公众号，马伊俐代表作

下一篇：phpcms正删改查，php增删改查心得