?? 點群分析f1.frm
字號:
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 Label5
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "數(shù)據(jù)文件全名"
ForeColor = &H80000008&
Height = 255
Left = 1800
TabIndex = 8
Top = 2760
Width = 3015
End
Begin VB.Label Label3
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "選擇數(shù)據(jù)文件"
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 = "選擇驅(qū)動器"
ForeColor = &H80000008&
Height = 255
Left = 480
TabIndex = 3
Top = 120
Width = 2655
End
End
Attribute VB_Name = "frmFileName"
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 '臨時保存數(shù)據(jù)
Dim blnTitle As Boolean '是否有標題
Dim blnRowLabel As Boolean '是否有行標
Dim blnColLabel As Boolean '是否有列標
Dim XX(1 To 1000, 1 To 100) '臨時工作數(shù)組
Private Sub Form_Load()
File1.Pattern = "*.dat" '只顯示數(shù)據(jù)文件
Frame1.Visible = False: Frame2.Visible = False: Frame3.Visible = False
End Sub
'選擇目錄
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
'選擇驅(qū)動器
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
'確定數(shù)據(jù)文件
Private Sub File1_Click()
txtFile.Text = Dir1.Path & "\" & File1.FileName
End Sub
'在選擇文件之后，框架可視
Private Sub txtFile_Change()
Frame1.Visible = True
Frame2.Visible = True
Frame3.Visible = True
End Sub
'確定，給出文件名和行數(shù)、列數(shù)后單擊
Private Sub cmdOK_Click()
If txtFile.Text = "" Then
MsgBox "必須先選定數(shù)據(jù)文件！"
Exit Sub
End If
strFileName = txtFile.Text '文件名
intFileNumber = FreeFile '取得空閑的文件號碼
Open strFileName For Input As intFileNumber
Input #intFileNumber, strData '讀列數(shù)
intCol = Val(strData) '取得列數(shù)
If intCol >= 2 Then
For intI = 2 To intCol '空轉(zhuǎn)，讀*****
Input #intFileNumber, strData
Next intI
End If
Input #intFileNumber, strData '讀行數(shù)
intRow = Val(strData) '取得行數(shù)
If intCol >= 2 Then
For intI = 2 To intCol '空轉(zhuǎn)，讀*****
Input #intFileNumber, strData
Next intI
End If
If intRow < intCol Then
MsgBox "數(shù)據(jù)的行數(shù)小于列數(shù)，重新建立數(shù)據(jù)文件！", _
vbOKOnly + vbExclamation, "數(shù)據(jù)文件錯誤"
End
End If
N = intRow: M = intCol
'重新定義自變量數(shù)組
ReDim X(1 To N, 1 To M)
Input #intFileNumber, strData '讀總行數(shù)
intRowAll = Val(strData) '取得總行數(shù)
If intCol >= 2 Then
For intI = 2 To intCol '空轉(zhuǎn)，讀*****
Input #intFileNumber, strData
Next intI
End If
blnTitle = False: blnRowLabel = False: blnColLabel = False
'優(yōu)先考慮標題
If intRowAll > intRow + 3 Then blnTitle = True '有標題
'其次考慮行標
If intRowAll > 2 * intRow + 3 Then
blnRowLabel = True '有行標
ReDim strRowLabel(1 To intRow) '重新定義行標數(shù)組
End If
'最后考慮列標
If intRowAll > 2 * intRow + 4 Then
blnColLabel = True '有列標
ReDim strColLabel(1 To intCol) '重新定義列標數(shù)組
End If
If blnTitle Then
Input #intFileNumber, strData '讀標題
strLabelName = strData '保存標題
If intCol >= 2 Then
For intI = 2 To intCol '空轉(zhuǎn)，讀*****號
Input #intFileNumber, strData
Next intI
End If
End If
If blnRowLabel Then
For intI = 1 To intRow
Input #intFileNumber, strData '讀行標題
If intCol >= 2 Then
For intJ = 2 To intCol '空轉(zhuǎn)，讀*****號
Input #intFileNumber, strData
Next intJ
End If
Next intI
End If
If blnColLabel Then
For intI = 1 To intCol '讀列標題
Input #intFileNumber, strData
Next intI
End If
For intI = 1 To intRow
For intJ = 1 To intCol
Input #intFileNumber, strData '讀數(shù)據(jù)
X(intI, intJ) = Val(strData)
Next intJ
Next intI
If Option1 Then Data_S1 X '標準差標準化
If Option2 Then Data_S2 X '極差標準化
If Option3 Then Data_S3 X '極差正規(guī)化
If Option6 Then Key = 1 'Q型距離系數(shù)
If Option7 Then Key = 2 'Q型夾角余弦
If Option8 Then Key = 3 'Q型相關(guān)系數(shù)
If Option5 Then 'R型相關(guān)系數(shù)
Key = 4
'將已經(jīng)變換的數(shù)據(jù)保存
For intI = 1 To intRow
For intJ = 1 To intCol
XX(intJ, intI) = X(intI, intJ)
Next intJ
Next intI
'重新按R型的要求改變數(shù)組，行、列互換
M = intRow: N = intCol
ReDim X(1 To N, 1 To M)
For intI = 1 To intRow
For intJ = 1 To intCol
X(intJ, intI) = XX(intI, intJ)
Next intJ
Next intI
End If
Close
frmCalculate.Visible = True
End Sub
'只在Q型時顯示分類統(tǒng)計量
Private Sub Option4_Click()
Frame3.Visible = True
End Sub
'R型時不顯示分類統(tǒng)計量
Private Sub Option5_Click()
Frame3.Visible = False
End Sub
'結(jié)束運行
Private Sub cmdExit_Click()
Unload Me
End
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -