创建个picturebox 跟两个 commandbutton
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc 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 nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
Private Sub Command1_Click()
Dim w As Long
Dim h As Long
Dim pic As PictureBox
Picture1.Cls
Picture1.AutoRedraw = True
Picture1.ScaleMode = vbPixels
w = Picture1.ScaleWidth
h = Picture1.ScaleHeight
hdcScreen = GetDC(Picture1.hwnd)
p = StretchBlt(Picture1.hdc, 0, 0, w, h, hdcScreen, 0, 0, w, h, vbSrcCopy)
Picture1.Refresh
End Sub
Private Sub Command2_Click()
CommonDialog1.FileName = "pic"
CommonDialog1.Filter = " jpg图片(*.jpg)|*.jpg|位图(*.bmp)|*.bmp"
CommonDialog1.ShowSave
SavePicture Picture1.Image, CommonDialog1.FileName
If Dir(CommonDialog1.FileName) <> "" Then
MsgBox "保存成功 "
Else
MsgBox "保存失败"
End If
End Sub
Private Sub Form_Load()
Command1.Caption = "截图"
Command2.Caption = "保存图片"
End Sub