2

ご覧のとおり、ドキュメントをスキャンし、オプションでページ情報、素材とサイズの情報、および日付情報を取得するプログラムを作成しました。

ここに画像の説明を入力

このように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座標のみをスキャンするのはどれ?

4

2 に答える 2

2

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

アップデート

次の例では、ページ番号と、ビューア コントロールでユーザーが選択した画像を囲む境界四角形の座標を報告します。そして、後でpicturebox内で使用できます。

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

お役に立てれば。

于 2012-06-06T07:56:23.447 に答える
1

画像ボックスと画像ボックスを使用して、HD ムービーに含めるために画像を正確に HD ピクセルとサイズにトリミングおよびサイズ変更しました。スライダー コントロールを使用して画像を移動しました (例: PicSize.Value) Visible=false。画像ボックスのサイズが にStretch設定されtrueていることは重要ではなく、最終的にトリミングされた画像の小さいバージョンが表示されます。

ピクチャ ボックスを bmp として保存するので、Adobe エディタで 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
于 2014-03-27T07:56:45.343 に答える