放大缩小翻转 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