?? frmspline.frm
字號(hào):
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 = "數(shù)據(jù)文件"
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() '計(jì)算弦長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() '′計(jì)算向量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() '′計(jì)算矩陣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() '′計(jì)算矩陣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 '計(jì)算導(dǎo)數(shù)值
eh:
End Sub
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -