📄 模糊聚类f1.frm
字号:
Begin VB.OptionButton Option4
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "指数相似"
ForeColor = &H80000008&
Height = 375
Left = 120
TabIndex = 11
Top = 1440
Width = 1335
End
End
Begin VB.TextBox txtFile
Alignment = 2 'Center
Appearance = 0 'Flat
Height = 270
Left = 120
TabIndex = 9
Top = 3000
Width = 6015
End
Begin VB.CommandButton cmdExit
Caption = "结束"
Height = 375
Left = 5520
TabIndex = 7
ToolTipText = "结束程序运行"
Top = 6720
Width = 615
End
Begin VB.CommandButton cmdOK
Caption = "确定"
Height = 375
Left = 4800
TabIndex = 6
ToolTipText = "选择好文件并给出行数和列数后单击"
Top = 6720
Width = 615
End
Begin VB.FileListBox File1
Appearance = 0 'Flat
Height = 1470
Left = 480
TabIndex = 2
Top = 1080
Width = 2655
End
Begin VB.DirListBox Dir1
Appearance = 0 'Flat
Height = 2190
Left = 3360
TabIndex = 1
Top = 360
Width = 2415
End
Begin VB.DriveListBox Drive1
Appearance = 0 'Flat
Height = 300
Left = 480
TabIndex = 0
Top = 360
Width = 2655
End
Begin VB.Label Label4
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "聚类分析结果文件全名"
ForeColor = &H80000008&
Height = 255
Left = 1200
TabIndex = 28
Top = 3480
Width = 3735
End
Begin VB.Label lblMoC
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "M值或C值"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H80000008&
Height = 255
Left = 4680
TabIndex = 21
Top = 4080
Width = 1335
End
Begin VB.Label Label5
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "数据文件全名"
ForeColor = &H80000008&
Height = 255
Left = 1560
TabIndex = 8
Top = 2760
Width = 3015
End
Begin VB.Label Label3
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "选择数据文件"
ForeColor = &H80000008&
Height = 255
Left = 480
TabIndex = 5
Top = 840
Width = 2655
End
Begin VB.Label Label2
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "选择目录"
ForeColor = &H80000008&
Height = 255
Left = 3000
TabIndex = 4
Top = 120
Width = 2415
End
Begin VB.Label Label1
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "选择驱动器"
ForeColor = &H80000008&
Height = 255
Left = 480
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, I As Integer, J As Integer
Dim intFileNumber As Integer '文件号
Dim strData As String '临时保存数据
Private Sub Form_Load()
File1.Pattern = "*.dat" '只显示数据文件
'先不显示提供参数M或C的文本框
lblMoC.Visible = False: txtMoC.Visible = False
'先不显示选择距离类型的框架
Frame2.Visible = False
'求相似矩阵方法的缺省设置为相关系数法
For intI = 1 To 15
Opt(intI) = 0
Next intI
Opt(3) = 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()
lblMoC.Visible = True: txtMoC.Visible = True
lblMoC.Caption = "提供参数M"
Frame2.Visible = False
For intI = 1 To 15
Opt(intI) = 0
Next intI
Opt(1) = 1
End Sub
'选择夹角余弦法
Private Sub Option2_Click()
lblMoC.Visible = False: txtMoC.Visible = False
Frame2.Visible = False
For intI = 1 To 15
Opt(intI) = 0
Next intI
Opt(2) = 1
End Sub
'选择相关系数法
Private Sub Option3_Click()
lblMoC.Visible = False: txtMoC.Visible = False
Frame2.Visible = False
For intI = 1 To 15
Opt(intI) = 0
Next intI
Opt(3) = 1
End Sub
'选择指数相似系数法
Private Sub Option4_Click()
lblMoC.Visible = False: txtMoC.Visible = False
Frame2.Visible = False
For intI = 1 To 15
Opt(intI) = 0
Next intI
Opt(4) = 1
End Sub
'选择最大最小法
Private Sub Option5_Click()
lblMoC.Visible = False: txtMoC.Visible = False
Frame2.Visible = False
For intI = 1 To 15
Opt(intI) = 0
Next intI
Opt(5) = 1
End Sub
'选择算术平均最小法
Private Sub Option6_Click()
lblMoC.Visible = False: txtMoC.Visible = False
Frame2.Visible = False
For intI = 1 To 15
Opt(intI) = 0
Next intI
Opt(6) = 1
End Sub
'选择几何平均最小法
Private Sub Option7_Click()
lblMoC.Visible = False: txtMoC.Visible = False
Frame2.Visible = False
For intI = 1 To 15
Opt(intI) = 0
Next intI
Opt(7) = 1
End Sub
'选择绝对值倒数法
Private Sub Option8_Click()
lblMoC.Visible = True: txtMoC.Visible = True
lblMoC.Caption = "提供参数M"
Frame2.Visible = False
For intI = 1 To 15
Opt(intI) = 0
Next intI
Opt(8) = 1
End Sub
'选择绝对值指数法
Private Sub Option9_Click()
lblMoC.Visible = False: txtMoC.Visible = False
Frame2.Visible = False
For intI = 1 To 15
Opt(intI) = 0
Next intI
Opt(9) = 1
End Sub
'选择直接距离法
Private Sub Option10_Click()
lblMoC.Visible = True: txtMoC.Visible = True
lblMoC.Caption = "提供参数C"
Frame2.Visible = True
For intI = 1 To 15
Opt(intI) = 0
Next intI
Opt(10) = 1
Opt(11) = 1 '海明距离为缺省
End Sub
'选择海明距离
Private Sub Option11_Click()
Opt(11) = 1: Opt(12) = 0: Opt(13) = 0: Opt(15) = 0
End Sub
'选择欧氏距离
Private Sub Option12_Click()
Opt(11) = 0: Opt(12) = 1: Opt(13) = 0: Opt(15) = 0
End Sub
'选择切氏距离
Private Sub Option13_Click()
Opt(11) = 0: Opt(12) = 0: Opt(13) = 1: Opt(15) = 0
End Sub
'选择海明加权
Private Sub Option15_Click()
Opt(11) = 0: Opt(12) = 0: Opt(13) = 0: Opt(15) = 1
End Sub
'直接使用相似矩阵
Private Sub Option14_Click()
lblMoC.Visible = False: txtMoC.Visible = False
Frame2.Visible = False
For intI = 1 To 15
Opt(intI) = 0
Next intI
Opt(14) = 1
End Sub
'确定，给出文件名和行数、列数后单击
Private Sub cmdOK_Click()
Dim intR As Integer
If txtFile.Text = "" Then
MsgBox "必须先选定数据文件！"
Exit Sub
End If
Fa1 = Val(txtF1.Text): Fa2 = Val(txtF2.Text)
'如果Fa1或Fa2等于0，则不进行F检验
If Fa1 <> 0 And Fa2 <> 0 And Fa1 <= Fa2 Then
MsgBox "F1必须大于F2！", , "F检验显著性水平错"
Exit Sub
End If
strFileName = txtFile.Text '文件名
intFileNumber = FreeFile '取得文件号码
Open strFileName For Input As intFileNumber '打开文件
Input #intFileNumber, intRow, intCol '读行数、列数
N = intRow: M = intCol
'重新定义自变量数组
ReDim X(1 To N, 1 To M)
ReDim R(1 To N, 1 To N), RR(1 To N, 1 To N)
For intI = 1 To intRow
For intJ = 1 To intCol
Input #intFileNumber, strData '读数据
X(intI, intJ) = Val(strData)
Next intJ
Next intI
'直接使用相似矩阵
If Opt(14) = 1 Then GoTo 100
If Check1.Value Then Data_T1 X '标准差变换
If Check2.Value Then Data_T2 X '极差变换
'建立相似矩阵时，选择数量积法或绝对值倒数法提供参数M
If Opt(1) = 1 Or Opt(8) = 1 Then dbM = Val(txtMoC.Text)
'建立相似矩阵时，选择直接距离法提供参数C
If Opt(11) = 1 Or Opt(12) = 1 Or Opt(13) = 1 Or Opt(15) = 1 _
Then dbC = Val(txtMoC.Text)
100:
Close
frmCalc.Visible = True
End Sub
'结束运行
Private Sub cmdExit_Click()
Unload Me
End
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -