VB6之截图

  1 Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, _
  2     ByVal X As Long, _
  3     ByVal Y As Long, _
  4     ByVal nWidth As Long, _
  5     ByVal nHeight As Long, _
  6     ByVal hSrcDC As Long, _
  7     ByVal xSrc As Long, _
  8     ByVal ySrc As Long, _
  9     ByVal dwRop As Long) As Long
 10 Private OnDraw As Boolean
 11 Private OnDrag As Boolean
 12 Private EndDraw As Boolean
 13 Private LocalX As Single
 14 Private LocalY As Single
 15 Private DragX As Single
 16 Private DragY As Single
 17 
 18 Private Sub Form_Load()
 19     OnDraw = False
 20     OnDrag = False
 21     EndDraw = False
 22     
 23     Shape2(0).Width = 5 * 15
 24     Shape2(0).Height = 5 * 15
 25     For i = 1 To 7
 26         Call Load(Shape2(i))
 27         Shape2(i).Width = 5 * 15
 28         Shape2(i).Height = 5 * 15
 29     Next
 30     
 31     Call ShowShape(False)
 32 End Sub
 33 
 34 Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 35     ‘drag the rect
 36     If Button = vbLeftButton And EndDraw = True Then
 37         If X > Shape1.Left And X < (Shape1.Left + Shape1.Width) And _
 38             Y > Shape1.Top And Y < (Shape1.Top + Shape1.Height) Then
 39                 OnDrag = True
 40                 Me.MousePointer = vbSizeAll
 41                 DragX = X
 42                 DragY = Y
 43                 Exit Sub
 44         End If
 45     End If
 46 
 47     ‘draw the rect
 48     If Button = vbLeftButton And OnDraw = False Then
 49         Me.MousePointer = vbCrosshair
 50         LocalX = X
 51         LocalY = Y
 52         Shape1.Left = X
 53         Shape1.Top = Y
 54         Shape1.Width = 100 * 15
 55         Shape1.Height = 100 * 15
 56         Call MoveShape
 57         Call ShowShape(False)
 58         OnDraw = True
 59     End If
 60 End Sub
 61 
 62 Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 63     ‘drag the rect
 64     If Button = vbLeftButton And OnDrag = True Then
 65         Shape1.Left = LocalX - (DragX - X)
 66         Shape1.Top = LocalY - (DragY - Y)
 67         Call MoveShape
 68         Exit Sub
 69     End If
 70     
 71     If Button = vbLeftButton And OnDraw = True Then
 72         If X > LocalX Then
 73             Shape1.Width = X - LocalX
 74         Else
 75             Shape1.Width = LocalX - X
 76             Shape1.Left = LocalX - Shape1.Width
 77         End If
 78         
 79         If Y > LocalY Then
 80             Shape1.Height = Y - LocalY
 81         Else
 82             Shape1.Height = LocalY - Y
 83             Shape1.Top = LocalY - Shape1.Height
 84         End If
 85         
 86         Call MoveShape
 87         Call ShowShape(True)
 88     End If
 89 End Sub
 90 
 91 Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
 92     If Button = vbLeftButton Then
 93         If OnDrag = True Then
 94             OnDrag = False
 95             LocalX = Shape1.Left
 96             LocalY = Shape1.Top
 97         End If
 98         Me.MousePointer = vbDefault
 99         Call DrawShape
100         OnDraw = False
101         EndDraw = True
102     ElseIf Button = vbRightButton Then
103     ‘RESET
104         Call ShowShape(False)
105         OnDraw = False
106         OnDrag = False
107         EndDraw = False
108     End If
109 End Sub
110 
111 Private Sub MoveShape()
112     Shape2(0).Left = Shape1.Left
113     Shape2(0).Top = Shape1.Top
114     
115     Shape2(1).Left = Shape1.Left + Shape1.Width / 2 - (5 * 15) / 2
116     Shape2(1).Top = Shape1.Top
117     
118     Shape2(2).Left = Shape1.Left + Shape1.Width - (5 * 15)
119     Shape2(2).Top = Shape1.Top
120     
121     Shape2(3).Left = Shape1.Left + Shape1.Width - (5 * 15)
122     Shape2(3).Top = Shape1.Top + Shape1.Height / 2 - (5 * 15) / 2
123     
124     Shape2(4).Left = Shape1.Left + Shape1.Width - (5 * 15)
125     Shape2(4).Top = Shape1.Top + Shape1.Height - (5 * 15)
126     
127     Shape2(5).Left = Shape1.Left + Shape1.Width / 2 - (5 * 15) / 2
128     Shape2(5).Top = Shape1.Top + Shape1.Height - (5 * 15)
129     
130     Shape2(6).Left = Shape1.Left
131     Shape2(6).Top = Shape1.Top + Shape1.Height - (5 * 15)
132     
133     Shape2(7).Left = Shape1.Left
134     Shape2(7).Top = Shape1.Top + Shape1.Height / 2 - (5 * 15) / 2
135 End Sub
136 
137 Private Sub ShowShape(ByVal bool As Boolean)
138     Shape1.Visible = bool
139     For i = 0 To 7
140         Shape2(i).Visible = bool
141     Next
142     DoEvents
143 End Sub
144 
145 Private Sub DrawShape()
146     Call ShowShape(False)
147     Call Picture1.Cls
148     Call BitBlt(Picture1.hDC, 0&, 0&, Shape1.Width / 15, Shape1.Height / 15, Me.hDC, Shape1.Left / 15, Shape1.Top / 15, vbSrcCopy)
149     Call ShowShape(True)
150 End Sub