📄 模糊识别f3.frm
字号:
VERSION 5.00
Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
Begin VB.Form frmResu
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "模糊识别"
ClientHeight = 7245
ClientLeft = 60
ClientTop = 450
ClientWidth = 11610
LinkTopic = "Form1"
ScaleHeight = 7245
ScaleWidth = 11610
StartUpPosition = 3 '窗口缺省
Begin VB.CommandButton cmdPrint
Caption = "打 印"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 3240
TabIndex = 4
Top = 0
Width = 1170
End
Begin VB.CommandButton cmdCata
Caption = "识 别"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 1080
TabIndex = 3
Top = 0
Width = 1095
End
Begin RichTextLib.RichTextBox rTxt
Height = 6615
Left = 120
TabIndex = 2
Top = 480
Width = 11295
_ExtentX = 19923
_ExtentY = 11668
_Version = 393217
Enabled = -1 'True
ScrollBars = 2
DisableNoScroll = -1 'True
Appearance = 0
TextRTF = $"模糊识别F3.frx":0000
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.CommandButton cmdSave
Caption = "保 存"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 2160
TabIndex = 1
Top = 0
Width = 1095
End
Begin VB.CommandButton cmdExit
Caption = "退 出"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 0
TabIndex = 0
Top = 0
Width = 1095
End
Begin VB.Label lblW
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "识别时请耐心等待！"
BeginProperty Font
Name = "隶书"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 375
Left = 4680
TabIndex = 5
Top = 0
Width = 3015
End
End
Attribute VB_Name = "frmResu"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'模糊识别
'识别窗体模块
Option Explicit
Dim intI As Integer, intJ As Integer, intK As Integer
Dim intL1 As Integer, intL2 As Integer, intL3 As Integer
Dim DL1 As Double, DL2 As Double, DL3 As Double
Dim strR As String '回车换行符
Private Sub Form_Load()
strR = Chr(13) + Chr(10) '回车换行符
cmdPrint.Visible = False: cmdSave.Visible = False
End Sub
'识别
Private Sub cmdCata_Click()
rTxt.Text = rTxt.Text & "共有" & intS & "个标准模型：" & strR
'显示各标准模型的各元素
For intI = 1 To intS 'intS是标准模型个数
rTxt.Text = rTxt.Text & " " & "(" & intI & ")："
For intJ = 1 To intCol - 1
rTxt.Text = rTxt.Text & Int((XS0(intI, intJ) + 0.0005) * 1000) / 1000 & " "
Next intJ
rTxt.Text = rTxt.Text & strR
Next intI
rTxt.Text = rTxt.Text & "共有" & intRow2 & "个待定样本需要识别：" & strR
'显示各待定样本的各元素
For intI = 1 To intRow2 'intRow2是待定样本个数
rTxt.Text = rTxt.Text & " " & "(" & intI & ")："
For intJ = 1 To intCol - 1
rTxt.Text = rTxt.Text & Int((X20(intI, intJ) + 0.0005) * 1000) / 1000 & " "
Next intJ
rTxt.Text = rTxt.Text & strR
Next intI
If Opt(1) Then _
rTxt.Text = rTxt.Text & "----------" & "格贴近度" & "----------" & strR
If Opt(2) Then _
rTxt.Text = rTxt.Text & "----------" & "海明贴近度" & "----------" & strR
If Opt(3) Then _
rTxt.Text = rTxt.Text & "----------" & "欧氏贴近度" & "----------" & strR
If Opt(4) Then _
rTxt.Text = rTxt.Text & "----------" & "最大最小贴近度" & "----------" & strR
If Opt(5) Then _
rTxt.Text = rTxt.Text & "----------" & "算术平均最小贴近度" & "----------" & strR
'计算并显示识别结果
For intI = 1 To intRow2 'intRow2是待定样本个数
rTxt.Text = rTxt.Text & " " & "待定样本" & intI & strR
For intJ = 1 To intS 'intS是标准模型个数
For intK = 1 To intCol - 1
XC(intK) = X2(intI, intK) '待定样本
SC(intK) = XS(intJ, intK) '标准模型
Next intK
If Opt(1) Then MM1 XC, SC, DT '格贴近度
If Opt(2) Then MM2 XC, SC, DT '海明贴近度
If Opt(3) Then MM3 XC, SC, DT '欧氏贴近度
If Opt(4) Then MM4 XC, SC, DT '最大最小贴近度
If Opt(5) Then MM5 XC, SC, DT '算术平均最小贴近度
DS(intJ) = Int((DT + 0.0005) * 1000) / 1000 '贴近度值
rTxt.Text = rTxt.Text & "与标准模型" & intJ & "的贴近度：" & DS(intJ) & strR
Next intJ
'找出待定样本所属的标准模型
'考虑到可能存在具有相同最大贴近度的标准模型不止一个
'允许待定样本可以与3个模型有相同的贴近度值
DL1 = 0: DL2 = 0: DL3 = 0
For intJ = 1 To intS 'intS是标准模型个数
If DS(intJ) > DL1 Then
DL1 = DS(intJ): intL1 = intJ: DS(intJ) = 0
End If
If intS > 1 And DS(intJ) > DL2 Then
DL2 = DS(intJ): intL2 = intJ: DS(intJ) = 0
End If
If intS > 2 And DS(intJ) > DL3 Then
DL3 = DS(intJ): intL3 = intJ: DS(intJ) = 0
End If
Next intJ
rTxt.Text = rTxt.Text & "与标准模型" & intL1 & "有最大贴近度：" & DL1 & strR
If intS > 1 And DL1 = DL2 Then _
rTxt.Text = rTxt.Text & "与标准模型" & intL2 & "有最大贴近度：" & DL2 & strR
If intS > 2 And DL1 = DL3 Then _
rTxt.Text = rTxt.Text & "与标准模型" & intL3 & "有最大贴近度：" & DL3 & strR
rTxt.Text = rTxt.Text & "********************************************" & strR
Next intI
cmdCata.Visible = False: cmdPrint.Visible = True: cmdSave.Visible = True
lblW.Visible = False
End Sub
'打印
Private Sub cmdPrint_Click()
rTxt.SelLength = 0
rTxt.SelPrint Printer.hDC
cmdPrint.Visible = False
End Sub
'保存
Private Sub cmdSave_Click()
rTxt.SaveFile strResultFile, 1
cmdSave.Visible = False
End Sub
'退出
Private Sub cmdExit_Click()
Unload Me
frmFile.Visible = True
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -