逐步回归f1.frm

<VB数理统计实用算法>书中的算法源程序

VERSION 5.00
Begin VB.Form frmFileName 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   Caption         =   "逐步回归"
   ClientHeight    =   3975
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5670
   LinkTopic       =   "Form1"
   ScaleHeight     =   3975
   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              '是否有列标
Dim m1 As Integer

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: m1 = intCol: m = m1 - 1
'重新定义变量数组
    ReDim xy(1 To n, 1 To m1)
'保存回归系数数组和工作单元
    ReDim b(0 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               '读数据
            xy(intI, intJ) = Val(strData)
        Next intJ
    Next intI
    Close
    frmCalculate.Visible = True
End Sub

'结束运行
Private Sub cmdExit_Click()
    Unload Me
    End
End Sub