タイトル | : Microsoft Office Document Imagingを使ってみました2 |
記事No | : 7209 |
投稿日 | : 2008/03/17(Mon) 17:08 |
投稿者 | : ひでと |
Private Function IsNumeral(ByVal Str As String) As Boolean Dim i As Integer Dim dum As Boolean If Mid(Str, 1, 1) >= "0" And Mid(Str, 1, 1) <= "9" Then dum = True Else dum = False : Return False End If For i = 2 To Len(Str) If dum = True Then Select Case Mid(Str, i, 1) Case "-", ".", "," : dum = True Case Else If Mid(Str, i, 1) >= "0" And Mid(Str, i, 1) <= "9" Then dum = True Else dum = False : Exit For End If End Select End If Next Return dum End Function Private Function IsNSChangeing(ByVal Str As String) As Boolean Dim i As Integer Dim isNum As Boolean If Mid(Str, 1, 1) >= "0" And Mid(Str, 1, 1) <= "9" Then isNum = True End If For i = 2 To Len(Str) If isNum Then Select Case Mid(Str, i, 1) Case "-", ".", "," Case Else If Mid(Str, i, 1) >= "0" And Mid(Str, i, 1) <= "9" Then Else isNum = False : Return True End If End Select Else Select Case Mid(Str, i, 1) Case "-", ".", "," : isNum = False Case Else If Mid(Str, i, 1) >= "0" And Mid(Str, i, 1) <= "9" Then isNum = True : Return True Else isNum = False End If End Select End If Next Return False End Function Private Sub ScwDevide(ByVal index As Integer, ByVal nfont As Font, ByVal Obj As PictureBox) Dim G As Graphics = Obj.CreateGraphics Dim preWidth As Integer Dim newWidth As Integer Dim fontLengScale As Single Dim oldText As String Dim newText As String Dim i As Integer Dim chk As Boolean Dim ScNum As New st_scWord Dim ScSchr As New st_scWord oldText = scWords(index).text preWidth = G.MeasureString(oldText, nfont).Width fontLengScale = preWidth / (scWords(index).right - scWords(index).left) newText = Mid(oldText, 1, 1) With ScNum .text = scWords(index).text .top = scWords(index).top .bottom = scWords(index).bottom .left = scWords(index).left .right = scWords(index).right End With With ScSchr .text = scWords(index).text .top = scWords(index).top .bottom = scWords(index).bottom .left = scWords(index).left .right = scWords(index).right End With
If IsNumeral(newText) Then chk = True Else chk = False End If i = 1 Do While i <= Len(oldText) newText = Mid(oldText, 1, i) If chk = True Then If IsNSChangeing(newText) Then newWidth = G.MeasureString(newText, nfont).Width newText = Mid(newText, 1, Len(newText) - 1) With ScNum .text = newText .right = ScNum.left + newWidth * fontLengScale End With ScSchr.left = ScNum.right ScNums.Add(ScNum) chk = False oldText = Mid(oldText, Len(newText) + 1) i = 0 End If Else If IsNSChangeing(newText) Then newWidth = G.MeasureString(newText, nfont).Width newText = Mid(newText, 1, Len(newText) - 1) With ScSchr .text = newText .right = ScSchr.left + newWidth * fontLengScale End With ScNum.left = ScSchr.right ScSchrs.Add(ScNum) chk = True oldText = Mid(oldText, Len(newText) + 1) i = 0 End If End If i = i + 1 Loop If IsNumeral(oldText) Then ScNum.text = oldText ScNums.Add(ScNum) Else ScSchr.text = oldText ScSchrs.Add(ScSchr) End If
End Sub Private Sub ScwPicDeVide(ByVal Obj As PictureBox) Dim G As Graphics = Obj.CreateGraphics Dim nfont As Font Dim i As Integer Dim preHeight As Integer Dim FontScale As Single
For i = 0 To scWords.Count - 1 nfont = New Font("MS 明朝", 10) preHeight = G.MeasureString(scWords(i).text, nfont).Height FontScale = preHeight / (scWords(i).bottom - scWords(i).top) nfont = New Font("MS 明朝", 10 * FontScale) ScwDevide(i, nfont, Obj) Next End Sub
Private Sub Button1_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button1.Click Dim Ret As DialogResult Dim FileName As String Me.OpenFileDialog1.Filter = "すべてのイメージドキュメント(*.mdi;*.tif;*.tiff)|*.mdi;*.tif;*.tiff)" Ret = Me.OpenFileDialog1.ShowDialog If Ret = Windows.Forms.DialogResult.OK Then FileName = Me.OpenFileDialog1.FileName.ToString Else Exit Sub End If GetOCR(FileName) ScwPicDeVide(Me.PictureBox1) PictureBox1.Refresh() End Sub
Private Sub PictureBox1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles PictureBox1.Paint Dim G As Graphics = e.Graphics Dim nfont As Font Dim i As Integer Dim preHeight As Integer Dim FontScale As Single Dim Scale As Single Dim minx, miny As Integer Dim x, y As Integer
For i = 0 To ScNums.Count - 1 nfont = New Font("MS 明朝", 10) preHeight = G.MeasureString(ScNums(i).text, nfont).Height FontScale = preHeight / (ScNums(i).bottom - ScNums(i).top) nfont = New Font("MS 明朝", 10 * FontScale) Scale = ScwScale(Me.PictureBox1) minx = minScWLeft() miny = minScWTop() x = (ScNums(i).left - minx) * Scale y = (ScNums(i).top - miny) * Scale G.DrawString(ScNums(i).text, nfont, Brushes.Black, x, y) Next End Sub
Private Sub PictureBox1_Resize(ByVal sender As Object, ByVal e As System.EventArgs) Handles PictureBox1.Resize Try Me.PictureBox1.Height = ScwHeight() * ScwScale(Me.PictureBox1) Catch ex As Exception End Try PictureBox1.Refresh() End Sub Private Sub YSort(ByRef Obj As List(Of st_scWord)) If Obj.Count = 0 Then Exit Sub Dim i, j As Integer Dim dum As New st_scWord Dim dum2 As New List(Of st_scWord) dum2 = Obj For i = 0 To dum2.Count - 2 For j = dum2.Count - 1 To i + 1 Step -1 If dum2(j).top < dum2(j - 1).top Then dum = dum2(j) dum2(j) = dum2(j - 1) dum2(j - 1) = dum End If Next Next Obj = dum2 End Sub Private Sub XSort(ByRef Obj As List(Of st_scWord)) If Obj.Count = 0 Then Exit Sub Dim i, j As Integer Dim dum As New st_scWord Dim dum2 As New List(Of st_scWord) dum2 = Obj For i = 0 To dum2.Count - 2 For j = dum2.Count - 1 To i + 1 Step -1 If dum2(j).left < dum2(j - 1).left Then dum = dum2(j) dum2(j) = dum2(j - 1) dum2(j - 1) = dum End If Next Next Obj = dum2 End Sub Private Function isSameRow(ByVal Obj As List(Of st_scWord), ByVal Targ As st_scWord) As Boolean Dim i As Integer Dim topMin, bottomMax As Integer topMin = Obj(0).top bottomMax = Obj(0).bottom For i = 0 To Obj.Count - 1 If topMin > Obj(i).top Then topMin = Obj(i).top If bottomMax < Obj(i).bottom Then bottomMax = Obj(i).bottom Next If topMin >= Targ.top And topMin <= Targ.bottom Then Return True If bottomMax >= Targ.top And bottomMax <= Targ.bottom Then Return True If topMin <= Targ.top And bottomMax >= Targ.top Then Return True Return False End Function Private Sub Maketext(ByVal TextFile As IO.StreamWriter) Dim i As Integer Dim Row As New List(Of st_scWord) Dim NewStr As String = ""
Row.Add(NScNums(0)) NScNums.Remove(NScNums(0)) i = 0 Do Until i >= NScNums.Count - 1 If isSameRow(Row, NScNums(i)) Then Row.Add(NScNums(i)) NScNums.Remove(NScNums(i)) If NScNums.Count = 1 Then Exit Do i = i - 1 End If i = i + 1 Loop XSort(Row) For i = 0 To Row.Count - 1 If i = Row.Count - 1 Then NewStr = NewStr & Row(i).text Else NewStr = NewStr & Row(i).text & Me.TextBox1.Text End If Next TextFile.WriteLine(NewStr) If NScNums.Count = 1 Then Exit Sub '再起 Maketext(TextFile) End Sub
Private Sub Button2_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Button2.Click Dim TextFile As IO.StreamWriter Dim i As Integer Dim ret As DialogResult ret = Me.SaveFileDialog1.ShowDialog If ret = Windows.Forms.DialogResult.OK Then TextFile = New IO.StreamWriter(Me.SaveFileDialog1.FileName) Else Exit Sub End If YSort(ScNums) For i = 0 To ScNums.Count - 1 NScNums.Add(ScNums(i)) Next Maketext(TextFile) TextFile.Close() End Sub
|