正如你在那里看到的那样,我制作了一个扫描文档的程序,并可选择获取页面信息和材料。大小信息和日期信息。
当我像这样使用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坐标?
答案 0 :(得分: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
,只需要更多时间。
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
希望这有帮助。
答案 1 :(得分:1)
我使用图像和图片框来精确地裁剪和调整图片大小以适应高清像素和大小以包含在高清电影中。我用滑块控件移动了图片(例如PicSize.Value
)
屏幕上的图片框设置为1900x1080像素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