frmspline.frm

由给出的三个点坐标

VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmSPline 
   Caption         =   "Form1"
   ClientHeight    =   7230
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9705
   LinkTopic       =   "Form1"
   ScaleHeight     =   7230
   ScaleWidth      =   9705
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "..."
      Height          =   375
      Left            =   8520
      TabIndex        =   4
      Top             =   240
      Width           =   735
   End
   Begin VB.PictureBox Picture1 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      ForeColor       =   &H80000008&
      Height          =   6255
      Left            =   240
      ScaleHeight     =   6225
      ScaleWidth      =   9225
      TabIndex        =   3
      Top             =   840
      Width           =   9255
      Begin MSComDlg.CommonDialog cmDlg 
         Left            =   7800
         Top             =   360
         _ExtentX        =   847
         _ExtentY        =   847
         _Version        =   393216
      End
   End
   Begin VB.TextBox Text1 
      Height          =   375
      Left            =   2520
      TabIndex        =   2
      Top             =   240
      Width           =   5895
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   975
   End
   Begin VB.Label Label1 
      Caption         =   "数据文件"
      Height          =   255
      Left            =   1560
      TabIndex        =   1
      Top             =   240
      Width           =   975
   End
End
Attribute VB_Name = "frmSPline"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Type coordinateXY
        x As Double
        y As Double
End Type

Private Const dotSize = 25
Private Const H = 4000
Private Const W = 400

Private n As Integer
Private T() As Single
Private P() As coordinateXY
Private M() As Single
Private B() As coordinateXY
Private V() As coordinateXY
Private D() As coordinateXY

Private Sub Command1_Click()

    
    Dim i As Integer, j As Integer
    Dim x1 As Double, y1 As Double
    Dim x2 As Double, y2 As Double
'    H = Picture1.ScaleHeight
'    W = Picture1.Left
    If n > 2 Then
    For i = 1 To n - 1 '绘制曲线
        Evaluation 0, i, x1, y1
        x1 = x1 + W
        y1 = H - y1
            For j = 2 To CInt(T(i)) Step 15
            Evaluation j, i, x2, y2
            x2 = x2 + W
              y2 = H - y2
            Picture1.Line (x1, y1)-(x2, y2)
            x1 = x2
            y1 = y2
        Next j
    Next i
    Picture1.Line (0, H)-(6000, H)
    Picture1.Line (W, 0)-(W, 5000)
    End If

End Sub


Public Sub readFile(fileName As String)
   
    Dim XY As coordinateXY
    Dim i As Integer
    i = 0
    
    Open fileName For Input As #2 Len = Len(XY)
    While Not EOF(2)
        ReDim Preserve P(i)
        Input #2, P(i).x, P(i).y
        i = i + 1
  Wend
  n = i
  Close #2
    
End Sub

Public Sub dataT()  '计算弦长T
  Dim i As Integer
  ReDim T(n)
  dataV
    For i = 1 To n - 1
T(i) = Sqr(V(i).x ^ 2 + V(i).y ^ 2)
  Next i
End Sub

Public Sub dataV()  '′计算向量V

  Dim i As Integer
  ReDim V(n)
  For i = 1 To n - 1
    V(i).x = P(i).x - P(i - 1).x
    V(i).y = P(i).y - P(i - 1).y
  Next i
End Sub

Public Sub dataB()  '′计算矩阵B

    Dim i As Integer
    ReDim B(n)
    B(0).x = 0
    B(0).y = 0
    B(n - 1).x = 0
    B(n - 1).y = 0
    For i = 1 To n - 2
        B(i).x = 3 * (T(i) ^ 2 * V(i + 1).x + T(i + 1) ^ 2 * V(i).x) / (T(i) * T(i + 1))
        B(i).y = 3 * (T(i) ^ 2 * V(i + 1).y + T(i + 1) ^ 2 * V(i).y) / (T(i) * T(i + 1))
    Next i

End Sub

Public Sub dataM()  '′计算矩阵M

    Dim i As Integer
    ReDim M(n - 1, n - 1)
    dataT
    M(0, 0) = 1
    M(0, 1) = -1
    M(n - 1, n - 2) = 1
    M(n - 1, n - 1) = -1
    For i = 1 To n - 2
        M(i, i - 1) = T(i + 1)
    M(i, i) = 2 * (T(i) + T(i + 1))
  M(i, i + 1) = T(i)
  Next i
End Sub

Public Sub exEquation()  '′解线性方程组
  Dim i As Integer, j As Integer
  Dim G As Double
  dataM
  dataB
  For i = 0 To n - 2
    For j = i To i + 1
        M(i + 1, j) = M(i + 1, j) - M(i, j) * M(i + 1, i) / M(i, i)
    Next j
    B(i + 1).x = B(i + 1).x - B(i).x * M(i + 1, i) / M(i, i)
    B(i + 1).y = B(i + 1).y - B(i).y * M(i + 1, i) / M(i, i)
    Next i
    ReDim D(n - 1)
  D(n - 1).x = B(n - 1).x / M(n - 1, n - 1)
  D(n - 1).y = B(n - 1).y / M(n - 1, n - 1)
  For i = n - 2 To 0 Step -1
    D(i).x = (B(i).x - M(i, i + 1) * D(i + 1).x) / M(i, i)
    D(i).y = (B(i).y - M(i, i + 1) * D(i + 1).y) / M(i, i)
  Next i
End Sub


Public Sub Evaluation(dt As Integer, k As Integer, x As Double, y As Double)


    x = P(k - 1).x + D(k - 1).x * dt + (3 * V(k).x / T(k) ^ 2 - (2 * D(k - 1).x + D(k).x) / T(k)) * dt ^ 2 _
                + (-2 * V(k).x / T(k) ^ 3 + (D(k - 1).x + D(k).x) / T(k) ^ 2) * dt ^ 3
    y = P(k - 1).y + D(k - 1).y * dt + (3 * V(k).y / T(k) ^ 2 - (2 * D(k - 1).y + D(k).y) / T(k)) * dt ^ 2 _
                + (-2 * V(k).y / T(k) ^ 3 + (D(k - 1).y + D(k).y) / T(k) ^ 2) * dt ^ 3
End Sub

Private Sub Command2_Click()
    
    On Error GoTo eh
    cmDlg.CancelError = True
    cmDlg.ShowOpen
    Me.Text1.Text = cmDlg.fileName
    Call readFile(Text1)
    exEquation '计算导数值
    
eh:
    
    
End Sub