曲线_插值f1.frm

这是一个有关线性插值的例子,用vb编写,具有良好的界面,而且是可是化的.仅供大家参考.

VERSION 5.00
Begin VB.Form frmFileName 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   Caption         =   "曲线_插值"
   ClientHeight    =   5190
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   5670
   LinkTopic       =   "Form1"
   ScaleHeight     =   5190
   ScaleWidth      =   5670
   StartUpPosition =   3  '窗口缺省
   Begin VB.TextBox txtX 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   3240
      TabIndex        =   17
      Top             =   4800
      Width           =   735
   End
   Begin VB.OptionButton Option2 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "单点插值"
      ForeColor       =   &H80000008&
      Height          =   375
      Left            =   120
      TabIndex        =   15
      Top             =   4680
      Width           =   1455
   End
   Begin VB.OptionButton Option1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "多点等距插值"
      ForeColor       =   &H80000008&
      Height          =   375
      Left            =   120
      TabIndex        =   14
      Top             =   4320
      Value           =   -1  'True
      Width           =   1695
   End
   Begin VB.TextBox txtM 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Height          =   270
      Left            =   3240
      TabIndex        =   13
      Top             =   4440
      Width           =   735
   End
   Begin VB.TextBox txtResult 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Height          =   375
      Left            =   120
      TabIndex        =   11
      Top             =   3840
      Width           =   5415
   End
   Begin VB.TextBox txtFile 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      Height          =   375
      Left            =   120
      TabIndex        =   9
      Top             =   3000
      Width           =   5415
   End
   Begin VB.CommandButton cmdExit 
      Caption         =   "退  出"
      Height          =   375
      Left            =   4680
      TabIndex        =   7
      ToolTipText     =   "结束程序运行"
      Top             =   4680
      Width           =   855
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "确  定"
      Height          =   375
      Left            =   4680
      TabIndex        =   6
      ToolTipText     =   "选择好文件并给出行数和列数后单击"
      Top             =   4320
      Width           =   855
   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 Label9 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "插值点X坐标："
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   1920
      TabIndex        =   16
      Top             =   4800
      Width           =   1215
   End
   Begin VB.Label Label7 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "等距点数："
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   2040
      TabIndex        =   12
      Top             =   4440
      Width           =   975
   End
   Begin VB.Label Label5 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "多点等距插值结果的文件全名"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   1200
      TabIndex        =   10
      Top             =   3600
      Width           =   3015
   End
   Begin VB.Label Label4 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "原始数据的文件全名"
      ForeColor       =   &H80000008&
      Height          =   255
      Left            =   1200
      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                   '临时保存数据

Private Sub Form_Load()
    Label5.Caption = "等距化插值结果的文件全名"
    Label9.Visible = False: txtX.Visible = False
    File1.Pattern = "*.dat"             '只显示数据文件
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 '原始数据文件
    If Option1 Then _
        txtResult.Text = _
        Dir1.Path & "\" & "Q_" & File1.FileName     '等距插值数据文件
End Sub

'确定，给出文件名和行数、列数后单击
Private Sub cmdOK_Click()
    Dim Temp
    If Option1 Then
        M = Val(txtM.Text)              '多点等距插值时点数
    Else
        A = Val(txtX.Text)              '单点插值时插值点坐标
    End If
    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)               '取得数据行数
'只有两行数据，一行X，一行Y
    If intRow <> 2 Then
        MsgBox "数据行数不等于2，不符合要求，退出检查数据"
        Exit Sub
    End If
    If intCol >= 2 Then
        For intI = 2 To intCol          '空转，读*****
            Input #intFileNumber, strData
        Next intI
    End If
'重新定义数据数组
    ReDim P(1 To intRow, 1 To intCol)   '原始数据
    ReDim X(1 To intCol), Y(1 To intCol)
    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               '读数据
            P(intI, intJ) = Val(strData)
        Next intJ
    Next intI
    Close
    For intJ = 1 To intCol
        X(intJ) = P(1, intJ)
        Y(intJ) = P(2, intJ)
    Next intJ
'排序
LL:
    For intJ = 1 To intCol - 1
        If X(intJ + 1) < X(intJ) Then
            Temp = X(intJ)
            X(intJ) = X(intJ + 1)
            X(intJ + 1) = Temp
            Temp = Y(intJ)
            Y(intJ) = Y(intJ + 1)
            Y(intJ + 1) = Temp
            GoTo LL
        End If
    Next intJ
    strRes_Name = txtResult.Text                        '保存等距数据的文件名
    frmCalculate.Visible = True                         '显示计算窗体
End Sub

Private Sub Opt()
    If Option1 Then
'选择多点等距插值
        Label5.Visible = True: txtResult.Visible = True
        Label7.Visible = True: txtM.Visible = True      '需要行数
        Label9.Visible = False
        txtX.Visible = False                            '无需插值点
    Else
'选择单点插值
        Label5.Visible = False: Label7.Visible = False
        txtResult.Visible = False
        Label9.Visible = True
        txtX.Visible = True                             '需要插值点
        txtM.Visible = False                            '无需点数
    End If
End Sub

'单击多点等距插值按钮事件
Private Sub Option1_Click()
    Opt
End Sub

'单击单点插值按钮事件
Private Sub Option2_Click()
    Opt
End Sub

'退出
Private Sub cmdExit_Click()
    Unload Me
    End
End Sub