'需一個PictureBox, 一個Command button
Option Explicit
Dim pic As New StdPicture
Private Sub Command1_Click()
Set pic = LoadPicture("e:\girl.bmp") '請輸入想放大/縮小的圖
Call setScope(pic, 0.5, 0.5, Picture1) '縮小0.5倍,將之放入Picture1
SavePicture Picture1.Image, "e:\t2.bmp" '存檔
Picture1.Visible = True
End Sub
Private Sub Form_Load()
Me.ScaleMode = 3
Picture1.AutoRedraw = True
Picture1.ScaleMode = 3
Picture1.BorderStyle = 0
Picture1.Visible = False
Picture1.Width = 1 '設定PictureBox為最小
Picture1.Height = 1
End Sub
Private Sub setScope(pic As StdPicture, ByVal xRate As Double, _
ByVal yRate As Double, pic2 As PictureBox)
Dim dstWidth As Long, dstHeight As Long
Dim srcWidth As Long, srcHeight As Long
Dim x As Long, y As Long
Dim i As Long
srcHeight = pic2.ScaleY(pic.Height, vbHimetric, vbPixels)
srcWidth = pic2.ScaleX(pic.Width, vbHimetric, vbPixels)
dstHeight = CLng(srcHeight * yRate)
If dstHeight < 0 Then
y = -1 * dstHeight
Else
y = 0
End If
dstWidth = CLng(srcWidth * xRate)
If dstWidth < 0 Then
x = -1 * dstWidth
Else
x = 0
End If
pic2.Width = Abs(dstWidth) '改變PictureBox的大小
pic2.Height = Abs(dstHeight)
pic2.PaintPicture pic, x, y, dstWidth, dstHeight, 0, 0, srcWidth, srcHeight
End Sub
|