vb 如何获取当前窗口的一部分截图

vb后台运行，获取当前窗口的一部分截图。比如当前窗口的100,100到200,200

在你的主窗口中放置一个PictrueBox设置为Visable = False
然后，你可以设置为一分钟设置一次截图[timer]，以上都是小儿科。

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

在你的timer事件里面写入。

BitBlt PictureBox1.hdc , 0, 0, rWidth, rHeight, form1.hdc , Lt, Top, &HCC0020 ' 或者窗口设备上下文复制在picturebox1中

PictureBox1.Savepicture() '储存图像为文件
==========================================
就是这样，看得懂你就照这样做。看不懂，我就给你具体代码。毕竟，这个自己动手来要好得多。

'以下代码放模块，否则必须适当修改函数权限 Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function EmptyClipboard Lib "user32" () As Long Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (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 Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long Private Declare Function CloseClipboard Lib "user32" () As Long Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public Declare Function ClientToScreen Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long Private Type POINTAPI X As Long Y As Long End Type Public pt1 As POINTAPI, pt2 As POINTAPI Public pt As POINTAPI '函数提供指定区域截图，置入剪切板 Public Sub ScrnCap(Lt As Long, top As Long, Rt As Long, Bot As Long) Dim rWidth, rHeight, SourceDC, DestDC, BHandle, Wnd, DHandle rWidth = Rt - Lt rHeight = Bot - top SourceDC = CreateDC("DISPLAY", 0, 0, 0) DestDC = CreateCompatibleDC(SourceDC) BHandle = CreateCompatibleBitmap(SourceDC, rWidth, rHeight) SelectObject DestDC, BHandle BitBlt DestDC, 0, 0, rWidth, rHeight, SourceDC, Lt, top, &HCC0020 Wnd = Screen.ActiveForm.hwnd OpenClipboard Wnd EmptyClipboard SetClipboardData 2, BHandle CloseClipboard DeleteDC DestDC ReleaseDC DHandle, SourceDC End Sub '********************************************************************************** '以下代码应该放窗体，单击执行 Private Sub Form_Click() Dim Image1 As Object Set Image1 = Controls.Add("VB.Image", "Image1") '添加控件用于显示 Image1.Visible = True: Image1.BorderStyle = 1 '样式 pt1.X = 100 / Screen.TwipsPerPixelX '单位转换 pt1.Y = 100 / Screen.TwipsPerPixelY pt2.X = 1200 / Screen.TwipsPerPixelX pt2.Y = 1200 / Screen.TwipsPerPixelY ClientToScreen Me.hwnd, pt1 '转屏幕坐标 ClientToScreen Me.hwnd, pt2 Call ScrnCap(pt1.X, pt1.Y, pt2.X, pt2.Y) '调用函数，参数为左上，右下坐标 Image1.Picture = Clipboard.GetData() '图像显示 On Error Resume Next Sleep 500 SavePicture Clipboard.GetData, "C:\图片1.bmp" '保存图像 End Sub ’测试通过， '注：自定义函数ScrnCap()是核心截图函数，Form_Click()里有窗口坐标客户区转屏幕的实例代码，很明了，一看就懂

'添加如下声明 private declare function bringwindowtotop lib "user32" (byval hwnd as long) as long private declare function getwindowrect lib "user32" (byval hwnd as long, lprect as rect) as long private declare function getwindowdc 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 type rect left as long top as long right as long bottom as long end type '添加这个函数 private sub getwndpic(wnd as long, pic as picturebox) dim r as rect, dc as long getwindowrect wnd, r '获取指定窗口的左上角、右下角位置(以便获取其大小) dc = getwindowdc(wnd) '得到dc with pic .autoredraw = true: .borderstyle = 0 .parent.scalemode = vbpixels .move .left, .top, r.right - r.left, r.bottom - r.top '使picturebox适合大小 bringwindowtotop wnd '目标窗口提到前面(非置顶) bitblt .hdc, 0, 0, .width, .height, dc, 0, 0, vbsrccopy '复制绘图 end with releasedc wnd, dc '释放 end sub '调用示例(把句柄131454的程序窗口截图放到picture1中) getwndpic 131454, picture1

如以上回答内容为低俗、色情、不良、暴力、侵权、涉及违法等信息，可以点下面链接进行举报！

点此我要举报以上问答信息