frmcurvefit.frm

曲线拟合程序

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmCurveFit 
   Caption         =   "Curve Fitting"
   ClientHeight    =   6720
   ClientLeft      =   60
   ClientTop       =   360
   ClientWidth     =   3570
   LinkTopic       =   "Form1"
   ScaleHeight     =   6720
   ScaleWidth      =   3570
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame frmOutputs 
      Caption         =   "Output Coefficients"
      Height          =   1575
      Left            =   120
      TabIndex        =   5
      Top             =   4560
      Width           =   3375
      Begin VB.TextBox txtCoeff1 
         Enabled         =   0   'False
         Height          =   285
         Left            =   240
         TabIndex        =   9
         Top             =   480
         Width           =   1215
      End
      Begin VB.TextBox txtLambda1 
         Enabled         =   0   'False
         Height          =   285
         Left            =   240
         TabIndex        =   8
         Top             =   1200
         Width           =   1215
      End
      Begin VB.TextBox txtCoeff2 
         Enabled         =   0   'False
         Height          =   285
         Left            =   1920
         TabIndex        =   7
         Top             =   480
         Width           =   1215
      End
      Begin VB.TextBox txtLambda2 
         Enabled         =   0   'False
         Height          =   285
         Left            =   1920
         TabIndex        =   6
         Top             =   1200
         Width           =   1215
      End
      Begin VB.Label lblCoeff1 
         Caption         =   "Co-efficient 1"
         Height          =   255
         Left            =   240
         TabIndex        =   13
         Top             =   240
         Width           =   975
      End
      Begin VB.Label Label2 
         Caption         =   "Lambda 1"
         Height          =   255
         Left            =   240
         TabIndex        =   12
         Top             =   960
         Width           =   735
      End
      Begin VB.Label Label3 
         Caption         =   "Co-efficient 2"
         Height          =   255
         Left            =   1920
         TabIndex        =   11
         Top             =   240
         Width           =   975
      End
      Begin VB.Label Label4 
         Caption         =   "Lambda 2"
         Height          =   255
         Left            =   1920
         TabIndex        =   10
         Top             =   960
         Width           =   855
      End
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "Cancel"
      Height          =   375
      Left            =   1920
      TabIndex        =   4
      Top             =   6240
      Width           =   1335
   End
   Begin VB.CommandButton cmdEvaluate 
      Caption         =   "Evaluate"
      Default         =   -1  'True
      Height          =   375
      Left            =   240
      TabIndex        =   3
      Top             =   6240
      Width           =   1335
   End
   Begin MSComctlLib.ListView lstYData 
      Height          =   3375
      Left            =   1800
      TabIndex        =   1
      Top             =   840
      Width           =   1530
      _ExtentX        =   2699
      _ExtentY        =   5953
      View            =   3
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin MSComctlLib.ListView lstXData 
      Height          =   3375
      Left            =   240
      TabIndex        =   0
      Top             =   840
      Width           =   1530
      _ExtentX        =   2699
      _ExtentY        =   5953
      View            =   3
      LabelEdit       =   1
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin VB.Frame frmInput 
      Caption         =   "Input Data Points"
      Height          =   4215
      Left            =   120
      TabIndex        =   2
      Top             =   120
      Width           =   3375
      Begin VB.TextBox txtNumOfDataPoints 
         Height          =   285
         Left            =   1920
         TabIndex        =   15
         Top             =   360
         Width           =   855
      End
      Begin VB.Label lblNumDataPoints 
         Caption         =   "Number of Data Points"
         Height          =   255
         Left            =   120
         TabIndex        =   14
         Top             =   360
         Width           =   1695
      End
   End
End
Attribute VB_Name = "frmCurveFit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim theFit As CurveFit.CurveFit ' Variable to hold the COM Object

' This routine is exectued when the form is initialized
Private Sub Form_Initialize()
' If the initialize routine fails, handle it accordingly
On Error GoTo Exit_Form
    ' Create the COM object
    Set theFit = New CurveFit.CurveFit
    ' Set the flags such that the output is transposed
    theFit.MWFlags.ArrayFormatFlags.TransposeOutput = True
    Exit Sub
Exit_Form:
    ' Display the error message and Unload the form if object creation failed
    MsgBox ("Error: " & Err.Description)
    MsgBox ("Error: Could not create the COM object")
    Unload Me
End Sub

Private Sub Form_Load()
On Error GoTo Exit_Form
    ' Set the runtime properties of the components
    
    ' Set the headers of the column
    Call lstXData.ColumnHeaders.Add(, , "X Data")
    Call lstYData.ColumnHeaders.Add(, , "Y Data")
    
    ' Make the labeledit property automatic so that you edit the label
    lstXData.LabelEdit = lvwAutomatic
    lstYData.LabelEdit = lvwAutomatic
    
    ' Make the grid lines for the listbox visible
    lstXData.GridLines = True
    lstYData.GridLines = True
    Exit Sub
Exit_Form:
    ' Error handling routine. Since cannot load the form, display the error message
    ' and unload the program
    MsgBox ("Error: Could not load the form")
    MsgBox ("Error: " & Err.Description)
    Unload Me
End Sub

Private Sub cmdCancel_Click()
    ' If the user hits the cancel button, unload the form
    Unload Me
End Sub

Private Sub txtNumOfDataPoints_Change()
    ' If the user changes the number of data points, clear the XData and YData listboxes
    ' and provide enough spaces for user given number of points
    Dim loopCount As Integer
    Call lstXData.ListItems.Clear
    Call lstYData.ListItems.Clear
    If (txtNumOfDataPoints.Text = "") Then
        Exit Sub
    End If
    For loopCount = 1 To CInt(txtNumOfDataPoints.Text)
        lstXData.ListItems.Add (loopCount)
        lstYData.ListItems.Add (loopCount)
    Next loopCount
End Sub

Private Sub cmdEvaluate_Click()
    Dim loopCount As Integer ' loop counter
    Dim numOfData As Integer ' variable to hold the number of data points the user has entered
    Dim XData() As Double ' Column Vector for XData, will be passed as input to the COM mehtod
    Dim YData() As Double ' Column Vector for YData, will be passed as input to the COM mehtod
    Dim Coeff As Variant ' Coefficient values will be returned by the COM method in this variable
    Dim Lambda As Variant ' Lambda values will be returned by the COM method in this variable
    
    ' If there is any error, handle it accordingly
On Error GoTo Handle_Error
    If txtNumOfDataPoints.Text = "" Then
        Exit Sub
    End If
    ' Get the number of data points
    numOfData = CInt(txtNumOfDataPoints.Text)
    ReDim XData(1 To numOfData) As Double
    ReDim YData(1 To numOfData) As Double
    ' Read the input data into respective double arrays
    For loopCount = 1 To numOfData
        XData(loopCount) = lstXData.ListItems.Item(loopCount)
        YData(loopCount) = lstYData.ListItems.Item(loopCount)
    Next loopCount
    
    ' Call the COM method
    Call theFit.fitdemo(2, Coeff, Lambda, XData, YData)
    
    ' Display the values of Coefficients returned by the COM method
    txtCoeff1.Text = CStr(Format(Coeff(1, 1), "##.####"))
    txtCoeff2.Text = CStr(Format(Coeff(1, 2), "##.####"))
    txtLambda1.Text = CStr(Format(Lambda(1, 1), "##.####"))
    txtLambda2.Text = CStr(Format(Lambda(1, 2), "##.####"))
    Exit Sub
Handle_Error:
    ' Error handling routine
    MsgBox ("Error: " & Err.Description)
End Sub