分享

VB识别屏幕图片图像上的文字内容?

 hdzgx 2017-10-13

使用vb截屏幕,然后识别截图里面的文字。谁有思路可以说一下。
其实就是网页上面FLASH上面的文字,就是一个时间显示。如何读取FLASH上面的时间?
我想了半天,最后确定一个可行的思路,先截屏,然后再把截下来的图识别成数字。
截屏搜了半天使用lhdc = GetDC(0) '获取屏幕DC
        BitBlt Picture1.hDC, 0, 0, 80000, 80000, lhdc, 0, 0, SRCCOPY
已经解决了。
但是是这个获取的图片如何识别成文字呢?谁有好的思路可以说一下。
还有把图片如何变成黑白的?
因为时间上面的背景是变的,显示的时间数字是白色的。如何把图片上白色的保存下来其他颜色全部变成黑色?
这些问题,谁知道都说说

 

主要是先要将图片转换为字节数组
'存放格式为(*, *, *),从左下角开始:
'第一维:0-蓝色分量,1-绿色分量,2-红色分量,
'第二维:列;第三维:行

全部步骤如下
1、用DibGet获取图片数据
2、用ColorToBlackAndWhite(或ColorToGray+OtsuColorToBlackAndWhite)将图片数据转换为黑白数据
3、用DibPut将数据恢复到一个PictureBox中
4、截取各个数字到单独的PictureBox中
5、将数字图片转换为图片数据,并与标准数据(0-9)对比,相似度最高的为准(比如与1的相似度为75%,与2的相似度为85%,则此数字为2)
有问题Hi


'图像输出的过程:
Public Sub DIBPut(ByVal IdDestination As Long, ByRef ImageData() As Byte)
   Dim LineBytes As Long
   Dim Width As Long, Height As Long
  
   Width = UBound(ImageData, 2) + 1
   Height = UBound(ImageData, 3) + 1
  
   On Error GoTo ErrLine
   Done = False
  
   With bi24BitInfo.bmiHeader
      .biWidth = Width
      .biHeight = Height
      LineBytes = ((Width * Bits + 31) And &HFFFFFFE0) \ 8
      .biSizeImage = LineBytes * Height
   End With
   SetDIBitsToDevice IdDestination, 0, 0, Width, Height, 0, 0, 0, Height, ImageData(0, 0, 0), bi24BitInfo, 0
  
   Done = True
   Exit Sub
ErrLine:
   MsgBox Err.Description
End Sub

 

'灰度处理SrcData(0 to 2, 0 to 宽度-1, 0 to 高度-1)
Public Sub ColorToGray(ByRef SrcData() As Byte, ByRef DestData() As Byte, _
                       Optional Left As Long = -1, Optional Top As Long = -1, _
                       Optional Right As Long = -1, Optional Bottom As Long = -1)
   Dim i As Long, j As Long, k As Long
   Dim red As Byte, green As Byte, blue As Byte
   Dim Color As Long, newcolor As Long
   Dim Width As Long, Height As Long
  
   Width = UBound(SrcData, 2) + 1
   Height = UBound(SrcData, 3) + 1
   If Left = -1 Then Left = 0
   If Top = -1 Then Top = 0
   If Right = -1 Then Right = Width - 1
   If Bottom = -1 Then Bottom = Height - 1
  
   For j = Left To Right
      For k = Height - Bottom - 1 To Height - Top - 1
         blue = SrcData(0, j, k)
         green = SrcData(1, j, k)
         red = SrcData(2, j, k)
         newcolor = CLng(0.299 * CDbl(red) + 0.585 * CDbl(green) + 0.114 * CDbl(blue)) '
         newcolor = newcolor * 65793
         red = newcolor Mod 256
         green = newcolor / 256 Mod 256 '(9798 * RValue + 19235 * GValue + 3735 * BValue) / 32768
         blue = newcolor / 256 / 256
         DestData(0, j, k) = blue
         DestData(1, j, k) = green
         DestData(2, j, k) = red
      Next
   Next
End Sub

 

'黑白处理DestData(0 to 2, 0 to 宽度-1, 0 to 高度-1)
'图片最下面两行总是无法参与变换????只好将采集的图片区域向下多延伸2个像素
Public Sub ColorToBlackAndWhite(ByRef SrcData() As Byte, ByRef DestData() As Byte)
   Dim i As Long, j As Long, k As Long
   Dim red As Byte, green As Byte, blue As Byte
   Dim Color As Long, newcolor As Long
   Dim Width As Long, Height As Long

   Width = UBound(SrcData, 2) + 1
   Height = UBound(SrcData, 3) + 1

   For j = 0 To Width - 1
      For k = 0 To Height - 1
         blue = SrcData(0, j, k)
         green = SrcData(1, j, k)
         red = SrcData(2, j, k)
         newcolor = CLng(0.3 * CDbl(red) + 0.59 * CDbl(green) + 0.11 * CDbl(blue))
        newcolor = CLng(0.39 * CDbl(red) + 0.5 * CDbl(green) + 0.11 * CDbl(blue))
         If newcolor > 127 Then newcolor = 255 Else newcolor = 0
         red = newcolor
         green = newcolor
         blue = newcolor
         DestData(0, j, k) = blue
         DestData(1, j, k) = green
         DestData(2, j, k) = red
      Next
   Next
End Sub

 

'黑白处理DestData(0 to 2, 0 to 宽度-1, 0 to 高度-1)
'图片最下面两行总是无法参与变换????只好将采集的图片区域向下多延伸2个像素
'OSTU算法可以说是自适应计算单阈值(用来转换灰度图像为二值图像)的简单高效方法。
'1978 OTSU年提出的最大类间方差法以其计算简单、稳定有效,一直广为使用。
Public Sub OtsuColorToBlackAndWhite(ByRef SrcData() As Byte, ByRef DestData() As Byte)
On Error Resume Next
   Dim i As Long, j As Long, k As Long
   Dim red As Byte, green As Byte, blue As Byte
   Dim Color As Long, newcolor As Long
   Dim Width As Long, Height As Long
   Dim AllSum As Long, SumSmall As Long, SumBig As Long, PartSum As Long
   Dim AllPixelNumber As Integer, PixelNumberSmall As Long, PixelNumberBig As Long
   Dim ProbabilitySmall As Double, ProbabilityBig As Double, Probability As Double, MaxValue As Double
   Dim BmpData() As Byte, Threshold As Byte
   Dim Histgram(255) As Integer '图像直方图,256个点
   Dim PixelNumber As Integer
  
   Width = UBound(SrcData, 2) + 1
   Height = UBound(SrcData, 3) + 1
   PixelNumber = Width * Height
  
   For i = 0 To Width - 1
      For j = 0 To Height - 1
          Histgram(SrcData(0, i, j)) = Histgram(SrcData(0, i, j)) + 1 '统计图像的直方图
      Next
   Next
   For i = 0 To 255
      AllSum = AllSum + i * Histgram(i)    质量矩
      AllPixelNumber = AllPixelNumber + Histgram(i) '  质量
   Next
   MaxValue = -1#
   For i = 0 To 255
      PixelNumberSmall = PixelNumberSmall + Histgram(i)
      PixelNumberBig = AllPixelNumber - PixelNumberSmall
      If PixelNumberBig = 0 Then Exit For
      SumSmall = SumSmall + i * Histgram(i)
      SumBig = AllSum - SumSmall
      ProbabilitySmall = CDbl(SumSmall) / PixelNumberSmall
      ProbabilityBig = CDbl(SumBig) / PixelNumberBig
     Probability = PixelNumberSmall * PixelNumberBig * (ProbabilityBig - ProbabilitySmall) * (ProbabilityBig - ProbabilitySmall)
      Probability = PixelNumberSmall * ProbabilitySmall * ProbabilitySmall + PixelNumberBig * ProbabilityBig * ProbabilityBig
      If Probability > MaxValue Then
          MaxValue = Probability
          Threshold = i
      End If
   Next
      
   For j = 0 To Width - 1
      For k = 0 To Height - 1
         If SrcData(0, j, k) <= Threshold Then
            DestData(0, j, k) = 0
            DestData(1, j, k) = 0
            DestData(2, j, k) = 0
         Else
            DestData(0, j, k) = 255
            DestData(1, j, k) = 255
            DestData(2, j, k) = 255
         End If
      Next
   Next
End Sub

 

'迭代法 (最佳阀值法)
'(1)求出图象的最大灰度值和最小灰度值,分别记为Zl和Zk,令初始阈值为:T=(Zl+Zk)/2
'(2)根据阈值TK将图象分割为前景和背景,分别求出两者的平均灰度值Z0和ZB:
'(3)令当前阈值Tk=(Z0+ZB)/2
'(4)若TK=TK+1, 则所得即为阈值,否则转2,迭代计算。
Public Sub BestThresholdColorToBlackAndWhite(ByRef SrcData() As Byte, ByRef DestData() As Byte)
   Dim i As Long, j As Long, k As Long
   Dim red As Byte, green As Byte, blue As Byte
   Dim Color As Long, newcolor As Long
   Dim Width As Long, Height As Long
   Dim PixelNumber As Integer
   Dim Threshold As Integer, NewThreshold As Integer, MaxGrayValue As Integer
   Dim MinGrayValue As Integer, MeanGrayValue1 As Integer, MeanGrayValue2 As Integer
   Dim IP1 As Long, IP2 As Long, IS1 As Long, IS2 As Long
   Dim Iteration As Long, Histgram(255) As Integer

Width = UBound(SrcData, 2) + 1
   Height = UBound(SrcData, 3) + 1
   PixelNumber = Width * Height
  
   '求出图像中的最小和最大灰度值,并 计算阈值初值为
   MaxGrayValue = 0: MinGrayValue = 255
   For i = 0 To Width - 1
      For j = 0 To Height - 1
          Histgram(SrcData(0, i, j)) = Histgram(SrcData(0, i, j)) + 1 '统计图像的直方图
         If MinGrayValue > SrcData(0, i, j) Then MinGrayValue = SrcData(0, i, j)
         If MaxGrayValue < SrcData(0, i, j) Then MaxGrayValue = SrcData(0, i, j)
      Next
   Next

NewThreshold = (MinGrayValue + MaxGrayValue) / 2
   While Threshold <> NewThreshold And Iteration < 100
       Threshold = NewThreshold
       '根据阈值将图像分割成目标和背景两部分,求出两部分的平均灰度值
       For i = MinGrayValue To Threshold
           IP1 = IP1 + Histgram(i) * i
           IS1 = IS1 + Histgram(i)
       Next
       MeanGrayValue1 = CByte(IP1 / IS1)
       For i = Threshold + 1 To MaxGrayValue
           IP2 = IP2 + Histgram(i) * i
           IS2 = IS2 + Histgram(i)
       Next
       MeanGrayValue2 = CByte(IP2 / IS2)
       '求出新的阈值:
       NewThreshold = (MinGrayValue + MaxGrayValue) / 2
       Iteration = Iteration + 1
   Wend
      
   For j = 0 To Width - 1
      For k = 0 To Height - 1
         If SrcData(0, j, k) <= Threshold Then
            DestData(0, j, k) = 0
            DestData(1, j, k) = 0
            DestData(2, j, k) = 0
         Else
            DestData(0, j, k) = 255
            DestData(1, j, k) = 255
            DestData(2, j, k) = 255
         End If
      Next
   Next
End Sub

 使用vb截屏幕,然后识别截图里面的文字。谁有思路可以说一下。

其实就是网页上面FLASH上面的文字,就是一个时间显示。如何读取FLASH上面的时间?
我想了半天,最后确定一个可行的思路,先截屏,然后再把截下来的图识别成数字。
截屏搜了半天使用lhdc = GetDC(0) '获取屏幕DC
        BitBlt Picture1.hDC, 0, 0, 80000, 80000, lhdc, 0, 0, SRCCOPY
已经解决了。
但是是这个获取的图片如何识别成文字呢?谁有好的思路可以说一下。
还有把图片如何变成黑白的?
因为时间上面的背景是变的,显示的时间数字是白色的。如何把图片上白色的保存下来其他颜色全部变成黑色?
这些问题,谁知道都说说

 

主要是先要将图片转换为字节数组
'存放格式为(*, *, *),从左下角开始:
'第一维:0-蓝色分量,1-绿色分量,2-红色分量,
'第二维:列;第三维:行

全部步骤如下
1、用DibGet获取图片数据
2、用ColorToBlackAndWhite(或ColorToGray+OtsuColorToBlackAndWhite)将图片数据转换为黑白数据
3、用DibPut将数据恢复到一个PictureBox中
4、截取各个数字到单独的PictureBox中
5、将数字图片转换为图片数据,并与标准数据(0-9)对比,相似度最高的为准(比如与1的相似度为75%,与2的相似度为85%,则此数字为2)
有问题Hi


'图像输出的过程:
Public Sub DIBPut(ByVal IdDestination As Long, ByRef ImageData() As Byte)
   Dim LineBytes As Long
   Dim Width As Long, Height As Long
  
   Width = UBound(ImageData, 2) + 1
   Height = UBound(ImageData, 3) + 1
  
   On Error GoTo ErrLine
   Done = False
  
   With bi24BitInfo.bmiHeader
      .biWidth = Width
      .biHeight = Height
      LineBytes = ((Width * Bits + 31) And &HFFFFFFE0) \ 8
      .biSizeImage = LineBytes * Height
   End With
   SetDIBitsToDevice IdDestination, 0, 0, Width, Height, 0, 0, 0, Height, ImageData(0, 0, 0), bi24BitInfo, 0
  
   Done = True
   Exit Sub
ErrLine:
   MsgBox Err.Description
End Sub

 

'灰度处理SrcData(0 to 2, 0 to 宽度-1, 0 to 高度-1)
Public Sub ColorToGray(ByRef SrcData() As Byte, ByRef DestData() As Byte, _
                       Optional Left As Long = -1, Optional Top As Long = -1, _
                       Optional Right As Long = -1, Optional Bottom As Long = -1)
   Dim i As Long, j As Long, k As Long
   Dim red As Byte, green As Byte, blue As Byte
   Dim Color As Long, newcolor As Long
   Dim Width As Long, Height As Long
  
   Width = UBound(SrcData, 2) + 1
   Height = UBound(SrcData, 3) + 1
   If Left = -1 Then Left = 0
   If Top = -1 Then Top = 0
   If Right = -1 Then Right = Width - 1
   If Bottom = -1 Then Bottom = Height - 1
  
   For j = Left To Right
      For k = Height - Bottom - 1 To Height - Top - 1
         blue = SrcData(0, j, k)
         green = SrcData(1, j, k)
         red = SrcData(2, j, k)
         newcolor = CLng(0.299 * CDbl(red) + 0.585 * CDbl(green) + 0.114 * CDbl(blue)) '
         newcolor = newcolor * 65793
         red = newcolor Mod 256
         green = newcolor / 256 Mod 256 '(9798 * RValue + 19235 * GValue + 3735 * BValue) / 32768
         blue = newcolor / 256 / 256
         DestData(0, j, k) = blue
         DestData(1, j, k) = green
         DestData(2, j, k) = red
      Next
   Next
End Sub

 

'黑白处理DestData(0 to 2, 0 to 宽度-1, 0 to 高度-1)
'图片最下面两行总是无法参与变换????只好将采集的图片区域向下多延伸2个像素
Public Sub ColorToBlackAndWhite(ByRef SrcData() As Byte, ByRef DestData() As Byte)
   Dim i As Long, j As Long, k As Long
   Dim red As Byte, green As Byte, blue As Byte
   Dim Color As Long, newcolor As Long
   Dim Width As Long, Height As Long

   Width = UBound(SrcData, 2) + 1
   Height = UBound(SrcData, 3) + 1

   For j = 0 To Width - 1
      For k = 0 To Height - 1
         blue = SrcData(0, j, k)
         green = SrcData(1, j, k)
         red = SrcData(2, j, k)
         newcolor = CLng(0.3 * CDbl(red) + 0.59 * CDbl(green) + 0.11 * CDbl(blue))
        newcolor = CLng(0.39 * CDbl(red) + 0.5 * CDbl(green) + 0.11 * CDbl(blue))
         If newcolor > 127 Then newcolor = 255 Else newcolor = 0
         red = newcolor
         green = newcolor
         blue = newcolor
         DestData(0, j, k) = blue
         DestData(1, j, k) = green
         DestData(2, j, k) = red
      Next
   Next
End Sub

 

'黑白处理DestData(0 to 2, 0 to 宽度-1, 0 to 高度-1)
'图片最下面两行总是无法参与变换????只好将采集的图片区域向下多延伸2个像素
'OSTU算法可以说是自适应计算单阈值(用来转换灰度图像为二值图像)的简单高效方法。
'1978 OTSU年提出的最大类间方差法以其计算简单、稳定有效,一直广为使用。
Public Sub OtsuColorToBlackAndWhite(ByRef SrcData() As Byte, ByRef DestData() As Byte)
On Error Resume Next
   Dim i As Long, j As Long, k As Long
   Dim red As Byte, green As Byte, blue As Byte
   Dim Color As Long, newcolor As Long
   Dim Width As Long, Height As Long
   Dim AllSum As Long, SumSmall As Long, SumBig As Long, PartSum As Long
   Dim AllPixelNumber As Integer, PixelNumberSmall As Long, PixelNumberBig As Long
   Dim ProbabilitySmall As Double, ProbabilityBig As Double, Probability As Double, MaxValue As Double
   Dim BmpData() As Byte, Threshold As Byte
   Dim Histgram(255) As Integer '图像直方图,256个点
   Dim PixelNumber As Integer
  
   Width = UBound(SrcData, 2) + 1
   Height = UBound(SrcData, 3) + 1
   PixelNumber = Width * Height
  
   For i = 0 To Width - 1
      For j = 0 To Height - 1
          Histgram(SrcData(0, i, j)) = Histgram(SrcData(0, i, j)) + 1 '统计图像的直方图
      Next
   Next
   For i = 0 To 255
      AllSum = AllSum + i * Histgram(i)    质量矩
      AllPixelNumber = AllPixelNumber + Histgram(i) '  质量
   Next
   MaxValue = -1#
   For i = 0 To 255
      PixelNumberSmall = PixelNumberSmall + Histgram(i)
      PixelNumberBig = AllPixelNumber - PixelNumberSmall
      If PixelNumberBig = 0 Then Exit For
      SumSmall = SumSmall + i * Histgram(i)
      SumBig = AllSum - SumSmall
      ProbabilitySmall = CDbl(SumSmall) / PixelNumberSmall
      ProbabilityBig = CDbl(SumBig) / PixelNumberBig
     Probability = PixelNumberSmall * PixelNumberBig * (ProbabilityBig - ProbabilitySmall) * (ProbabilityBig - ProbabilitySmall)
      Probability = PixelNumberSmall * ProbabilitySmall * ProbabilitySmall + PixelNumberBig * ProbabilityBig * ProbabilityBig
      If Probability > MaxValue Then
          MaxValue = Probability
          Threshold = i
      End If
   Next
      
   For j = 0 To Width - 1
      For k = 0 To Height - 1
         If SrcData(0, j, k) <= Threshold Then
            DestData(0, j, k) = 0
            DestData(1, j, k) = 0
            DestData(2, j, k) = 0
         Else
            DestData(0, j, k) = 255
            DestData(1, j, k) = 255
            DestData(2, j, k) = 255
         End If
      Next
   Next
End Sub

 

'迭代法 (最佳阀值法)
'(1)求出图象的最大灰度值和最小灰度值,分别记为Zl和Zk,令初始阈值为:T=(Zl+Zk)/2
'(2)根据阈值TK将图象分割为前景和背景,分别求出两者的平均灰度值Z0和ZB:
'(3)令当前阈值Tk=(Z0+ZB)/2
'(4)若TK=TK+1, 则所得即为阈值,否则转2,迭代计算。
Public Sub BestThresholdColorToBlackAndWhite(ByRef SrcData() As Byte, ByRef DestData() As Byte)
   Dim i As Long, j As Long, k As Long
   Dim red As Byte, green As Byte, blue As Byte
   Dim Color As Long, newcolor As Long
   Dim Width As Long, Height As Long
   Dim PixelNumber As Integer
   Dim Threshold As Integer, NewThreshold As Integer, MaxGrayValue As Integer
   Dim MinGrayValue As Integer, MeanGrayValue1 As Integer, MeanGrayValue2 As Integer
   Dim IP1 As Long, IP2 As Long, IS1 As Long, IS2 As Long
   Dim Iteration As Long, Histgram(255) As Integer

Width = UBound(SrcData, 2) + 1
   Height = UBound(SrcData, 3) + 1
   PixelNumber = Width * Height
  
   '求出图像中的最小和最大灰度值,并 计算阈值初值为
   MaxGrayValue = 0: MinGrayValue = 255
   For i = 0 To Width - 1
      For j = 0 To Height - 1
          Histgram(SrcData(0, i, j)) = Histgram(SrcData(0, i, j)) + 1 '统计图像的直方图
         If MinGrayValue > SrcData(0, i, j) Then MinGrayValue = SrcData(0, i, j)
         If MaxGrayValue < SrcData(0, i, j) Then MaxGrayValue = SrcData(0, i, j)
      Next
   Next

NewThreshold = (MinGrayValue + MaxGrayValue) / 2
   While Threshold <> NewThreshold And Iteration < 100
       Threshold = NewThreshold
       '根据阈值将图像分割成目标和背景两部分,求出两部分的平均灰度值
       For i = MinGrayValue To Threshold
           IP1 = IP1 + Histgram(i) * i
           IS1 = IS1 + Histgram(i)
       Next
       MeanGrayValue1 = CByte(IP1 / IS1)
       For i = Threshold + 1 To MaxGrayValue
           IP2 = IP2 + Histgram(i) * i
           IS2 = IS2 + Histgram(i)
       Next
       MeanGrayValue2 = CByte(IP2 / IS2)
       '求出新的阈值:
       NewThreshold = (MinGrayValue + MaxGrayValue) / 2
       Iteration = Iteration + 1
   Wend
      
   For j = 0 To Width - 1
      For k = 0 To Height - 1
         If SrcData(0, j, k) <= Threshold Then
            DestData(0, j, k) = 0
            DestData(1, j, k) = 0
            DestData(2, j, k) = 0
         Else
            DestData(0, j, k) = 255
            DestData(1, j, k) = 255
            DestData(2, j, k) = 255
         End If
      Next
   Next
End Sub

 

    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。
    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约

    类似文章 更多