tagCANDY CGI VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
[ツリー表示へ]　 [ワード検索]　 [Home]

タイトル ： Microsoft Office Document Imagingを使ってみました2
投稿日： 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("ＭＳ 明朝", 10)
            preHeight = G.MeasureString(scWords(i).text, nfont).Height
            FontScale = preHeight / (scWords(i).bottom - scWords(i).top)
            nfont = New Font("ＭＳ 明朝", 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("ＭＳ 明朝", 10)
            preHeight = G.MeasureString(ScNums(i).text, nfont).Height
            FontScale = preHeight / (ScNums(i).bottom - ScNums(i).top)
            nfont = New Font("ＭＳ 明朝", 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
- 関連一覧ツリー （ をクリックするとツリー全体を一括表示します）

古いスレッドにレスはつけられません。