■当前位置：首页 > VB 小程序 > 用 PlgBlt 将图像快速任意旋转和变形

　 　 　 72. 用 PlgBlt 将图像快速任意旋转和变形

　　使用 API 函数 PlgBlt 旋转图像，这是我知道的在 VB 中旋转图像速度最快的方法，我相信 Windows 自带的画图程序就是使用了这个函数，但此程序却没有提供按任意角度旋转图片的功能，我感到疑惑。
　　用 PlgBlt 旋转图像比我以前写的另一文章“将图像快速旋转任意角度”采用的方法还快，几乎可以说是瞬间就完成了图像的旋转和变形。玩过祖玛游戏的朋友一定会对那个随鼠标转圈的蛤蟆印象深刻，PlgBlt 就能达到相同的效果。
　　PlgBlt 的功能是：将源对象指定矩形区域的图像复制到目标对象的一个平行四边形区域内，通过设置放置区的平行四边形的四个点，可实现图像的扭曲、翻转、放大、缩小、任意角度旋转等功能。
以下是本程序运行截图:
http://s3/middle/b1879bb4xc93fac595b12&690PlgBlt 将图像快速任意旋转和变形" TITLE="vb代码vb小程序：用 PlgBlt 将图像快速任意旋转和变形" />  

 http://s16/middle/b1879bb4xc93fe1294dbf&690PlgBlt 将图像快速任意旋转和变形" TITLE="vb代码vb小程序：用 PlgBlt 将图像快速任意旋转和变形" />

' ' 下面是窗体代码，在 VB6 调试通过
'需在窗体放置以下控件，除了将 Option1 的 Index 属性设置为 0 外，不必设置其他属性(包括位置和大小)：
'   2 个图片框：Picture1、Picture2
'   1 个按钮：Command1
'   1 个文本框：Text1
'   1 个单选框：Option1（ 在属性窗口将 Option1 的 Index 属性设置为 0 ）
'本人原创，转载请注明出处：

'百度 http://hi.baidu.com/100bd/blog/item/db322dd4d4a281d650da4bc2.html

'新浪 http://blog.sina.com.cn/s/blog_b1879bb401018hbw.html
Dim ctP180 As Double
Private Type PointAPI
    X As Long: Y As Long
End Type
Private Declare Function PlgBlt Lib "gdi32" (ByVal hdcDest As Long, lpPoint As PointAPI, _
   ByVal hdcSrc As Long, ByVal nXSrc As Long, ByVal nYSrc As Long, ByVal nWidth As Long, _
   ByVal nHeight As Long, ByVal hbmMask As Long, ByVal xMask As Long, ByVal yMask As Long) As Long
''PlgBlt 参数说明：
'    hdcDest  目的：设备场景句柄图像
'    lpPoint  目的：PointAPI 结构的数组，指定了图像放置区的位置和大小
'    hdcSrc   源：设备场景句柄
'    nXSrc    源：复制区起点 x 坐标
'    nYSrc    源：复制区起点 y 坐标
'    nWidth   源：复制区宽度
'    nHeight  源：复制区高度
'    hbmMask  掩码（屏蔽）用单色位图的句柄
'    xMask    单色位图左上角的 X 坐标
'    yMask    单色位图左上角的 Y 坐标

Private Sub Form_Load()
    Dim I As Long, W1 As Long, L As Long, T As Long, W As Long
    ctP180 = 4 * Atn(1)  '圆周率 3.14159265358979
    Me.Caption = "旋转和变形": Command1.Caption = "加载图片"
    Text1.Text = 30
    Me.Font.Size = 9: W1 = Me.TextWidth("A")
    L = W1: T = W1
    Command1.Move L, T, W1 * 10, W1 * 3
    W = W1 * 11
    For I = 0 To 9
       If I > 0 Then Load Option1(I)
       Option1(I).Visible = True
       L = L + W1 + W
       If I = 6 Then L = W1: T = T + W1 * 3: W = W1 * 7
       If I = 8 Then W = W1 * 15
       Option1(I).Move L, T, W, W1 * 3
    Next
    Text1.Move L + W, T, W1 * 5, W1 * 2
    Option1(0).Caption = "垂直扭曲"
    Option1(1).Caption = "水平扭曲"
    Option1(2).Caption = "垂直翻转"
    Option1(3).Caption = "水平翻转"
    Option1(4).Caption = "垂直压缩"
    Option1(5).Caption = "水平压缩"
    Option1(6).Caption = "放大"
    Option1(7).Caption = "缩小"
    Option1(8).Caption = "随鼠标转动"
    Option1(9).Caption = "指定角度旋转"
    Option1(8).Value = True: Option1(8).Width = W1 * 14
   
    T = T + W1 * 4
    Picture1.Move W1, T, W1 * 40, W1 * 40
    Picture2.Move W1 * 42, T, W1 * 60, W1 * 60
    
    Picture1.AutoRedraw = True: Picture1.ScaleMode = 3
    Picture1.AutoSize = True
    Picture2.AutoRedraw = True: Picture2.ScaleMode = 3
    
    Picture1.BackColor = RGB(210, 210, 155)
    Picture1.Font.Size = 36
    Picture1.Print Me.Caption
    Picture1.Line (40, 80)-Step(60, 100), 255
End Sub

Private Sub Command1_Click()
   '加载图片
   Static nF As String
   Dim F As String
   If nF = "" Then F = App.Path & "\Tu1.jpg" Else F = nF
   F = Trim(InputBox("请输入图片文件名：", "装载图片", F))
   If F = "" Then Exit Sub
   On Error GoTo Err1
   Picture1.Picture = LoadPicture(F)
   nF = F
   Exit Sub
Err1:
   MsgBox "无法读取图片文件：" & vbCrLf & F, vbInformation, "装载图片"
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Picture1.ZOrder
End Sub
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Picture2.ZOrder
End Sub

Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
   Dim J As Single, x0 As Long, y0 As Long
   If Not Option1(8).Value Then Exit Sub
   x0 = Picture2.ScaleWidth * 0.5: y0 = Picture2.ScaleHeight * 0.5
   Call Jiao(x0, y0, X, Y, J, 0) ' J：返回线段与水平线的夹角
   Call Zhuan(J + ctP180 * 0.5)
   Picture2.Line (x0, y0)-Step(2, 2), 255, BF '画中心点
   Picture2.Refresh
End Sub

Private Sub Option1_Click(Index As Integer)
   Select Case Index
   Case 0: ImgChange 0, 0, 1, 0.25, 0, 1   '垂直扭曲:左上角 右上角 左下角
   Case 1: ImgChange 0.4, 0, 1.4, 0, 0, 1  '水平扭曲
   Case 2: ImgChange 0, 1, 1, 1, 0, 0      '垂直翻转
   Case 3: ImgChange 1, 0, 0, 0, 1, 1      '水平翻转
   Case 4: ImgChange 0, 0, 1, 0, 0, 0.5    '垂直压缩
   Case 5: ImgChange 0, 0, 0.5, 0, 0, 1    '水平压缩
   Case 6: ImgChange 0, 0, 1.5, 0, 0, 1.5  '放大
   Case 7: ImgChange 0, 0, 0.75, 0, 0, 0.75 '缩小
   Case 8:                   '随鼠标转动
   Case 9: Call Text1_Change '指定角度旋转
   End Select
   Text1.Enabled = Index = 9
End Sub

Private Sub ImgChange(x0 As Single, y0 As Single, x1 As Single, y1 As Single, x2 As Single, y2 As Single)
    Dim W As Long, H As Long, nP(0 To 2) As PointAPI
   
    W = Picture1.ScaleWidth: H = Picture1.ScaleHeight '图像的原尺寸
    nP(0).X = W * x0: nP(0).Y = H * y0 '左上角
    nP(1).X = W * x1: nP(1).Y = H * y1 '右上角
    nP(2).X = W * x2: nP(2).Y = H * y2 '左下角
    
    Picture2.Line (0, 0)-(Picture2.ScaleWidth, Picture2.ScaleHeight), &HFFFFFF, BF '抹去原图像
    PlgBlt Picture2.hDC, nP(0), Picture1.hDC, 0, 0, W, H, 0, 0, 0
End Sub

Private Sub Text1_Change()
   Dim J As Single
   J = Val(Text1.Text) / 180 * ctP180
   Zhuan J
End Sub

Private Sub Zhuan(ByVal J As Single)
    '将 Picture1 的图像旋转 J（弧度）后显示在 Picture2
    Dim x0 As Long, y0 As Long, X As Long, Y As Long
    Dim W As Long, H As Long, W2 As Long, H2 As Long
    Dim x02 As Long, y02 As Long, nP(0 To 2) As PointAPI
    
    '旋转前的尺寸
    W = Picture1.ScaleWidth: H = Picture1.ScaleHeight
    
'    '旋转后的新尺寸
'    W2 = Abs(W * Cos(J)) + Abs(H * Sin(J))
'    H2 = Abs(W * Sin(J)) + Abs(H * Cos(J))
'    Picture2.Width = Me.ScaleX(W2, vbPixels, vbTwips)
'    Picture2.Height = Me.ScaleY(H2, vbPixels, vbTwips)

    x0 = W * 0.5: y0 = H * 0.5                                      '旋转中心点
    x02 = Picture2.ScaleWidth * 0.5: y02 = Picture2.ScaleHeight * 0.5 '目的中心点
    
    Zhuan1 J, x0, y0, 0, 0, X, Y '左上角
    nP(0).X = x02 - x0 + X: nP(0).Y = y02 - y0 + Y
   
    Zhuan1 J, x0, y0, W, 0, X, Y '右上角
    nP(1).X = x02 - x0 + X: nP(1).Y = y02 - y0 + Y
   
    Zhuan1 J, x0, y0, 0, H, X, Y '左下角
    nP(2).X = x02 - x0 + X: nP(2).Y = y02 - y0 + Y
   
    Picture2.Line (0, 0)-(Picture2.ScaleWidth, Picture2.ScaleHeight), &HFFFFFF, BF '抹去原图像
    PlgBlt Picture2.hDC, nP(0), Picture1.hDC, 0, 0, W, H, 0, 0, 0
End Sub

Private Sub Zhuan1(ToJ As Single, x0 As Long, y0 As Long, ByVal X As Long, ByVal Y As Long, x1 As Long, y1 As Long)
   '将点 x,y 围绕 x0,y0 顺时针旋转 ToJ 弧度，用 x1,y1 返回旋转后的位置
    Dim J As Single, S As Single
    Call Jiao(x0, y0, X, Y, J, S) 'S：返回线段（x,y - x0,y0）的长度 J：返回线段与水平线的夹角
    x1 = x0 + S * Cos(J + ToJ): y1 = y0 + S * Sin(J + ToJ) '返回旋转后的位置
End Sub

Private Sub Jiao(x0 As Long, y0 As Long, ByVal X As Long, ByVal Y As Long, J As Single, S As Single)
   'S：返回线段（x,y - x0,y0）的长度 J：返回线段与水平线的夹角：弧度
   '注意：要预先设置圆周率 ctP180 = 4 * Atn(1)
    X = X - x0: Y = Y - y0
    S = Sqr(X ^ 2 + Y ^ 2)               'X,Y 与 x0,y0 的距离
    If S = 0 Then J = 0 Else J = Y / S   '与水平线的夹角的正弦值
    If Abs(J) >= 1 Then
       If J > 0 Then J = ctP180 * 0.5 Else J = -ctP180 * 0.5 '90 度时的特殊情况
    Else
       J = Atn(J / Sqr(-J * J + 1)) '与水平线的夹角
    End If
    If X < 0 Then J = -ctP180 - J
End Sub
'本人原创，转载请注明出处：http://blog.sina.com.cn/s/blog_b1879bb401018hbw.html

后记：本程序虽然是 VB 中旋转图像最快的方法，但旋转图像后容易产生锯齿，消除锯齿的方法见：消除旋转图像的锯齿现象

■当前位置：首页 > VB 小程序 > 用 PlgBlt 将图像快速任意旋转和变形