Как я могу сделать зональное распознавание текста в VB6?

Question

Как вы можете видеть, я создал программу, которая сканирует документ и дополнительно получает информацию о странице, информацию о материале, размере и дате.

Когда я использую сканирование 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?

Answer 1

Фрагмент vb6

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

---

Надеюсь это поможет.

Answer 2

Я использовал графические и графические блоки для обрезки и изменения размера изображения точно до пикселей HD и размера для включения в фильм HD. Я переместил картинку с помощью ползунка управления (например, PicSize.Value) Поле изображения установлено на 1900x1080 пикселей вне экрана с Visible=false, Размер окна изображения имеет Stretch установлен в true с размером не критично и показывает уменьшенную версию финальной обрезанной картинки.

Я сохраняю графическую рамку в виде BMP, чтобы она прекрасно интегрировалась с моим видео AVCHD в редакторе Adobe, размер кадра которого совпадает с размером видео.

Это была основная подпрограмма:

-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