
程序代码:
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
你要录取视频的时候,调一下Timer1的Interval,设成33左右,就可以了.
附上公式:
Timer的Interval=1000/帧数

程序代码:
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