?? frmmain.frm
字號:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FrmMain
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
Caption = "OCR手寫識別系統"
ClientHeight = 5775
ClientLeft = 0
ClientTop = 0
ClientWidth = 6615
Icon = "FrmMain.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 385
ScaleMode = 3 'Pixel
ScaleWidth = 441
StartUpPosition = 2 '屏幕中心
Begin VB.PictureBox PicPrintMode
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
BeginProperty Font
Name = "楷體_GB2312"
Size = 63.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 1455
Left = 4200
ScaleHeight = 97
ScaleMode = 3 'Pixel
ScaleWidth = 97
TabIndex = 16
Top = 1080
Visible = 0 'False
Width = 1455
End
Begin MyOCR.MyButton CmdClear
Height = 345
Left = 4440
TabIndex = 15
Top = 5280
Width = 975
_extentx = 1720
_extenty = 609
spn = "MyButtonDefSkin"
textline = 1
text = "清除(&C)"
accesskey = "C"
font = "FrmMain.frx":0ABA
End
Begin MyOCR.MyButton CmdRead
Height = 345
Left = 5520
TabIndex = 14
Top = 5280
Width = 975
_extentx = 1720
_extenty = 609
spn = "MyButtonDefSkin"
textline = 1
text = "識別(&R)"
accesskey = "R"
font = "FrmMain.frx":0ADE
End
Begin MSComDlg.CommonDialog CDFont
Left = 2280
Top = 5280
_ExtentX = 847
_ExtentY = 847
_Version = 393216
CancelError = -1 'True
End
Begin MyOCR.MicTitleBar MicTitleBar1
Height = 360
Left = 0
TabIndex = 13
Top = 0
Width = 6615
_extentx = 11668
_extenty = 635
End
Begin VB.TextBox TxtPrint
Appearance = 0 'Flat
Height = 4455
Left = 4440
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 11
Top = 720
Width = 2055
End
Begin VB.ListBox ListSame
Height = 2400
Left = 120
TabIndex = 9
Top = 3120
Width = 1980
End
Begin MyOCR.MyButton CmdFont
Height = 345
Left = 3045
TabIndex = 8
Top = 5280
Width = 1215
_extentx = 2143
_extenty = 609
spn = "MyButtonDefSkin"
textline = 1
text = "字體(&F)"
accesskey = "F"
font = "FrmMain.frx":0B02
End
Begin VB.TextBox TxtSample
Appearance = 0 'Flat
BeginProperty Font
Name = "Comic Sans MS"
Size = 15
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2055
Left = 2280
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 5
Top = 3120
Width = 1980
End
Begin VB.PictureBox PicSampleOutSide
AutoRedraw = -1 'True
BackColor = &H00FF0000&
Height = 1980
Left = 2280
ScaleHeight = 128
ScaleMode = 3 'Pixel
ScaleWidth = 128
TabIndex = 3
Top = 720
Width = 1980
Begin VB.PictureBox PicSample
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H80000005&
BorderStyle = 0 'None
BeginProperty Font
Name = "Comic Sans MS"
Size = 72
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 1455
Left = 240
ScaleHeight = 97
ScaleMode = 3 'Pixel
ScaleWidth = 97
TabIndex = 4
Top = 240
Width = 1455
End
End
Begin VB.PictureBox PicPrint
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
DrawWidth = 10
Height = 1980
Left = 120
MouseIcon = "FrmMain.frx":0B26
MousePointer = 99 'Custom
ScaleHeight = 128
ScaleMode = 3 'Pixel
ScaleWidth = 128
TabIndex = 1
Top = 720
Width = 1980
Begin VB.Shape SapText
BorderColor = &H00FF0000&
Height = 1335
Left = 360
Top = 240
Visible = 0 'False
Width = 1215
End
End
Begin VB.PictureBox MyButtonDefSkin
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 315
Left = 0
Picture = "FrmMain.frx":0E30
ScaleHeight = 21
ScaleMode = 3 'Pixel
ScaleWidth = 150
TabIndex = 0
Top = 0
Visible = 0 'False
Width = 2250
End
Begin VB.Label LabGetLetters
BackStyle = 0 'Transparent
Caption = "顯示識別后的文本內容："
Height = 255
Left = 4440
TabIndex = 12
Top = 480
Width = 2055
End
Begin VB.Label LabeIsSame
BackStyle = 0 'Transparent
Caption = "文字匹配程度："
Height = 255
Left = 120
TabIndex = 10
Top = 2880
Width = 1695
End
Begin VB.Label LabSampleTxt
BackStyle = 0 'Transparent
Caption = "模式文本輸入："
Height = 255
Left = 2280
TabIndex = 7
Top = 2880
Width = 1455
End
Begin VB.Label LabSamplePic
BackStyle = 0 'Transparent
Caption = "模式文本顯示："
Height = 255
Left = 2280
TabIndex = 6
Top = 480
Width = 1455
End
Begin VB.Label LabPrint
BackStyle = 0 'Transparent
Caption = "手寫輸入文本："
Height = 255
Left = 120
TabIndex = 2
Top = 480
Width = 1335
End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人為我，我為人人
'枕善居收藏整理
'發布日期：2008/01/21
'描 述：簡易手寫識別系統(Version 0.10Beta)
'網 站：http://www.Mndsoft.com/ (VB6源碼博客)
'網 站：http://www.VbDnet.com/ (VB.NET源碼博客,主要基于.NET2005)
'e-mail ：Mndsoft@163.com
'e-mail ：Mndsoft@126.com
'OICQ ：88382850
' 如果您有新的好的代碼別忘記給枕善居哦!
'****************************************************************************
'簡易手寫識別系統(Version 0.10Beta)
'作者：劉留。網名：隕落雕(ThirdApple)
'通訊地址：遂寧中學初2003級三班
'E-mail：3rdapple@sohu.com
'其它作品：http://3rdapple.51.net/QQSkiner.htm | http://3rdapple.51.net/FantasiaPhoto.htm
'本代碼可以任意轉載，但是請保持其完整性，包括本說明，謝謝合作！
'本代碼如果有任何需要改進的地方，給作者說一聲，謝謝！
'其它關于本代碼：
'1. 本代碼界面系刺猬制作的用戶控件完成。
'2. 本代碼按鈕系一外國網站代碼。
Dim OcrText() As OcrType '定義OcrText為動態OcrType類型數組
'OcrType類型中有ModeText保存文本，SameBits保存匹配度
Private Sub CmdClear_Click() '清理手寫輸入框
PicPrint.Cls
SapText.Visible = False
End Sub
Private Sub CmdFont_Click() '選擇文字大小和字體
On Error GoTo Error
With CDFont
.Flags = cdlCFBoth
.FontName = PicSample.FontName
.FontSize = PicSample.FontSize
.FontBold = PicSample.FontBold
.FontItalic = PicSample.FontItalic
.ShowFont
End With
With PicSample
.FontName = CDFont.FontName
.FontSize = CDFont.FontSize
.FontBold = CDFont.FontBold
.FontItalic = CDFont.FontItalic
End With
With TxtSample
.FontName = CDFont.FontName
'.FontSize = CDFont.FontSize
.FontBold = CDFont.FontBold
End With
Error:
End Sub
Private Sub CmdRead_Click() '進行識別
Dim CutPic As RECT
ListSame.Clear '清空List框
CutPic = CutLetters(PicPrint) '將PicPrint中的手寫文本剪切
SapText.Left = CutPic.Left
SapText.Width = CutPic.Right - CutPic.Left
SapText.Top = CutPic.Top
SapText.Height = CutPic.Bottom - CutPic.Top
SapText.Visible = True
ReDim OcrText(1 To Len(TxtSample.Text)) '重新定義OcrText數組的長度
For i = 1 To Len(TxtSample.Text) '循環進行匹配度校驗
OcrText(i).ModeText = Mid(TxtSample.Text, i, 1) '取得文字
PicSample.Width = PicSample.TextWidth(OcrText(i).ModeText) '初步設置大小
PicSample.Height = PicSample.TextHeight(OcrText(i).ModeText)
PicSample.CurrentX = 0
PicSample.CurrentY = 0
PicSample.Cls
PicSample.Print OcrText(i).ModeText '輸出標準文本
CutPic = CutLetters(PicSample) '剪切標準文本
BitBlt PicSample.hdc, 0, 0, CutPic.Right - CutPic.Left, CutPic.Bottom - CutPic.Top, PicSample.hdc, CutPic.Left, CutPic.Top, vbSrcCopy
PicSample.Refresh
PicSample.Width = CutPic.Right - CutPic.Left
PicSample.Height = CutPic.Bottom - CutPic.Top
PicSample.Left = (PicSampleOutSide.ScaleWidth - PicSample.ScaleWidth) / 2
PicSample.Top = (PicSampleOutSide.ScaleHeight - PicSample.ScaleHeight) / 2
PicPrintMode.Width = PicSample.Width
PicPrintMode.Height = PicSample.Height
StretchBlt PicPrintMode.hdc, 0, 0, PicPrintMode.ScaleWidth, PicPrintMode.ScaleHeight, PicPrint.hdc, SapText.Left, SapText.Top, SapText.Width, SapText.Height, vbSrcCopy
BlackBits PicSample '對標準文本二值化
OcrText(i).SameBits = OcrBits(PicPrintMode, PicSample) '進行匹配度校驗
DoEvents
Next i
Kspxd OcrText, 1, Len(TxtSample.Text) '對匹配進行排序
For i = Len(TxtSample.Text) To 1 Step -1 '輸出到List框中
ListSame.AddItem OcrText(i).ModeText & "的相似度：" & CStr(Round(OcrText(i).SameBits / 100, 2)) & "%"
Next i
'顯示最匹配文字到標準文本輸出框
TxtPrint.Text = TxtPrint.Text & OcrText(Len(TxtSample.Text)).ModeText
PicSample.Width = PicSample.TextWidth(OcrText(Len(TxtSample.Text)).ModeText)
PicSample.Height = PicSample.TextHeight(OcrText(Len(TxtSample.Text)).ModeText)
PicSample.CurrentX = 0
PicSample.CurrentY = 0
PicSample.Cls
PicSample.Print OcrText(Len(TxtSample.Text)).ModeText
CutPic = CutLetters(PicSample)
BitBlt PicSample.hdc, 0, 0, CutPic.Right - CutPic.Left, CutPic.Bottom - CutPic.Top, PicSample.hdc, CutPic.Left, CutPic.Top, vbSrcCopy
PicSample.Refresh
PicSample.Width = CutPic.Right - CutPic.Left
PicSample.Height = CutPic.Bottom - CutPic.Top
PicSample.Left = (PicSampleOutSide.ScaleWidth - PicSample.ScaleWidth) / 2
PicSample.Top = (PicSampleOutSide.ScaleHeight - PicSample.ScaleHeight) / 2
End Sub
Private Sub Form_Load()
PicPrint.DrawWidth = 10 '設置筆刷大小
TxtSample.Text = "0123456789AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz" '設置在哪些文字中進行識別
End Sub
Private Sub ListSame_Click() '點擊List框，選擇文字添加到文本框中
On Error Resume Next
TxtPrint.Text = Left(TxtPrint.Text, Len(TxtPrint.Text) - 1) & OcrText(ListSame.ListCount - ListSame.ListIndex).ModeText
End Sub
Private Sub PicPrint_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button <> 0 Then
If SapText.Visible = True Then Call CmdClear_Click '如果虛框在就將輸入框清理了。
PicPrint.Circle (x, y), 2 '進行繪圖
End If
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -