放大縮小翻轉 BitMap圖

來源:cww

一般來說我們會使用PaintPicture來完成，而這個方法和StretchBlt的使用很類似，在
此提出兩種不同的方式來達放大縮小翻轉圖形，使用API的DrawBitMap只能使用BitMap圖
，而沒有API的PaintPicture則無此限制，但DrawBitMap在處理大的圖形時，可能較快
些吧。

StretchBlt 其定義如下：
Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, _
	ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, _
	ByVal hSrcdc As Long, ByVal xSrc As Long, ByVal ySrc As Long, _
	ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, _
	ByVal dwRop As Long) As Long

hdc		 待繪圖的hDc
x, y		 待繪圖目標的起點座標
nWidth, nHeight  繪圖的長寬(by Pixels)
hSrcDc		 來源Dc
xSrc, ySrc	 來源圖的起點座標
nSrcWidth, nSrcHeight 來源圖的長寬
dwRop		 繪圖的方式

由以上的參數，我們知道事實上可以取來源圖的一部份(方形區域)來縮放，而目的繪圖
區呢，它可以指定從某個起始座標開始畫(不一定 (0,0) )，而nWidth與nHeight控制圖
的縮放，例如說nWidth = CLng(1.5 * nSrcWidth), nHeight = CLng(nSrcHeight * 1.5)
那代表比原圖放大1.5倍，如果nWidth = -1 * nSrcWidth 表該圖會左右相反，而
nHeight = -1 * nSrcHeight 時則會有上正顛倒的圖出現。以下提供一個副程式，該副
程式簡化了StretchBlt，允許我們畫一個圖於Form/PictureBox的左上角，並可以放大
縮小或翻轉。

DrawBitMap(Dst As Object, ByVal xRate As Double, _
		       ByVal yRate As Double, ByVal FileName As String)

該副程式中
hDst	   是待繪圖的物件(可以為Form或PictureBox)
xRate	   寬度縮放比例
rRate	   長度縮放比例
FileName   圖形檔名


'以下在.Bas
Option Explicit
Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, _
        ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, _
        ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long

Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long

Const SRCCOPY = &HCC0020

Public Sub DrawBitMap(Dst As Object, ByVal xRate As Double, _
		       ByVal yRate As Double, ByVal FileName As String)
Dim dstWidth As Long, dstHeight As Long
Dim srcWidth As Long, srcHeight As Long
Dim x As Long, y As Long
Dim pic As StdPicture
Dim hDc5 As Long, i As Long

Set pic = LoadPicture(FileName) '讀取圖形檔

hDc5 = CreateCompatibleDC(0) '建立Memory DC
i = SelectObject(hDc5, pic.Handle) '在該memoryDC上放上bitmap圖

srcHeight = Dst.ScaleY(pic.Height, vbHimetric, vbPixels)
srcWidth = Dst.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
Call StretchBlt(Dst.hdc, x, y, dstWidth, dstHeight, hDc5, 0, 0, srcWidth, srcHeight, SRCCOPY)
Call DeleteDC(hDc5)
End Sub


Public Sub DrawPicture(Dst As Object, ByVal xRate As Double, _
               ByVal yRate As Double, ByVal FileName As String)
Dim dstWidth As Long, dstHeight As Long
Dim srcWidth As Long, srcHeight As Long
Dim x As Long, y As Long
Dim pic As StdPicture
Dim i As Long

Set pic = LoadPicture(FileName) '讀取圖形檔

srcHeight = Dst.ScaleY(pic.Height, vbHimetric, vbPixels)
srcWidth = Dst.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
Dst.ScaleMode = 3
Dst.PaintPicture pic, x, y, dstWidth, dstHeight, 0, 0, srcWidth, srcHeight

End Sub


'以下在Form需兩個command button一個PictureBox
Private Sub Command1_Click()
Call DrawBitMap(Me, 1.5, -1.5, "c:\windows\circles.bmp") '放大1.5倍並上下翻轉
End Sub

Private Sub Command2_Click()
Call DrawBitMap(Picture1, 1.5, -1.5, "c:\windows\client.ico") '放大1.5倍並上下翻轉
End Sub