vb如何截图 - VB6论坛

楼主

问题点数：0 回复次数：2

vb如何截图

我用这段代码可以截图，但图片是整个屏幕的，我只要截取程序本身界面的图片就好，这段代码要如何改

程序代码：

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

搜索更多相关主题的帖子: 图片　

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, Me.Width, Me.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(Me.hwnd)'---------改动了这里 '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