100求自动揭屏代码

[rose_886886]

揭屏后还要求自动保存为bmp文件格式！

[zou19820704]

Option Explicit
Dim i As Long

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 Command1_Click()
Me.AutoRedraw = True
BitBlt Me.hDC, 0, 0, Screen.Width, Screen.Height, _
GetDC(0), 0, 0, vbSrcCopy '抓屏
Dim sFile As String
sFile = "D:\" & Format(Now, "yyyymmddhhmmss") & ".BMP"
SavePicture Me.Image, sFile '保存
' MsgBox "当前屏幕图像已经保存到" & sFile, 64

End Sub

Private Sub Timer1_Timer()
i = i + 1
If i Mod 10 = 0 Then Command1_Click

End Sub