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
希望这可以帮助。
