VERSION 5.00
Begin VB.Form frmFileName
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "多元线性回归"
ClientHeight = 4065
ClientLeft = 60
ClientTop = 345
ClientWidth = 5670
LinkTopic = "Form1"
ScaleHeight = 4065
ScaleWidth = 5670
StartUpPosition = 3 '窗口缺省
Begin VB.TextBox txtFile
Alignment = 2 'Center
Appearance = 0 'Flat
Height = 270
Left = 120
TabIndex = 9
Top = 3000
Width = 5415
End
Begin VB.CommandButton cmdExit
Caption = "退出"
Height = 375
Left = 4920
TabIndex = 7
ToolTipText = "结束程序运行"
Top = 3480
Width = 615
End
Begin VB.CommandButton cmdOK
Caption = "确定"
Height = 375
Left = 4080
TabIndex = 6
ToolTipText = "选择好文件并给出行数和列数后单击"
Top = 3480
Width = 615
End
Begin VB.FileListBox File1
Appearance = 0 'Flat
Height = 1470
Left = 120
TabIndex = 2
Top = 1080
Width = 2655
End
Begin VB.DirListBox Dir1
Appearance = 0 'Flat
Height = 2190
Left = 3000
TabIndex = 1
Top = 360
Width = 2415
End
Begin VB.DriveListBox Drive1
Appearance = 0 'Flat
Height = 300
Left = 120
TabIndex = 0
Top = 360
Width = 2655
End
Begin VB.Label Label5
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
Caption = "数据文件全名"
ForeColor = &H80000008&
Height = 255
Left = 1320
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 = 120
TabIndex = 5
Top = 840
Width = 2535
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 = 120
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
Dim intFileNumber As Integer '文件号
Dim strData As String '临时保存数据
Dim blnTitle As Boolean '是否有标题
Dim blnRowLabel As Boolean '是否有行标
Dim blnColLabel As Boolean '是否有列标
Private Sub Form_Load()
File1.Pattern = "*.dat" '只显示数据文件
Me.Width = 5760
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
End Sub
'确定，给出文件名和行数、列数后单击
Private Sub cmdOK_Click()
strFileName = txtFile.Text '文件名
intFileNumber = FreeFile '取得空闲的文件号码
Open strFileName For Input As intFileNumber
Input #intFileNumber, strData '读列数
intCol = Val(strData) '取得列数
If intCol >= 2 Then
For intI = 2 To intCol '空转，读*****
Input #intFileNumber, strData
Next intI
End If
Input #intFileNumber, strData '读行数
intRow = Val(strData) '取得行数
If intCol >= 2 Then
For intI = 2 To intCol '空转，读*****
Input #intFileNumber, strData
Next intI
End If
n = intRow: m = intCol - 1
'重新定义自变量数组
ReDim x(1 To n, 1 To m)
'重新定义因变量数组
ReDim y(1 To n)
'保存回归系数数组和工作单元
ReDim b(0 To m), a(1 To m, 1 To m)
'重新定义t检验值数组
ReDim t(1 To m)
Input #intFileNumber, strData '读总行数
intRowAll = Val(strData) '取得总行数
If intCol >= 2 Then
For intI = 2 To intCol '空转，读*****
Input #intFileNumber, strData
Next intI
End If
blnTitle = False: blnRowLabel = False: blnColLabel = False
'优先考虑标题
If intRowAll > intRow + 3 Then blnTitle = True '有标题
'其次考虑行标
If intRowAll > 2 * intRow + 3 Then
blnRowLabel = True '有行标
ReDim strRowLabel(1 To intRow) '重新定义行标数组
End If
'最后考虑列标
If intRowAll > 2 * intRow + 4 Then
blnColLabel = True '有列标
ReDim strColLabel(1 To intCol) '重新定义列标数组
End If
If blnTitle Then
Input #intFileNumber, strData '读标题
strLabelName = strData '保存标题
If intCol >= 2 Then
For intI = 2 To intCol '空转，读*****号
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 '空转，读*****号
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 '读数据
If intJ = intCol Then
y(intI) = Val(strData)
Else
x(intI, intJ) = Val(strData)
End If
Next intJ
Next intI
Close
frmCalculate.Visible = True
End Sub
'结束运行
Private Sub cmdExit_Click()
Unload Me
End
End Sub
