?? frmmain.frm
字號:
End If
If arrTagData(i) <> "" Then
Write #1, arrTagData(i) & "," & arrRawData(i)
End If
i = i + 1
Wend
Close #1
Else
End If
Else
'Dim oFile As TextStream
Dim strValue As String
' Set oFile = New TextStream
' MsgBox "Opening..."
' On Error GoTo OpenErrorHandler
Open_CommonDialog.FileName = ""
Open_CommonDialog.DialogTitle = "打開"
Open_CommonDialog.Filter = "識別文件 (*.rec)|*.rec|全部文件 (*.*)|*.*"
Open_CommonDialog.DefaultExt = ".rec"
Open_CommonDialog.InitDir = App.Path
Open_CommonDialog.ShowOpen
' If Open_CommonDialog.ShowOpen = vbCancel Then
' GoTo OpenCancelClicked
' End If
If Open_CommonDialog.FileName <> "" Then
Filename_Open = Open_CommonDialog.FileName
Filename_Open = Mid(Filename_Open, InStrRev(Filename_Open, "\") + 1)
picboxDataArea.Cls
Open Filename_Open For Binary As #1
i = 0
strBuffer = Space(5)
Get #1, , strBuffer
arrRawData(i) = strBuffer
i = i + 1
strBuffer = Space(22)
While Not EOF(1)
Get #1, , strBuffer
arrRawData(i) = strBuffer
i = i + 1
Wend
arrRawData(i - 1) = ""
Close #1
i = 0
strBuffer = ""
If arrRawData(0) = "recPK" Then
i = i + 1
While arrRawData(i) <> ""
arrTagData(i - 1) = Mid(arrRawData(i), 1, 1)
' strBuffer = strBuffer & Mid(strData(i), 1, 1) & vbCrLf
' strBuffer = strBuffer & Mid(strData(0), i, 1) & ","
' Me.ListBox_List.AddItem i & ". <" & Mid(strData(i), 1, 1) & ">"
arrRawData(i - 1) = ""
For j = 1 To 10
' strBuffer = strBuffer & DecToBin(Asc(Mid(strData(i), 3 + ((j - 1) * 2), 1)), 2)
' strBuffer = strBuffer & DecToBin(Asc(Mid(strData(i), 4 + ((j - 1) * 2), 1)), 8)
arrRawData(i - 1) = arrRawData(i - 1) & _
DecToBin(Asc(Mid(arrRawData(i), 3 + ((j - 1) * 2), 1)), 2) & _
DecToBin(Asc(Mid(arrRawData(i), 4 + ((j - 1) * 2), 1)), 8)
' strBuffer = strBuffer
Next j
' strBuffer = strBuffer & vbCrLf
i = i + 1
Wend
' Me.RichTextBox_Text.Text = strBuffer
' Me.TextBox_Text.ScrollBars
arrTagData(i - 1) = ""
arrRawData(i - 1) = ""
Else
Filename_Open = Open_CommonDialog.FileName
Filename_Open = Mid(Filename_Open, InStrRev(Filename_Open, "\") + 1)
picboxDataArea.Cls
c = 0
Open Filename_Open For Input As #1
While Not EOF(1)
Open_SkipLine:
a = 190
b = 190
d = 0
Me.picboxDataArea.Cls
If EOF(1) Then
GoTo Open_FileClose
End If
Input #1, arrRawData(c)
If Len(arrRawData(c)) < 102 Then
GoTo Open_SkipLine
End If
arrTagData(c) = Mid(arrRawData(c), 1, 1)
arrRawData(c) = Mid(arrRawData(c), 3)
' Debug.Print arrRawData(c)
c = c + 1
''' For i = 1 To 10
''' For j = 1 To 10
''' If Mid(arrRawData(c - 1), d + 1, 1) = vbBlack Then
''' picboxDataArea.PSet (a, b)
''' ' picboxDataArea.Circle (a, b), 110
''' ''' picboxDataArea.Line (a - 110, b - 110)-(a + 110, b - 110)
''' ''' picboxDataArea.Line (a + 110, b - 110)-(a + 110, b + 110)
''' ''' picboxDataArea.Line (a + 110, b + 110)-(a - 110, b + 110)
''' ''' picboxDataArea.Line (a - 110, b + 110)-(a - 110, b - 110)
''' End If
''' d = d + 1
''' b = b + (Me.picboxDataArea.Height - 200) / 10
''' Next j
''' b = 190
''' a = a + (Me.picboxDataArea.Width - 200) / 10
''' Next i
Wend
Open_FileClose:
Close #1
arrTagData(c) = ""
arrRawData(c) = ""
End If
End If
' With oFile
' .FileName = Filename_Open
' ' Check For File Too Big - 32K limit on text boxes
' If .FileTooBig Then
' Beep
' MsgBox "File Too Big To Read", , "File Open Error"
' Else
' If .OpenTextFile(Filename_Open, ForReading) Then
' Do Until .AtEndOfStream
' strValue = strValue & .ReadLine & vbCrLf
' Loop
' .CloseFile
' MsgBox strValue
' End If
' End If
' End With
' Set oFile = Nothing
'OpenCancelClicked:
'OpenErrorHandler:
' Exit Sub
If Open_CommonDialog.FileName <> "" Then
Me.Open.Enabled = False
Me.Teach.Enabled = False
Me.Recognise.Enabled = False
Me.ClearScreen.Enabled = True
Me.comboOpen.Visible = True
Me.comboOpen.Text = "選擇要打開的字符集 ..."
i = 0
While Me.comboOpen.List(i) <> ""
Me.comboOpen.RemoveItem (i)
Wend
i = 0
While arrTagData(i) <> ""
Me.comboOpen.AddItem i + 1 & ". - <" & arrTagData(i) & ">"
i = i + 1
Wend
Dim lngRet As Long
lngRet = SendMessage(Me.comboOpen.hwnd, _
CB_SHOWDROPDOWN, _
1, _
0&)
End If
End If
End Sub
Private Sub Recognise_Click()
Dim Filename_Database As String
Dim strRecognised As String
Dim intMatch As Integer
Dim intMaxMatch As Integer
Dim intCounter As Integer
Dim boolFindLastFile As Boolean
Dim boolNoMoreFileLeft As Boolean
Dim buffer As String
Dim Buffer_DatabaseArea As Variant
Dim strBuffer As String
' MsgBox "Recognising...", vbOKOnly, "Run into sub function..."
' Call GraspRawData
FileSystem.ChDir (App.Path)
Me.pbRecognising.Visible = True
strRecognised = ""
intMaxMatch = 0
intCounter = 0
c = 0
On Error GoTo Recognise_FileClose
Filename_Database = "DATA" & RECOG_EXT
If Filename_Database <> "" Then
Me.picboxDatabaseArea.Cls
Open Filename_Database For Binary As #1
i = 0
strBuffer = Space(5)
Get #1, , strBuffer
arrRawData(i) = strBuffer
i = i + 1
strBuffer = Space(22)
While Not EOF(1)
Get #1, , strBuffer
arrRawData(i) = strBuffer
i = i + 1
Wend
arrRawData(i - 1) = ""
Close #1
i = 0
strBuffer = ""
If arrRawData(0) = "recPK" Then
i = i + 1
strRecognised = ""
intMaxMatch = 0
intCounter = 0
c = 0
While arrRawData(i) <> ""
a = 190
b = 190
d = 0
intMatch = 0
Me.picboxDatabaseArea.Cls
arrTagData(i - 1) = Mid(arrRawData(i), 1, 1)
' strBuffer = strBuffer & Mid(strData(i), 1, 1) & vbCrLf
' strBuffer = strBuffer & Mid(strData(0), i, 1) & ","
' Me.ListBox_List.AddItem i & ". <" & Mid(strData(i), 1, 1) & ">"
arrRawData(i - 1) = ""
For j = 1 To 10
' strBuffer = strBuffer & DecToBin(Asc(Mid(strData(i), 3 + ((j - 1) * 2), 1)), 2)
' strBuffer = strBuffer & DecToBin(Asc(Mid(strData(i), 4 + ((j - 1) * 2), 1)), 8)
arrRawData(i - 1) = arrRawData(i - 1) & _
DecToBin(Asc(Mid(arrRawData(i), 3 + ((j - 1) * 2), 1)), 2) & _
DecToBin(Asc(Mid(arrRawData(i), 4 + ((j - 1) * 2), 1)), 8)
' strBuffer = strBuffer
Next j
' strBuffer = strBuffer & vbCrLf
i = i + 1
For ii = 1 To 10
For jj = 1 To 10
If Mid(arrRawData(c), d + 1, 1) = vbBlack Then
' picboxDataArea.PSet (i, j)
' j2 - mask - finalise
' picboxDatabaseArea.PSet (a, b)
' picboxDataArea.Circle (a, b), 110
' picboxDatabaseArea.Line (a - 110, b - 110)-(a + 110, b - 110)
' picboxDatabaseArea.Line (a + 110, b - 110)-(a + 110, b + 110)
' picboxDatabaseArea.Line (a + 110, b + 110)-(a - 110, b + 110)
' picboxDatabaseArea.Line (a - 110, b + 110)-(a - 110, b - 110)
' Debug.Print ""
If Mid(strData, d + 1, 1) = vbBlack Then
intMatch = intMatch + 1
Else
intMatch = intMatch - 1
End If
Else
If Mid(strData, d + 1, 1) <> vbBlack Then
intMatch = intMatch + 1
Else
intMatch = intMatch - 1
End If
End If
d = d + 1
b = b + (Me.picboxDatabaseArea.Height - 200) / 10
Next jj
b = 190
a = a + (Me.picboxDatabaseArea.Width - 200) / 10
Next ii
If intMaxMatch < intMatch Then
intMaxMatch = intMatch
strRecognised = arrTagData(c)
intCounter = c
Me.pbRecognising.Value = intMaxMatch
If intMaxMatch > 90 Then
GoTo Recognise_FileClose
End If
End If
c = c + 1
Wend
' Me.RichTextBox_Text.Text = strBuffer
' Me.TextBox_Text.ScrollBars
arrTagData(i - 1) = ""
arrRawData(i - 1) = ""
Else
strRecognised = ""
intMaxMatch = 0
intCounter = 0
c = 0
Open Filename_Database For Input As #1
While Not EOF(1)
Recognise_SkipLine:
a = 190
b = 190
d = 0
intMatch = 0
Me.picboxDatabaseArea.Cls
If EOF(1) Then
GoTo Recognise_FileClose
End If
Input #1, arrRawData(c)
If Len(arrRawData(c)) < 102 Then
GoTo Recognise_SkipLine
End If
arrTagData(c) = Mid(arrRawData(c), 1, 1)
arrRawData(c) = Mid(arrRawData(c), 3)
' Debug.Print arrRawData(c)
For i = 1 To 10
For j = 1 To 10
If Mid(arrRawData(c), d + 1, 1) = vbBlack Then
' picboxDataArea.PSet (i, j)
picboxDatabaseArea.PSet (a, b)
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -