VB6之截图

今天先把主要逻辑写出来，如果有时间就实现一个真正的截图工具。

 Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
 Private OnDraw As Boolean
 Private OnDrag As Boolean
 Private EndDraw As Boolean
 Private LocalX As Single
 Private LocalY As Single
 Private DragX As Single
 Private DragY As Single

 Private Sub Form_Load()
     OnDraw = False
     OnDrag = False
     EndDraw = False

     Shape2().Width =  *
     Shape2().Height =  *
     For i =  To
         Call Load(Shape2(i))
         Shape2(i).Width =  *
         Shape2(i).Height =  *
     Next

     Call ShowShape(False)
 End Sub

 Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
     'drag the rect
     If Button = vbLeftButton And EndDraw = True Then
         If X > Shape1.Left And X < (Shape1.Left + Shape1.Width) And _
             Y > Shape1.Top And Y < (Shape1.Top + Shape1.Height) Then
                 OnDrag = True
                 Me.MousePointer = vbSizeAll
                 DragX = X
                 DragY = Y
                 Exit Sub
         End If
     End If

     'draw the rect
     If Button = vbLeftButton And OnDraw = False Then
         Me.MousePointer = vbCrosshair
         LocalX = X
         LocalY = Y
         Shape1.Left = X
         Shape1.Top = Y
         Shape1.Width =  *
         Shape1.Height =  *
         Call MoveShape
         Call ShowShape(False)
         OnDraw = True
     End If
 End Sub

 Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
     'drag the rect
     If Button = vbLeftButton And OnDrag = True Then
         Shape1.Left = LocalX - (DragX - X)
         Shape1.Top = LocalY - (DragY - Y)
         Call MoveShape
         Exit Sub
     End If

     If Button = vbLeftButton And OnDraw = True Then
         If X > LocalX Then
             Shape1.Width = X - LocalX
         Else
             Shape1.Width = LocalX - X
             Shape1.Left = LocalX - Shape1.Width
         End If

         If Y > LocalY Then
             Shape1.Height = Y - LocalY
         Else
             Shape1.Height = LocalY - Y
             Shape1.Top = LocalY - Shape1.Height
         End If

         Call MoveShape
         Call ShowShape(True)
     End If
 End Sub

 Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
     If Button = vbLeftButton Then
         If OnDrag = True Then
             OnDrag = False
             LocalX = Shape1.Left
             LocalY = Shape1.Top
         End If
         Me.MousePointer = vbDefault
         Call DrawShape
         OnDraw = False
         EndDraw = True
     ElseIf Button = vbRightButton Then
     'RESET
         Call ShowShape(False)
         OnDraw = False
         OnDrag = False
         EndDraw = False
     End If
 End Sub

 Private Sub MoveShape()
     Shape2().Left = Shape1.Left
     Shape2().Top = Shape1.Top

     Shape2().Left = Shape1.Left + Shape1.Width /  - ( * ) /
     Shape2().Top = Shape1.Top

     Shape2().Left = Shape1.Left + Shape1.Width - ( * )
     Shape2().Top = Shape1.Top

     Shape2().Left = Shape1.Left + Shape1.Width - ( * )
     Shape2().Top = Shape1.Top + Shape1.Height /  - ( * ) / 

     Shape2().Left = Shape1.Left + Shape1.Width - ( * )
     Shape2().Top = Shape1.Top + Shape1.Height - ( * )

     Shape2().Left = Shape1.Left + Shape1.Width /  - ( * ) /
     Shape2().Top = Shape1.Top + Shape1.Height - ( * )

     Shape2().Left = Shape1.Left
     Shape2().Top = Shape1.Top + Shape1.Height - ( * )

     Shape2().Left = Shape1.Left
     Shape2().Top = Shape1.Top + Shape1.Height /  - ( * ) /
 End Sub

 Private Sub ShowShape(ByVal bool As Boolean)
     Shape1.Visible = bool
     For i =  To
         Shape2(i).Visible = bool
     Next
     DoEvents
 End Sub

 Private Sub DrawShape()
     Call ShowShape(False)
     Call Picture1.Cls
     Call BitBlt(Picture1.hDC, &, &, Shape1.Width / , Shape1.Height / , Me.hDC, Shape1.Left / , Shape1.Top / , vbSrcCopy)
     Call ShowShape(True)
 End Sub

贴张图：