BitBlt Me.hdc, -Me.Left / 15, -Me.Top / 15, Me.Width, Me.Height, hDCtmp, a, b, vbSrcCopy
ReleaseDC 0, hDCtmp 看見了沒，這個是使用窗體的位置進行截圖。窗體的刻度單位是像素，如果是提就把寬和高除以15. 下面是我編的截圖程序，比qq差點吧，今天完善了壹些，勉強可以用，妳看不看的懂就不清楚了。 Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) _
As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, _
ByVal hdc As Long) As Long
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
Dim xx As Integer, yy As Integer, xx1 As Integer, yy1 As Integer, z As Integer
Private Sub Form_Load()
Line1.Visible = False
Line2.Visible = False
Line3.Visible = False
Line4.Visible = False
Label1.Visible = False
Label2.Visible = False
Me.Move 0, 0, Screen.Width, Screen.Height
hDCtmp = GetDC(0)
BitBlt Me.hdc, 0, 0, Me.Width, Me.Height, hDCtmp, a, b, vbSrcCopy
ReleaseDC 0, hDCtmp
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
xx = X
yy = Y
Line1.Visible = True
Line2.Visible = True
Line3.Visible = True
Line4.Visible = True
Label1.Visible = True
Label2.Visible = False
End If
End SubPrivate Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
xx1 = X
yy1 = YLine1.X1 = xx: Line1.Y1 = yy: Line1.X2 = xx: Line1.Y2 = yy1
Line2.X1 = xx: Line2.Y1 = yy: Line2.X2 = xx1: Line2.Y2 = yy
Line3.X1 = xx1: Line3.Y1 = yy: Line3.X2 = xx1: Line3.Y2 = yy1
Line4.X1 = xx: Line4.Y1 = yy1: Line4.X2 = xx1: Line4.Y2 = yy1If xx < xx1 And yy < yy1 Then
Label1.Move xx1, yy1
Label1.Caption = "當前大小" & (xx1 - xx) & "*" & (yy1 - yy) & vbCrLf & "當前RGB(" & _
Abs((ColorCmp And &HFF&) - (Me.Point(xx1, yy1) And &HFF&)) & "," & _
Abs((ColorCmp And &HFF00&) - (Me.Point(xx1, yy1) And &HFF00&)) / &H100& & "," & _
Abs((ColorCmp And &HFF0000) - (Me.Point(xx1, yy1) And &HFF0000)) / &H10000 & ")"
ElseIf xx > xx1 And yy < yy1 Then
Label1.Move xx, yy1
Label1.Caption = "當前大小" & (xx1 - xx) & "*" & (yy1 - yy) & vbCrLf & "當前RGB(" & _
Abs((ColorCmp And &HFF&) - (Me.Point(xx1, yy1) And &HFF&)) & "," & _
Abs((ColorCmp And &HFF00&) - (Me.Point(xx1, yy1) And &HFF00&)) / &H100& & "," & _
Abs((ColorCmp And &HFF0000) - (Me.Point(xx1, yy1) And &HFF0000)) / &H10000 & ")"
ElseIf xx < xx1 And yy > yy1 Then
Label1.Move xx1, yy
Label1.Caption = "當前大小" & (xx1 - xx) & "*" & (yy1 - yy) & vbCrLf & "當前RGB(" & _
Abs((ColorCmp And &HFF&) - (Me.Point(xx1, yy1) And &HFF&)) & "," & _
Abs((ColorCmp And &HFF00&) - (Me.Point(xx1, yy1) And &HFF00&)) / &H100& & "," & _
Abs((ColorCmp And &HFF0000) - (Me.Point(xx1, yy1) And &HFF0000)) / &H10000 & ")"
Else
Label1.Move xx, yy
Label1.Caption = "當前大小" & (xx1 - xx) & "*" & (yy1 - yy) & vbCrLf & "當前RGB(" & _
Abs((ColorCmp And &HFF&) - (Me.Point(xx1, yy1) And &HFF&)) & "," & _
Abs((ColorCmp And &HFF00&) - (Me.Point(xx1, yy1) And &HFF00&)) / &H100& & "," & _
Abs((ColorCmp And &HFF0000) - (Me.Point(xx1, yy1) And &HFF0000)) / &H10000 & ")"
End If
End If
End SubPrivate Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
Dim xxSave As Integer
Dim yySave As Integer
xx1 = X
yy1 = Y
Label2.Visible = True
If xx < xx1 And yy < yy1 Then
Label2.Move xx, yy, xx1 - xx, yy1 - yy
ElseIf xx > xx1 And yy < yy1 Then
Label2.Move xx1, yy, xx - xx1, yy1 - yy
ElseIf xx < xx1 And yy > yy1 Then
Label2.Move xx, yy1, xx1 - xx, yy - yy1
ElseIf xx > xx1 And yy > yy1 Then
Label2.Move xx1, yy1, xx - xx1, yy - yy1
End If
Line1.Visible = False
Line2.Visible = False
Line3.Visible = False
Line4.Visible = False
End If
End SubPrivate Sub Label1_Click()
Me.Cls
Me.Move Label2.Left * 15, Label2.Top * 15, Label2.Width * 15, Label2.Height * 15
hDCtmp = GetDC(0)
BitBlt Me.hdc, -Me.Left / 15, -Me.Top / 15, Me.Width, Me.Height, hDCtmp, a, b, vbSrcCopy
ReleaseDC 0, hDCtmp
SavePicture Me.Image, App.Path & "\" & "截屏" & Minute(Time) & Second(Time) & ".jpg"
End
End SubPrivate Sub Label2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
xx = X / 15
yy = Y / 15
If Label2.MousePointer = vbNormal Then
z = 1
Else
z = 2
End If
End If
End SubPrivate Sub Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
X = X / 15
Y = Y / 15
If (X + 10 >= Label2.Width And Y + 10 >= Label2.Height) Then '右下\左上角
Label2.MousePointer = vbSizeNWSE
If z = 2 Then
If X >= 5 Then
Label2.Width = X
End If
If Y >= 5 Then
Label2.Height = Y
End If
End If
Else
If z = 1 Then
Label2.Left = Label2.Left + X - xx
Label2.Top = Label2.Top + Y - yy
End If
Label2.MousePointer = vbNormal
End If
Label1.Caption = "點此保存" & vbCrLf & _
"圖片寬 " & Label2.Width & vbCrLf & "圖片高 " & Label2.Height & vbCrLf & "當前RGB(" & _
Abs((ColorCmp And &HFF&) - (Me.Point(Label2.Left + X, Label2.Top + Y) And &HFF&)) & "," & _
Abs((ColorCmp And &HFF00&) - (Me.Point(Label2.Left + X, Label2.Top + Y) And &HFF00&)) / &H100& & "," & _
Abs((ColorCmp And &HFF0000) - (Me.Point(Label2.Left + X, Label2.Top + Y) And &HFF0000)) / &H10000 & ")"
Call label1W_Move
End SubPrivate Sub Label2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
z = 0
End Sub
Private Sub label1W_Move()
If Label2.Left + Label2.Width + 100 < Me.Width / 15 Then
Call label1H_Move(Label2.Left + Label2.Width)
ElseIf Label2.Left - 50 > 0 Then
Call label1H_Move(Label2.Left - Label1.Width)
Else
Call label1H_Move(Label2.Left)
End If
End SubPrivate Sub label1H_Move(i As Integer)
If Label2.Top + Label2.Height + 100 < Me.Height / 15 Then
Label1.Move i, Label2.Top + Label2.Height
ElseIf Label2.Top - 50 > 0 Then
Label1.Move i, Label2.Top - Label1.Height
Else
Label1.Move i, Label2.Top
End If
End Sub