📄 模糊识别f1.frm
字号:
VERSION 5.00
Begin VB.Form frmFile
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "识别模糊"
ClientHeight = 6645
ClientLeft = 60
ClientTop = 345
ClientWidth = 5760
LinkTopic = "Form1"
ScaleHeight = 6645
ScaleWidth = 5760
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame2
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "数据预处理"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 1095
Left = 240
TabIndex = 18
Top = 4200
Width = 1815
Begin VB.CheckBox Check2
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "极差变换"
ForeColor = &H80000008&
Height = 375
Left = 120
TabIndex = 20
Top = 600
Value = 1 'Checked
Width = 1095
End
Begin VB.CheckBox Check1
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "标准差变换"
ForeColor = &H80000008&
Height = 375
Left = 120
TabIndex = 19
Top = 240
Width = 1335
End
End
Begin VB.TextBox txtResultFile
Alignment = 2 'Center
Appearance = 0 'Flat
Height = 270
Left = 240
TabIndex = 17
Top = 3720
Width = 5295
End
Begin VB.Frame Frame1
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "求贴近度方法"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 2295
Left = 2400
TabIndex = 10
Top = 4200
Width = 2295
Begin VB.OptionButton Option3
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "欧氏贴近度"
ForeColor = &H80000008&
Height = 375
Left = 120
TabIndex = 15
Top = 1080
Width = 1335
End
Begin VB.OptionButton Option2
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "海明贴近度"
ForeColor = &H80000008&
Height = 375
Left = 120
TabIndex = 14
Top = 720
Width = 1335
End
Begin VB.OptionButton Option1
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "格贴近度"
ForeColor = &H80000008&
Height = 375
Left = 120
TabIndex = 13
Top = 360
Width = 1335
End
Begin VB.OptionButton Option5
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "算术平均最小贴近度"
ForeColor = &H80000008&
Height = 375
Left = 120
TabIndex = 12
Top = 1800
Width = 2055
End
Begin VB.OptionButton Option4
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "最大最小贴近度"
ForeColor = &H80000008&
Height = 375
Left = 120
TabIndex = 11
Top = 1440
Value = -1 'True
Width = 1935
End
End
Begin VB.TextBox txtFile
Alignment = 2 'Center
Appearance = 0 'Flat
Height = 270
Left = 240
TabIndex = 9
Top = 3000
Width = 5295
End
Begin VB.CommandButton cmdExit
Caption = "结束"
Height = 375
Left = 4920
TabIndex = 7
ToolTipText = "结束程序运行"
Top = 6120
Width = 615
End
Begin VB.CommandButton cmdOK
Caption = "确定"
Height = 375
Left = 4920
TabIndex = 6
ToolTipText = "选择好文件并给出行数和列数后单击"
Top = 5640
Width = 615
End
Begin VB.FileListBox File1
Appearance = 0 'Flat
Height = 1470
Left = 240
TabIndex = 2
Top = 1080
Width = 2655
End
Begin VB.DirListBox Dir1
Appearance = 0 'Flat
Height = 2190
Left = 3120
TabIndex = 1
Top = 360
Width = 2415
End
Begin VB.DriveListBox Drive1
Appearance = 0 'Flat
Height = 300
Left = 240
TabIndex = 0
Top = 360
Width = 2655
End
Begin VB.Label lblR
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "模糊识别结果文件全名"
ForeColor = &H80000008&
Height = 255
Left = 1080
TabIndex = 16
Top = 3480
Width = 3735
End
Begin VB.Label lblFile
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "数据文件全名"
ForeColor = &H80000008&
Height = 255
Left = 1440
TabIndex = 8
Top = 2760
Width = 3015
End
Begin VB.Label lblF
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "选择数据文件"
ForeColor = &H80000008&
Height = 255
Left = 240
TabIndex = 5
Top = 840
Width = 2655
End
Begin VB.Label lblC
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "选择目录"
ForeColor = &H80000008&
Height = 255
Left = 3120
TabIndex = 4
Top = 120
Width = 2415
End
Begin VB.Label lblD
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "选择驱动器"
ForeColor = &H80000008&
Height = 255
Left = 240
TabIndex = 3
Top = 120
Width = 2655
End
End
Attribute VB_Name = "frmFile"
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 intA As Integer
Dim intFileNumber As Integer '文件号
Dim strData As String '临时保存数据
Private Sub Form_Load()
File1.Pattern = "*.dat" '只显示数据文件
'求贴近度方法的缺省设置为最大最小法
For intI = 1 To 5
Opt(intI) = 0
Next intI
Opt(4) = 1
End Sub
'选择目录
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
'选择驱动器
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
'确定数据文件
Private Sub File1_Click()
txtFile.Text = Dir1.Path & "\" & File1.FileName
txtResultFile.Text = Dir1.Path & "\" & "识别_" & File1.FileName
strResultFile = txtResultFile.Text
End Sub
'选择格贴近度
Private Sub Option1_Click()
For intI = 1 To 5
Opt(intI) = 0
Next intI
Opt(1) = 1
End Sub
'选择海明贴近度
Private Sub Option2_Click()
For intI = 1 To 5
Opt(intI) = 0
Next intI
Opt(2) = 1
End Sub
'选择欧氏贴近度
Private Sub Option3_Click()
For intI = 1 To 5
Opt(intI) = 0
Next intI
Opt(3) = 1
End Sub
'选择最大最小贴近度
Private Sub Option4_Click()
For intI = 1 To 5
Opt(intI) = 0
Next intI
Opt(4) = 1
End Sub
'选择算术平均最小贴近度
Private Sub Option5_Click()
For intI = 1 To 5
Opt(intI) = 0
Next intI
Opt(5) = 1
End Sub
'确定，给出文件名和行数、列数后单击
Private Sub cmdOK_Click()
Dim intR As Integer
If txtFile.Text = "" Then
MsgBox "必须先选定数据文件！", , "数据文件错误"
Exit Sub
End If
strFileName = txtFile.Text '文件名
intFileNumber = FreeFile '取得文件号码
Open strFileName For Input As intFileNumber '打开文件
Input #intFileNumber, intRow, intCol '读总行数、总列数
'XX是已知样本和待定样本数组；X是去除标志列的数组且做预处理
ReDim XX(1 To intRow, 1 To intCol), X(1 To intRow, 1 To intCol - 1)
ReDim X0(1 To intRow, 1 To intCol - 1) '原始数据不做预处理
For intI = 1 To intRow
For intJ = 1 To intCol
Input #intFileNumber, strData '读数据
XX(intI, intJ) = Val(strData)
If intJ < intCol Then X(intI, intJ) = XX(intI, intJ)
If intJ < intCol Then X0(intI, intJ) = XX(intI, intJ)
Next intJ
Next intI
If Check1.Value Then Data_T1 X '标准差变换
If Check2.Value Then Data_T2 X '极差变换
'intRow1为已知样本个数（用于形成标准模型）
'intRow2为待定样本个数（用于识别）
intRow1 = 0: intRow2 = 0
For intI = 1 To intRow
If XX(intI, intCol) > 0 Then intRow1 = intRow1 + 1
If XX(intI, intCol) = 0 Then intRow2 = intRow2 + 1
Next intI
If intRow1 = 0 Then
MsgBox "将转化为标准模型的已知样本不能为0！", , "缺失已知样本错误"
End
End If
If intRow2 = 0 Then
MsgBox "将用于识别的待定样本不能为0！", , "缺失待定样本错误"
End
End If
'X1是已知样本数组；X2是待定样本数组
ReDim X1(1 To intRow1, 1 To intCol - 1), X2(1 To intRow2, 1 To intCol - 1)
ReDim X20(1 To intRow2, 1 To intCol - 1) 'X20是待定样本，不做预处理
ReDim SC(1 To intCol - 1) '某一标准模型
ReDim XC(1 To intCol - 1) '某一待定样本
intRow1 = 0: intRow2 = 0
For intI = 1 To intRow
If XX(intI, intCol) > 0 Then
intRow1 = intRow1 + 1
For intJ = 1 To intCol - 1
X1(intRow1, intJ) = X(intI, intJ) '已知样本数组
Next intJ
End If
If XX(intI, intCol) = 0 Then
intRow2 = intRow2 + 1
For intJ = 1 To intCol - 1
X2(intRow2, intJ) = X(intI, intJ) '待定样本数组
X20(intRow2, intJ) = X0(intI, intJ) '待定样本数组
Next intJ
End If
Next intI
intS = 0 'intS为标准模型的个数
For intI = 1 To intRow
If intS < XX(intI, intCol) Then intS = XX(intI, intCol)
Next intI
'检查标准模型编号
'标准模型编号必须是连续的整数，即1，2，3，...，如果中间出现间断则视为错误
For intI = 1 To intS
For intJ = 1 To intRow1
If XX(intJ, intCol) = intI Then GoTo 100
Next intJ
MsgBox "标准模型的标志必须是连续的整数！", , "标准模型标志错误"
End
100:
Next intI
ReDim XS(1 To intS, 1 To intCol - 1) '标准模型数组
ReDim XS0(1 To intS, 1 To intCol - 1) '标准模型数组，不做预处理
ReDim DS(1 To intS) '贴近度数组
'由已知样本确定标准模型
For intI = 1 To intS
intA = 0
For intJ = 1 To intRow
If XX(intJ, intCol) = intI Then
intA = intA + 1 '同一模型样本计数器
For intK = 1 To intCol - 1
XS(intI, intK) = XS(intI, intK) + X(intJ, intK)
XS0(intI, intK) = XS0(intI, intK) + X0(intJ, intK)
Next intK
End If
Next intJ
'intA为某一标准模型的样本个数
'对属于同一个标准模型的不同样本的对应指标做算术平均
For intK = 1 To intCol - 1
XS(intI, intK) = XS(intI, intK) / intA
XS0(intI, intK) = XS0(intI, intK) / intA
Next intK
Next intI
Close
frmResu.Visible = True
End Sub
'结束运行
Private Sub cmdExit_Click()
Unload Me
End
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -