📄 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 + -