【问题标题】:How can I do zonal OCR in VB6?如何在 VB6 中进行区域 OCR?
【发布时间】:2012-06-09 10:15:35
【问题描述】:

正如您在下面看到的那样,我制作了一个程序来扫描文档并可选择获取页面信息、材料和尺寸信息以及日期信息。

当我像这样使用 OCR 扫描时:

Dim Mdoc As MODI.Document
Dim Mlay As MODI.Layout
Dim fso As Scripting.FileSystemObject
Dim logfile As Object

Public Function ScanMan(ByVal Name As String, ByVal Path As String) As String
    Set Mdoc = New MODI.Document
    'Set Mdoc = CreateObject("MODI.Document")
    Set fso = New Scripting.FileSystemObject

    DoEvents
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''''''''''''''' Create OCRLog File '''''''''''''''''''
    OCRPath = App.Path & "\OCR Results Log\"
    OCRName = Str(DateTime.Date) & " OCRresults"
    If fso.FolderExists(OCRPath) = False Then
        fso.CreateFolder (OCRPath)
    End If
    If fso.FileExists(OCRPath & OCRName & ".txt") = False Then
        fso.CreateTextFile OCRPath & OCRName & ".txt"
    End If
    Set logfile = fso.OpenTextFile(OCRPath & OCRName & ".txt", ForAppending)
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    On Error GoTo OCRErr
    DoEvents
    Mdoc.Create Path & "\" & Name
    Mdoc.Images(0).OCR miLANG_ENGLISH, True, True
    logfile.Write Mdoc.Images(0).Layout.Text

    ScanMan = Mlay.Text

    Mdoc.Close False

    Set Mlay = Nothing
    Set Mdoc = Nothing

    Exit Function

OCRErr:
    logfile.WriteLine "OCR given (" & Err.Number & ") numbered (" & Err.Description & ") error."
    logfile.Close
End Function

这会获取整个页面,但我只想扫描这 3 个特定区域,那么我该如何实现呢?有什么功能吗?哪个只扫描 X,Y 坐标?

【问题讨论】:

    标签: vb6 ocr scanning modi


    【解决方案1】:

    vb6 sn-p

    Sub TestTextSelection()
    
      Dim miTextSel As MODI.IMiSelectableItem
      Dim miSelectRects As MODI.miSelectRects
      Dim miSelectRect As MODI.miSelectRect
      Dim strTextSelInfo As String
    
      Set miTextSel = MiDocView1.TextSelection
      Set miSelectRects = miTextSel.GetSelectRects
      strTextSelInfo = _
        "Bounding rectangle page & coordinates: " & vbCrLf
      For Each miSelectRect In miSelectRects
        With miSelectRect
          strTextSelInfo = strTextSelInfo & _
            .PageNumber & ", " & .Top & ", " & _
            .Left & ", " & .Bottom & ", " & _
            .Right & vbCrLf
        End With
      Next
      MsgBox strTextSelInfo, vbInformation + vbOKOnly, _
        "Text Selection Info"
    
      Set miSelectRect = Nothing
      Set miSelectRects = Nothing
      Set miTextSel = Nothing
    
    End Sub
    

    虽然问题被标记为vb6,但答案来自vb.Net 2010。我希望vb.NET 可以很容易地转换为vb6,只是多花一些时间而已。

    基本思想是从图像创建一个 xml 文件,然后对 xml 文件运行查询以获取由 (x1,y1) 和 (x2,y2) 包围的所需块的文本。

    The core class

    Imports System
    Imports System.IO
    Imports System.Xml
    Imports System.Linq
    Imports MODI
    
    Public Class clsCore
        Public Sub New()
            'blah blah blah
        End Sub
    
        Public Function GetTextFromCoordinates(ByVal iPath$, ByVal x1&, ByVal y1&, ByVal x2&, ByVal y2&) As String
            Try
                Dim xDoc As XElement = Me.ConvertImage2XML(iPath)
                If IsNothing(xDoc) = False Then
                    Dim result As New XElement(<text/>)
                    Dim query = xDoc...<wd>.Where(Function(c) Val(CStr(c.@left)) >= x1 And Val(CStr(c.@right)) <= x2 And Val(CStr(c.@top)) >= y1 And Val(CStr(c.@bottom)) <= y2)
                    For Each ele As XElement In query
                        result.Add(CStr(ele.Value) & " ")
                    Next ele
                    Return Trim(result.Value)
                Else
                    Return ""
                End If
            Catch ex As Exception
                Console.WriteLine(ex.ToString)
                Return ex.ToString
            End Try
        End Function
    
        Private Function ConvertImage2XML(ByVal iPath$) As XElement
            Try
                If File.Exists(iPath) = True Then
                    Dim miDoc As New MODI.Document
                    Dim result As New XElement(<image path=<%= iPath %>/>)
                    miDoc.Create(iPath)
                    For Each miImg As MODI.Image In miDoc.Images
                        Dim page As New XElement(<page id=<%= result...<page>.Count + 1 %>/>)
                        miImg.OCR()
                        For Each miWord As MODI.Word In miImg.Layout.Words
                            Dim wd As New XElement(<wd block=<%= miWord.RegionId.ToString %>><%= miWord.Text %></wd>)
                            For Each miRect As MODI.MiRect In miWord.Rects
                                wd.Add(New XAttribute("left", miRect.Left))
                                wd.Add(New XAttribute("top", miRect.Top))
                                wd.Add(New XAttribute("right", miRect.Right))
                                wd.Add(New XAttribute("bottom", miRect.Bottom))
                            Next miRect
                            page.Add(wd)
                        Next miWord
                        result.Add(page)
                    Next miImg
                    Return result
                Else
                    Return Nothing
                End If
            Catch ex As Exception
                Console.WriteLine(ex.ToString)
                Return Nothing
            End Try
        End Function
    End Class
    

    main module

    Imports System
    Imports System.IO
    Imports System.Text.RegularExpressions
    
    Module modMain
    
        Sub Main()
            Dim iPath$ = "", iPos$ = "150,825,1400,1200"
            Console.WriteLine("Enter path to file:")
            iPath = Console.ReadLine()
            Console.WriteLine("")
            Console.WriteLine("Enter co-ordinates(i.e., x1,y1,x2,y2 or 150,825,1400,1200):")
            iPos = Console.ReadLine()
            Dim tmp As String() = Regex.Split(iPos, "\D+")
            Dim outText$ = New clsCore().GetTextFromCoordinates(iPath, tmp(0), tmp(1), tmp(2), tmp(3))
            Console.WriteLine("")
            Console.WriteLine(String.Format("{0}[({1},{2})-({3},{4})]:{5}{5}{6}", Dir(iPath), tmp(0), tmp(1), tmp(2), tmp(3), vbCrLf, outText))
            Console.ReadLine()
        End Sub
    
    End Module
    

    更新

    以下示例在查看器控件中报告用户图像选择周围的边界矩形的页码和坐标。并且可以稍后在图片框中使用。

    Sub TestImageSelection()
    
      Dim miImageSel As MODI.IMiSelectableImage
      Dim lngPageNo As Long
      Dim lngLeft As Long, lngTop As Long
      Dim lngRight As Long, lngBottom As Long
      Dim strImageSelInfo As String
    
      Set miImageSel = MiDocView1.ImageSelection
      miImageSel.GetBoundingRect lngPageNo, _
        lngLeft, lngTop, lngRight, lngBottom
      strImageSelInfo = _
        "Page number: " & lngPageNo & vbCrLf & _
        "Bounding rectangle coordinates: " & vbCrLf & _
        lngLeft & ", " & lngTop & ", " & _
        lngRight & ", " & lngBottom
      MsgBox strImageSelInfo, vbInformation + vbOKOnly, _
        "Image Selection Info"
    
      Set miImageSel = Nothing
    
    End Sub
    

    希望这会有所帮助。

    【讨论】:

    • 这是一个很好的技巧,但正如我所说的“技巧”.. 我在想图片框实际上是获取图片的确切点,将其保存为另一张图片。比 OCR 更重要。但是是的,这也有帮助。出于这个原因,我期待其他一些答案 +1,但很可能你的答案会被接受。
    • Picturebox 也可能是一个解决方案。查看我的更新。
    【解决方案2】:

    我使用图像和图片框将图片裁剪并调整为高清像素和大小,以便包含在高清电影中。我用滑块控件移动了图片(例如PicSize.Value) 图片框设置为屏幕外 1900x1080 像素,Visible=false。 图像框大小将Stretch 设置为true,大小不重要,显示最终裁剪图片的较小版本。

    我将图片框保存为 bmp,因此它可以很好地与我在 Adob​​e 编辑器中的 AVCHD 视频集成,并且与视频的帧大小相同。

    这是主要的子程序:

    -Private Sub Convert()
    'Creates a cropped and/or magnified fixed pixel 1900x1080 picture
    Dim file_name As String, LeftPos As Long
    Picture2.Picture = LoadPicture("")
    DoEvents 
    ' Resize the picture.
    LeftPos = 950 + HPos.Value - PicSize.Value / 2 + PicWidth.Value * 20
    Picture2.PaintPicture Picture1.Picture, _
        LeftPos, VPos.Value, _
        PicSize.Value - (PicSize.Value * (PicWidth.Value / 50)), _
        PicSize.Value * (Aspect.Value / 100)
    Picture2.Picture = Picture2.Image
    TopValue.Caption = VPos.Value
    HPosValue.Caption = HPos.Value
    SizeValue.Caption = PicSize.Value
    AspectValue.Caption = Aspect.Value - 75
    StretchValue.Caption = PicWidth.Value
    Image1.Picture = Picture2.Image 'preview it
    End Sub
    

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 2016-01-15
      • 1970-01-01
      • 2012-06-06
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多