=======================按键截取===================
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)

Private Sub Command1_Click()
	Call keybd_event(vbKeySnapshot, 0, 0, 0)     '全屏
End Sub

Private Sub Command2_Click()
	Call keybd_event(vbKeySnapshot, 1, 0, 0)     '当前窗体
End Sub

Private Sub Command3_Click()
	SavePicture Clipboard.GetData, "C:\图片.bmp" '保存图片
End Sub
=========================非(按键截取)===========================
Private Declare Function GetDC Lib "user32" (ByVal hwnd 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

Private Sub Form_Load()
    Me.Hide                '窗体不可见
    On Error Resume Next   '出错忽略
    Me.AutoRedraw = True   '自动重画
    Timer1.Interval = 1000 '每十秒一抓
End Sub

Private Sub Timer1_Timer()
BitBlt hDC, 0, 0, Screen.Width, Screen.Height, GetDC(0), 0, 0, vbSrcCopy   '抓屏
SavePicture Me.Image, "c:\图片.BMP"    '保存
End Sub
=========================指定区域截取===========================
Option Explicit
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (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
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long

Sub ScrnCap(Lt As Integer, top As Integer, Rt As Integer, Bot As Integer) '屏幕截图核心函数
	Dim rWidth, rHeight, SourceDC, DestDC, BHandle, Wnd, DHandle
	rWidth = Rt - Lt
	rHeight = Bot - top
	SourceDC = CreateDC("DISPLAY", 0, 0, 0)
	DestDC = CreateCompatibleDC(SourceDC)
	BHandle = CreateCompatibleBitmap(SourceDC, rWidth, rHeight)
	SelectObject DestDC, BHandle
	BitBlt DestDC, 0, 0, rWidth, rHeight, SourceDC, Lt, top, &HCC0020
	Wnd = Screen.ActiveForm.hwnd
	OpenClipboard Wnd
	EmptyClipboard
	SetClipboardData 2, BHandle
	CloseClipboard
	DeleteDC DestDC
	ReleaseDC DHandle, SourceDC
End Sub

Private Sub Command1_Click()
	Call ScrnCap(0, 0, 100, 300) '4个参数分别为：左上角X,左上角Y,右上角X,右上角Y
	Image1.Picture = Clipboard.GetData()
End Sub
=========================裁剪图片=========================
Private Sub Command1_Click()
	Dim fn As String, xx As Single, yy As Single, ww As Single, hh As Single
	'fn = "c:\1.bmp"   '裁剪图片名及路径
	xx = 500           '裁剪横坐标
	yy = 500           '裁剪纵坐标
	ww = 100           '裁剪宽度
	hh = 100           '裁剪高度
	Picture1.Width = ww
	Picture1.Height = hh
	Picture1.PaintPicture Picture1.Picture, 0, 0, ww, hh, xx, yy, ww, hh
	Picture2.Picture = Picture1.Image
End Sub

Private Sub Form_Load()
	Me.ScaleMode = 3
	Picture1.Visible = False
	Picture1.BorderStyle = 0
	Picture1.AutoRedraw = True
	Picture1.ScaleMode = 3
End Sub