資訊好好玩

0愛的鼓勵 0訂閱站台

來源:cww

VB中圖存檔使用 SavePicture 指令，而它的參數是
   picture	      產生圖形檔案的 PictureBox 控制項或 Image 控制項。
   stringexpression   儲存的圖形檔案名稱

而我的作法是：在PictureBox的Image屬性上作動作，因為PictureBox上的Picture經設
定後，它就固定下來，我們在其上的繪圖等動作，基本上沒有動到Picture屬性所指的圖
，而想改變到圖，就只能從Image上著手。所以了，一定得設定PictureBox的AutoRedraw
為True，這才會使繪圖的動作在Image上發生，最後再使用SavePicture的指令，傳Image
當第一個參數來存檔。這裡有另一個重要的問題，如果PictureBox的大小是100*100，
而實際進來的圖是50*50，那麼，PictureBox.Image其大小範圍仍是100*100，因而我一開
始設定PictureBox的長寬各為1，等後來圖放大後，PictureBox Image的大小也隨之變大。
也正因我們使用的是PictureBox的Image物件，所以存檔的結果只能是Bitmap圖，這點要
特別注意。

'需一個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