程序代码：

Private Declare Function GetDesktopWindow Lib "user32" () As Long

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

Private Const SRCCOPY = &HCC0020 

Public Function Screen(FilePath As String) 

        If FilePath="" Then

           FilePath="App.Path" + "\Screen"

        End If

        Dim lngDesktopHwnd As Long

        Dim lngDesktopDC As Long

        Picture1.AutoRedraw = True

        Picture1.ScaleMode = vbPixels

        lngDesktopHwnd = GetDesktopWindow

        lngDesktopDC = GetDC(lngDesktopHwnd)

        'filePath为截屏要保存的路径
        
        Me.Visible = False

        Me.WindowState = 2

        Picture1.Width = Screen.Width

        Picture1.Height = Screen.Height

        Call BitBlt(Picture1.hdc, 0, 0, Screen.Width, Screen.Height, lngDesktopDC, 0, 0, SRCCOPY)

        Picture1.Picture = Picture1.Image'将截图存放到图片框里

        Call ReleaseDC(lngDesktopHwnd, lngDesktopDC)

        Me.Visible = True

        SavePicture Picture1, FilePath        '保存图片

End Function

程序代码：

Private Sub Form_Load()

MkDir (App.Path & "\Screen")'新建一个存放截图的文件夹

Private Sub Timer1_Timer()

Screen("App.Path")'开始截图

End Sub

Private Sub Recording_Click()

Staic Start As Boolean

If Start=True Then

 
   Timer1.Enabled=True

   Recording.Caption="停止录制"

Else

   Timer1.Enabled=False

   Recording.Caption="开始录制"

End If