| 一般来说我们会使用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 图形档名
'以下在.BasOption ExplicitDeclare 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 LongDeclare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As LongDeclare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As LongDeclare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As LongConst SRCCOPY = &HCC0020Public Sub DrawBitMap(Dst As Object, ByVal xRate As Double, _ ByVal yRate As Double, ByVal FileName As String)Dim dstWidth As Long, dstHeight As LongDim srcWidth As Long, srcHeight As LongDim x As Long, y As LongDim pic As StdPictureDim hDc5 As Long, i As LongSet pic = LoadPicture(FileName) '读取图形档hDc5 = CreateCompatibleDC(0) '建立Memory DCi = 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 * dstHeightElse y = 0End IfdstWidth = CLng(srcWidth * xRate)If dstWidth < 0 Then x = -1 * dstWidthElse x = 0End IfCall StretchBlt(Dst.hdc, x, y, dstWidth, dstHeight, hDc5, 0, 0, srcWidth, srcHeight, SRCCOPY)Call DeleteDC(hDc5)End SubPublic Sub DrawPicture(Dst As Object, ByVal xRate As Double, _ ByVal yRate As Double, ByVal FileName As String)Dim dstWidth As Long, dstHeight As LongDim srcWidth As Long, srcHeight As LongDim x As Long, y As LongDim pic As StdPictureDim i As LongSet 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 * dstHeightElse y = 0End IfdstWidth = CLng(srcWidth * xRate)If dstWidth < 0 Then x = -1 * dstWidthElse x = 0End IfDst.ScaleMode = 3Dst.PaintPicture pic, x, y, dstWidth, dstHeight, 0, 0, srcWidth, srcHeightEnd Sub'以下在Form需两个command button一个PictureBoxPrivate Sub Command1_Click()Call DrawBitMap(Me, 1.5, -1.5, "c:\windows\circles.bmp") '放大1.5倍并上下翻转End SubPrivate Sub Command2_Click()Call DrawBitMap(Picture1, 1.5, -1.5, "c:\windows\client.ico") '放大1.5倍并上下翻转End Sub
放大缩小翻转 BitMap图 |
