VB.NET截屏工具 - g12339645的博客

作者在 2020-08-15 18:27:47 发布以下内容

WIN7有个截图工具比较不错，用VB.NET如何实现呢？

在这里做个简单的实现。

一首先在VB.NET中添加两个窗体FrmMain、frmScreen，一个模块JTModule

二开始实现截图

1 在模块中加入以下语句，做为全局变量

 Public JTyangshi As Integer = 0'截图样式
    Public yuantu As Image'原图，用于存图片
    Public baocun As Boolean = False'是否保存，初始不保存

2 将窗体frmScreen样式FormBorderStyle改为None，WindowState 改为Maximized（最大）

拖一个PictureBox控件，设置PictureBox控件Dock属性为Fill（填充）

3 设计窗体FrmMain，拖1个Button、4个RadioButton控件

Button按钮TEXT改成“截图”，4个RadioButton控件TEXT改成截图的样式

“全屏”、“矩形”、“任意”、“窗口”

4 窗体FrmMain内代码

  Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Me.Hide()
        Threading.Thread.Sleep(200)
        Dim p1 As New Point(0, 0)
        Dim p2 As New Point(Screen.PrimaryScreen.Bounds.Width, Screen.PrimaryScreen.Bounds.Height)
        Dim pic As New Bitmap(p2.X, p2.Y, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
        Using g As Graphics = Graphics.FromImage(pic)
            g.CopyFromScreen(p1, p1, p2, System.Drawing.CopyPixelOperation.SourceCopy)
        End Using
        frmScreen.PictureBox1.Image = pic
        yuantu = pic
        frmScreen.Show()
        frmScreen.TopLevel = True
    End Sub
    Private Sub FrmMain_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        JTyangshi = 0
    End Sub
    Private Sub RadioButton1_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles RadioButton1.CheckedChanged, RadioButton2.CheckedChanged, RadioButton3.CheckedChanged, RadioButton4.CheckedChanged
        If RadioButton1.Checked Then JTyangshi = 0
        If RadioButton2.Checked Then JTyangshi = 1
        If RadioButton3.Checked Then JTyangshi = 2
        If RadioButton4.Checked Then JTyangshi = 3
    End Sub

简要说明如下

窗体加载中设定截图样式为0（全屏方式）;

RadioButton改变时截图样式改变（全局变量JTyangshi）;

截图按钮按单击时：

FrmMain窗体隐藏,进程停200毫秒，定义屏幕左上点P1，定义屏幕右下点P2，

定义新的图片pic并设置为屏幕大小，定义画布g,用CopyFromScreen方法复制屏幕，

结束画布应用，frmScreen窗体PictureBox1控件赋值， yuantu（原图）赋值（备用），

frmScreen窗体显示，frmScreen窗体置顶。

程序运行到此，frmScreen窗体显示原屏幕图片并置顶。

5 frmScreen窗体内代码如下，主要功能鼠标右键单击，保存图片，鼠标左键可进行矩形、任意形状选择。

Public Class frmScreen
    Private p1 As Point, p2 As Point
    Private penPath As New Drawing2D.GraphicsPath
    Private mye As Drawing.Graphics
    Private Sub frmScreen_VisibleChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.VisibleChanged
        Select Case JTyangshi
            Case 0 '全屏截图
                Me.Cursor = Cursors.Default
            Case 1 '矩形截图
                Me.Cursor = Cursors.Cross
            Case 2 '任意形状截图
                Me.Cursor = Cursors.Cross
            Case 3 '选择窗口
                Me.Cursor = Cursors.Hand
        End Select
    End Sub
    Private Sub PictureBox1_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseDown
        If e.Button = Windows.Forms.MouseButtons.Left Then
            Select Case JTyangshi
                Case 0 '全屏截图
                Case 1 '矩形截图
                    p1 = New Point(e.X, e.Y)
                Case 2 '任意形状截图
                    p1 = New Point(e.X, e.Y)
                    penPath.Reset()
                    penPath.AddRectangle(New Rectangle(p1, New Size(1, 1)))
                Case 3 '选择窗口
                    Me.Hide()
                    Threading.Thread.Sleep(200)
                    '
                    Dim myhandle As IntPtr = getWindowsHDC()
                    GetWndPic(myhandle)
                    Me.Show()
            End Select
        End If
    End Sub
    Private Sub PictureBox1_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseMove
        If e.Button = Windows.Forms.MouseButtons.Left Then
            Select Case JTyangshi
                Case 0 '全屏截图
                Case 1 '矩形截图
                    p2 = New Point(e.X, e.Y)
                    drawJUXING()
                Case 2 '任意形状截图
                    p2 = New Point(e.X, e.Y)
                    penPath.AddLine(p1, p2)
                    p1 = p2
                    Dim pic As New Bitmap(PictureBox1.Width, PictureBox1.Height)
                    mye = Graphics.FromImage(pic)
                    mye.DrawImage(yuantu, 0, 0)
                    mye.DrawPath(Pens.Blue, penPath)
                    PictureBox1.Image = pic
                    mye.Dispose()
                    PictureBox1.Refresh()
                Case 3 '选择窗口
            End Select
        End If
    End Sub
    Private Sub PictureBox1_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles PictureBox1.MouseUp
        If e.Button = Windows.Forms.MouseButtons.Left Then
            Select Case JTyangshi
                Case 0 '全屏截图
                Case 1 '矩形截图
                    p2 = New Point(e.X, e.Y)
                    drawJUXING()
                    Dim jx As Rectangle = getjuxing(p1, p2)
                    Dim pic As New Bitmap(jx.Width, jx.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
                    mye = Graphics.FromImage(pic)
                    mye.DrawImage(yuantu, 0, 0, jx, GraphicsUnit.Pixel)
                    My.Computer.Clipboard.SetImage(pic)
                    mye.Dispose()
                    pic.Dispose()
                Case 2 '任意形状截图
                    penPath.CloseFigure()
                    Dim pic As New Bitmap(PictureBox1.Width, PictureBox1.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
                    mye = Graphics.FromImage(pic)
                    mye.DrawImage(yuantu, 0, 0)
                    mye.DrawPath(Pens.Blue, penPath)
                    PictureBox1.Image = pic
                    mye.Dispose()
                    PictureBox1.Refresh()
                    Dim picJQB As New Bitmap(PictureBox1.Width, PictureBox1.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
                    Dim eJQB As Graphics = Graphics.FromImage(picJQB)
                    eJQB.Clear(Color.White)
                    eJQB.FillPath(New TextureBrush(yuantu), penPath)
                    Dim picj As New Bitmap(CInt(penPath.GetBounds.Width), CInt(penPath.GetBounds.Height), System.Drawing.Imaging.PixelFormat.Format32bppArgb)
                    Dim ej As Graphics = Graphics.FromImage(picj)
                    ej.DrawImage(picJQB, 0, 0, New Rectangle(penPath.GetBounds.Left, penPath.GetBounds.Top, CInt(penPath.GetBounds.Width), CInt(penPath.GetBounds.Height)), GraphicsUnit.Pixel)
                    My.Computer.Clipboard.SetImage(picj)
                    eJQB.Dispose()
                    ej.Dispose()
                    picJQB.Dispose()
                    picj.Dispose()
                Case 3 '选择窗口

            End Select
        End If
        If e.Button = Windows.Forms.MouseButtons.Right Then
            Select Case JTyangshi
                Case 0 '全屏截图
                    My.Computer.Clipboard.SetImage(yuantu)
                Case 1 '矩形截图
                Case 2 '任意形状截图
                Case 3 '选择窗口
            End Select
            savetupian()
            Me.Hide()
            FrmMain.Show()
        End If
    End Sub
    Private Sub drawJUXING()
        Dim pic As New Bitmap(PictureBox1.Width, PictureBox1.Height)
        mye = Graphics.FromImage(pic)
        mye.DrawImage(yuantu, 0, 0)
        mye.DrawRectangle(Pens.Red, getjuxing(p1, p2))
        PictureBox1.Image = pic
        mye.Dispose()
        PictureBox1.Refresh()
        Threading.Thread.Sleep(20)
    End Sub
    Private Function getjuxing(ByVal jp1 As Point, ByVal jp2 As Point) As Rectangle
        If jp1.X = jp2.X And jp1.Y = jp2.Y Then
            jp2.X = jp1.X + 1
            jp2.Y = jp1.Y + 1
        End If
        Dim jx1 As Point = New Point(Math.Min(jp1.X, jp2.X), Math.Min(jp1.Y, jp2.Y))
        Return New Rectangle(jx1.X, jx1.Y, Math.Abs(jp1.X - jp2.X), Math.Abs(jp1.Y - jp2.Y))
    End Function
    Public Sub savetupian()
        Dim opic As Bitmap = My.Computer.Clipboard.GetImage
        My.Computer.Clipboard.Clear()
        If IsNothing(opic) Then
        Else
            Dim sdlag As New Windows.Forms.SaveFileDialog
            sdlag.Filter = "bmp文件|*.bmp|gif文件|*.gif|jpeg文件|*.jpeg|png文件|*.png|tiff文件|*.tiff"
            sdlag.InitialDirectory = My.Application.Info.DirectoryPath

            If sdlag.ShowDialog() = Windows.Forms.DialogResult.OK Then
                If sdlag.FileName <> "" Then
                    Select Case sdlag.FilterIndex
                        Case 1
                            opic.Save(sdlag.FileName, System.Drawing.Imaging.ImageFormat.Bmp)
                        Case 2
                            opic.Save(sdlag.FileName, System.Drawing.Imaging.ImageFormat.Gif)
                        Case 3
                            opic.Save(sdlag.FileName, System.Drawing.Imaging.ImageFormat.Jpeg)
                        Case 4
                            opic.Save(sdlag.FileName, System.Drawing.Imaging.ImageFormat.Png)
                        Case 5
                            opic.Save(sdlag.FileName, System.Drawing.Imaging.ImageFormat.Tiff)
                        Case Else
                    End Select
                End If
            Else

            End If

        End If
    End Sub
End Class

------------------------

三窗体截图

有个简单方法仅供参考

在主窗体代码引用

Imports System.Diagnostics.Process

增加公共变量

Public pid As Process()‘存储所有进程
Public listProcessIndex As New List(Of Integer)’泛型，存储pid变量进程下标

主窗体加个按钮，一个LISTBOX

按钮代码（button2）其中Button2.Text = "刷新窗口进程，在以下列表选择一个窗口项（双击截图）"

 Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

        pid = Process.GetProcesses '获得系统所有进程
        ListBox1.Items.Clear() '清零
        listProcessIndex.Clear() '清零
        For i As Integer = 0 To pid.Count - 1 '将有主窗口且窗口标题不为空的进程加进LISTBOX
            If pid(i).MainWindowHandle <> 0 And pid(i).MainWindowTitle <> "" Then
                ListBox1.Items.Add(pid(i).MainWindowTitle + " // 窗口ID  " + pid(i).MainWindowHandle.ToString + " //")
                listProcessIndex.Add(i) '记录pid进程下标
            End If
        Next
    End Sub

listbox双击代码：

Private Sub ListBox1_DoubleClick(ByVal sender As Object, ByVal e As System.EventArgs) Handles ListBox1.DoubleClick
        Dim WindowCaption As String = ""
        Dim ClassName As String = ""
        Dim hWnd As Integer = 0
        If ListBox1.SelectedIndex <> -1 Then
            ClassName = pid(listProcessIndex.Item(ListBox1.SelectedIndex)).ProcessName
            WindowCaption = pid(listProcessIndex.Item(ListBox1.SelectedIndex)).MainWindowTitle
            hWnd = pid(listProcessIndex.Item(ListBox1.SelectedIndex)).MainWindowHandle
            '  MsgBox(ClassName & "|" & WindowCaption & "|" & hWnd.ToString)
            hWnd = pid(listProcessIndex.Item(ListBox1.SelectedIndex)).MainWindowHandle
            ' 如果找不到窗口，则 FindWindow 将窗口句柄设置为 0。如果该
            ' 句柄为 0，则会显示错误信息，否则会将该窗口置于前台。
            If hWnd = 0 Then
                MsgBox("Specified window is not running.", MsgBoxStyle.Exclamation, Me.Text)
            Else
                ' 将窗口设置为前台窗口。
                SetForegroundWindow(hWnd)
                ' 如果窗口是最小化的，则只需将其还原，否则应显示该窗口。注意，
                'IsIconic 的声明将返回值定义为 Boolean，
                ' 从而允许 .NET 将整数值封送到 Boolean。
                If IsIconic(hWnd) Then
                    ShowWindow(hWnd, SW_RESTORE)
                Else
                    ShowWindow(hWnd, SW_SHOW)
                End If

            End If
            Threading.Thread.Sleep(200)
            GetWndPic(hWnd)
            frmScreen.savetupian() '保存图片
        Else
        End If
    End Sub

API代码：

SetForegroundWindow，将窗口置前

 Public Declare Function IsIconic Lib "user32.dll" Alias "IsIconic" (ByVal hwnd As Integer) As Boolean
    Public Declare Function SetForegroundWindow Lib "user32.dll" Alias "SetForegroundWindow" (ByVal hwnd As Integer) As Integer



	GetWndPic代码如下：

Public Sub GetWndPic(ByVal Wnd As IntPtr) '根据窗口句柄将窗口截图到PIC
        Dim R As RECT, DC As IntPtr
        Dim mSize As Size
        ' BringWindowToTop(Wnd) '目标窗口提到前面(非置顶)
        '  ShowWindow(Wnd, 1)
        '  SetWindowPos(Wnd, HWND_TOPMOST, 0&, 0&, 0&, 0&, &H1 Or &H2)
        ' DC = GetWindowDC(Wnd) '得到dc
        GetWindowRect(Wnd, R) '获取指定窗口bai的左上角du、右下角位置(以便获取其大小)
        mSize = New Size(R.Right - R.Left, R.Bottom - R.Top) '定义大小
        '  Dim a As Integer = BitBlt(, 0, 0, mSize.Width, mSize.Height, DC, 0, 0, SRCCOPY) '复制绘图
        Dim bmp As Image = New Bitmap(mSize.Width, mSize.Height, Imaging.PixelFormat.Format32bppArgb)
        Dim g As Graphics = Graphics.FromImage(bmp)
        Threading.Thread.Sleep(200)
        g.CopyFromScreen(R.Left, R.Top, 0, 0, mSize, Drawing.CopyPixelOperation.SourceCopy)
        My.Computer.Clipboard.SetImage(bmp) '存到剪贴板
        g.Dispose()
       ' ReleaseDC(Wnd, DC) '释放

    End Sub

最后，窗口截图还可通过鼠标进行。

主要用到API有 GetCursorPos、 WindowFromPoint、GetParent、 GetWindowText、GetClassName

代码如下：

Public Declare Function GetParent Lib "user32" (ByVal hwnd As IntPtr) As Integer

'获取鼠标指针的当前位置
Public Declare Function GetCursorPos Lib "user32" Alias "GetCursorPos" (ByRef lpPoint As POINTAPI) As Integer

'返回包含了指定点的窗口的句柄。忽略屏蔽、隐藏以及透明窗口
Public Declare Function WindowFromPoint Lib "user32" Alias "WindowFromPoint" (ByVal xPoint As Integer, ByVal yPoint As Integer) As IntPtr

'为指定的窗口取得类名
    Public Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As IntPtr, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Long
    '取得一个窗体的标题（caption）文字，或者一个控件的内容（在vb里使用：使用vb窗体或控件的caption或text属性）
    Public Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As IntPtr, ByVal lpString As String, ByVal cch As Integer) As Integer

Public Function getWindowsHDC() As IntPtr '得到窗口句柄
        Dim msg As String = ""
        Dim shubiao As POINTAPI
        Dim Leiming As String, Biaoti As String
        Leiming = Space(255)
        Biaoti = Space(255)
        GetCursorPos(shubiao)
        Dim mm As Point = System.Windows.Forms.Cursor.Position
        msg = "坐标：" + shubiao.X.ToString() & " , " & shubiao.Y.ToString() + vbCrLf
        Dim hdc As IntPtr = WindowFromPoint(shubiao.X, shubiao.Y)
        msg += "句柄：" + hdc.ToString() + vbCrLf
        msg += "父窗体句柄为" + GetParent(hdc).ToString + vbCrLf
        GetWindowText(hdc, Biaoti, 255)
        msg += "标题：" + Biaoti + vbCrLf
        GetClassName(hdc, Leiming, 255)
        msg += "类名称：" + Leiming + vbCrLf
        MsgBox(msg)
        Return hdc
    End Function

上边代码没有对父窗体进行循环判断，若是最上层窗口或不是最上层窗口该如何，未处理。

附现程序界面

将方法