vb.net 截取鼠标选中屏幕区域并识别文字内容

本人开发环境是visual studio 2022 net 8.0 识别较快，以下为效果图

思路

弹出一个全屏的透明form 在上面用鼠标选中区域，之后截图，同时通过PaddleOCRSharp 识别上面的文字 将文字写入到粘贴板，用组合键ctrl+v就可以复制出。

引入相应的模块

Imports System.Runtime.InteropServices
Imports PaddleOCRSharp
Imports System.IO

父窗口弹出透明的窗体

Dim screen As New FormScreen(Me)
screen.ShowDialog()

子窗体的代码

Imports System.Runtime.InteropServices
Imports PaddleOCRSharp
Imports System.IO

Partial Public Class FormScreen
    Inherits Form
    '定义变量
    Public basepoint As System.Drawing.Point '鼠标坐标
    Public m_down As Boolean '鼠标按下标志
    Private g As Graphics 'gid对象
    Private p As Pen '画笔
    Private i As Image '位图
    Private _parentForm As Form
    Private selecting As Boolean
    Private screenshotBitmap As Bitmap
    Private startPoint As System.Drawing.Point
    Private endPoint As System.Drawing.Point
    ' 程序全局初始化一次即可，不必每次识别都初始化，容易报错。
    ' 初始化 OCR 模型配置，默认中英文 V3 模型
    Private config As OCRModelConfig = Nothing
    ' 初始化 OCR 参数
    Private oCRParameter As New OCRParameter()
    ' 创建一个 OCR 识别结果对象
    Private ocrResult As New OCRResult()
    Public Property ReturnValue As String '此值为返回值 没有使用
    Public Shadows Property ParentForm As Form
        Get
            Return _parentForm
        End Get
        Set(value As Form)
            _parentForm = value
        End Set
    End Property
    Public Sub New(parentForm As Form)
        InitializeComponent()
        '开启双缓存避免闪烁
        Me.DoubleBuffered = True
    End Sub

    '鼠标按下事件
    Private Sub Form1_MouseDown(sender As Object, e As MouseEventArgs) Handles MyBase.MouseDown
        '记录按下位置
        basepoint = e.Location
        startPoint = basepoint
        '按下标志true
        m_down = True
    End Sub

    '鼠标移动事件 画出色框
    Private Sub Form1_MouseMove(sender As Object, e As MouseEventArgs) Handles MyBase.MouseMove
        '鼠标有按下才绘图
        If m_down Then
            '实例化一个和窗口一样大的位图
            i = New Bitmap(Me.Width, Me.Height)
            '创建位图的gdi对象
            g = Graphics.FromImage(i)
            '创建画笔
            p = New Pen(Color.Black, 2.0F)
            '指定线条的样式为划线段
            p.DashStyle = System.Drawing.Drawing2D.DashStyle.Dash
            '根据当前位置画图，使用math的abs()方法求绝对值
            If e.X < basepoint.X AndAlso e.Y < basepoint.Y Then
                g.DrawRectangle(p, e.X, e.Y, System.Math.Abs(e.X - basepoint.X), System.Math.Abs(e.Y - basepoint.Y))
            ElseIf e.X > basepoint.X AndAlso e.Y < basepoint.Y Then
                g.DrawRectangle(p, basepoint.X, e.Y, System.Math.Abs(e.X - basepoint.X), System.Math.Abs(e.Y - basepoint.Y))
            ElseIf e.X < basepoint.X AndAlso e.Y > basepoint.Y Then
                g.DrawRectangle(p, e.X, basepoint.Y, System.Math.Abs(e.X - basepoint.X), System.Math.Abs(e.Y - basepoint.Y))
            Else
                g.DrawRectangle(p, basepoint.X, basepoint.Y, System.Math.Abs(e.X - basepoint.X), System.Math.Abs(e.Y - basepoint.Y))
            End If
            '将位图贴到窗口上
            Me.BackgroundImage = i
            '释放gid和pen资源
            g.Dispose()
            p.Dispose()

        End If
    End Sub

    '鼠标释放事件 此时调用了截屏将画片保存
    Private Sub Form1_MouseUp(sender As Object, e As MouseEventArgs) Handles MyBase.MouseUp
        '清除图像

        i = New Bitmap(Me.Width, Me.Height)
        g = Graphics.FromImage(i)
        g.Clear(Color.Transparent)
        Me.BackgroundImage = i
        g.Dispose()
        '标志位置低
        m_down = False
        endPoint = e.Location
        CaptureScreenshot()
        Debug.WriteLine("Cut End")
        Me.Dispose()


    End Sub

    Private Sub FormScreen_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.Opacity = 0.1 '不进行全透明 否则划线都看不清 自己调整
        ' 获取屏幕的缩放比例
        Dim scaleX As Single = Screen.PrimaryScreen.Bounds.Width / Screen.PrimaryScreen.WorkingArea.Width
        Dim scaleY As Single = Screen.PrimaryScreen.Bounds.Height / Screen.PrimaryScreen.WorkingArea.Height

        ' 根据缩放比例调整窗体的位置和大小
        Me.Size = New System.Drawing.Size(CInt(Screen.PrimaryScreen.WorkingArea.Width * scaleX), CInt(Screen.PrimaryScreen.WorkingArea.Height * scaleY))
        Me.Location = Screen.PrimaryScreen.WorkingArea.Location
        Me.DoubleBuffered = True
    End Sub



    '截屏保存 同时进行了识别文字
    Private Async Sub CaptureScreenshot()


        Dim width As Integer = Math.Abs(endPoint.X - startPoint.X)
        Dim height As Integer = Math.Abs(endPoint.Y - startPoint.Y)

        If width > 0 AndAlso height > 0 Then
            Dim x As Integer = Math.Min(startPoint.X, endPoint.X)
            Dim y As Integer = Math.Min(startPoint.Y, endPoint.Y)

            ' 确保坐标在屏幕范围内
            x = Math.Max(0, Math.Min(x, Screen.PrimaryScreen.Bounds.Width - 1))
            y = Math.Max(0, Math.Min(y, Screen.PrimaryScreen.Bounds.Height - 1))

            ' 获取 DPI 缩放信息
            Dim screenDpiX As Single = Screen.PrimaryScreen.Bounds.Width / CreateGraphics().VisibleClipBounds.Width
            Dim screenDpiY As Single = Screen.PrimaryScreen.Bounds.Height / CreateGraphics().VisibleClipBounds.Height

            ' 进行 DPI 缩放调整
            x = CInt(x * screenDpiX)
            y = CInt(y * screenDpiY)
            width = CInt(width * screenDpiX)
            height = CInt(height * screenDpiY)

            screenshotBitmap = New Bitmap(width, height, Imaging.PixelFormat.Format32bppArgb)

            Using g As Graphics = Graphics.FromImage(screenshotBitmap)
                g.CopyFromScreen(x, y, 0, 0, New System.Drawing.Size(width, height), CopyPixelOperation.SourceCopy)
            End Using

            ' 在此添加保存或处理带有透明度的截图的代码
            screenshotBitmap.Save("C:\s.png", Imaging.ImageFormat.Png)
            screenshotBitmap.Dispose()
            'MessageBox.Show("截图已保存或处理完成。")

            Dim imagebyte = File.ReadAllBytes("C:\s.png")

            ' 将字节数据转换成 Bitmap 图像对象
            Dim bitmap As New Bitmap(New MemoryStream(imagebyte))

            ' 创建 PaddleOCR 引擎，使用之前初始化的配置和参数
            Dim engine As New PaddleOCREngine(config, oCRParameter)

            ' 使用 PaddleOCR 引擎对图像进行文字识别
            ' OCR 识别结果会保存在 ocrResult 对象中
            ocrResult = engine.DetectText(bitmap)

            ' 如果识别结果不为空，显示识别出的文字内容
            If ocrResult IsNot Nothing Then
                ' 弹出一个消息框，显示识别出的文字内容
                Try
                    Clipboard.SetText(ocrResult.Text)
                    MessageBox.Show(ocrResult.Text, "识别结果已复制 请用CTRL+V粘贴")
                Catch
                    MessageBox.Show(":)", "无识别")
                End Try

            End If
        End If
    End Sub
End Class