自动截屏并保存为图片的VB代码
自动定时截屏
截屏'每隔一定时间，自动截取桌面图像保存到指定的文件夹中
'图片文件名为：P-00001.Bmp、P-00002.Bmp 等
'例子需控件：Timer1、Command1、Picture1，都采用默认设置
'标有 '***** 符号的语句可适当修改，以满足个人的特殊要求
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 RasterOpConstants) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Dim ctCi As Long
Private Sub Form_Load()
Timer1.Enabled = False
Timer1.Interval = 1000 '*****每隔 1000 毫秒（1秒）保存一次
Picture1.AutoRedraw = True: Picture1.ScaleMode = vbPixels
Picture1.Move 0, 0, Screen.Width, Screen.Height
Picture1.Visible = False
Me.Caption = "自动定时截屏"
Command1.Caption = "开始截屏"
End Sub
Private Sub Command1_Click()
Timer1.Enabled = Not Timer1.Enabled
If Timer1.Enabled Then Command1.Caption = "暂停截屏" Else Command1.Caption = "开始截屏"
End Sub
Private Sub Timer1_Timer()
Dim nDC As Long, dl As Long, nPath As String, nName As String
nPath = "D:\MyPic" '*****保存的目的文件夹
If Dir(nPath, 23) = "" Then MkDir nPath
nDC = GetWindowDC(0)
'dl 返回非零表示成功，零表示失败
dl = BitBlt(Picture1.hDC, 0, 0, Picture1.ScaleWidth, Picture1.ScaleWidth, nDC, 0, 0, vbSrcCopy)
ctCi = ctCi + 1
nName = ctCi
dl = 5 - Len(nName)
If dl > 0 Then nName = String(dl, "0") & nName
SavePicture Picture1.Image, nPath & "\P-" & nName & ".bmp" '***** P- 表示文件前缀
End Sub

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。