給你一個(gè)模塊，簡單調(diào)用即可：
站在用戶的角度思考問題，與客戶深入溝通，找到新華網(wǎng)站設(shè)計(jì)與新華網(wǎng)站推廣的解決方案，憑借多年的經(jīng)驗(yàn)，讓設(shè)計(jì)與互聯(lián)網(wǎng)技術(shù)結(jié)合，創(chuàng)造個(gè)性化、用戶體驗(yàn)好的作品，建站類型包括：做網(wǎng)站、網(wǎng)站建設(shè)、企業(yè)官網(wǎng)、英文網(wǎng)站、手機(jī)端網(wǎng)站、網(wǎng)站推廣、空間域名、網(wǎng)絡(luò)空間、企業(yè)郵箱。業(yè)務(wù)覆蓋新華地區(qū)。
一、新建一個(gè)模塊，復(fù)制下面代碼
Option Explicit
'常量聲明
Private Const GdiplusVersion As Long = 1
'結(jié)構(gòu)聲明
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
'根據(jù)版本初始化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
'獲取當(dāng)前窗體(作為臨時(shí)控件的寄存之處)
Function GetCurForm() As Form
'獲取當(dāng)前可用窗體
For Each GetCurForm In Forms
Exit For
Next
End Function
'圖片按指定縮放比例進(jìn)行顯示
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) '讀取顯示數(shù)據(jù)圖片(包括png)
Call GdipGetImageHeight(gdip_pngImage, lngHeight) '
Call GdipGetImageWidth(gdip_pngImage, lngWidth)
lngWidth = lngWidth * Compress / 100
lngHeight = lngHeight * Compress / 100
'動(dòng)態(tài)創(chuàng)建一個(gè)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
'把圖片按指定縮放比例進(jìn)行保存
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
'對(duì)參數(shù)的合法性進(jìn)行處理
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)
'從句柄創(chuàng)建 GDI+ 圖像
'lRes = GdipCreateBitmapFromFile(StrPtr(SrcFilename), lBitmap)
lRes = GdipCreateBitmapFromHBITMAP(pic.Handle, 0, lBitmap)
Dim tJpgEncoder As GUID
Dim tParams As EncoderParameters
'初始化解碼器的GUID標(biāo)識(shí)
Select Case Leix
Case "jpg", "jpeg"
CLSIDFromString StrPtr("{557CF401-1A04-11D3-9A73-0000F81EF32E}"), tJpgEncoder
'設(shè)置解碼器參數(shù)
tParams.Count = 1
With tParams.Parameter(0) ' Quality
'得到Quality參數(shù)的GUID標(biāo)識(shí)
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
二、調(diào)用舉例：
PictureSave "c:\1.bmp", "d:\2.bmp", 50 '表示把c:\1.bmp縮小50%，并保存為d:\2.bmp
PictureBox.SizeMode
屬性
默認(rèn)情況下，在
Normal
模式中，Image
置于
PictureBox
的左上角，凡是因過大而不適合
PictureBox
的任何圖像部分都將被剪裁掉。
使用
StretchImage
值會(huì)使圖像拉伸或收縮，以便適合
PictureBox。
使用
Zoom
的值可以使圖像被拉伸或收縮以適應(yīng)
PictureBox；但是仍然保持原始縱橫比。
使用
AutoSize
值會(huì)使控件調(diào)整大小，以便總是適合圖像的大小。
使用
CenterImage
值會(huì)使圖像居于工作區(qū)的中心。
Pegasus的ImagXpress 8.0控件，支持各種格式文件的加載?？丶庋b了右鍵局部區(qū)域放大的功能，要實(shí)現(xiàn)圖片的縮放，把AutoResize屬性設(shè)置為PegasusImaging.WinForms.ImagXpress8.AutoResizeType.CropImage，修改 ZoomFactor的值就可以了。
1.我有個(gè)思路可以嘗試一下：把一張字節(jié)數(shù)在280-300K的圖片用PS打開看看像素大??；
2.定義一個(gè)新的位圖，指定像素大小為上面得到的數(shù)據(jù)；
3.讀取你需要修改大小的JPG文件，然后按指定大小復(fù)制到上面新建的位圖，并保存為JPG格式
重慶分公司
重慶分公司
