form1.frm

VB绘制样条曲线的源码

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "样条曲线"
   ClientHeight    =   7290
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   7335
   LinkTopic       =   "Form1"
   ScaleHeight     =   7290
   ScaleWidth      =   7335
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command2 
      Caption         =   "随机产生43个点，并作样条曲线"
      Height          =   615
      Left            =   4440
      TabIndex        =   2
      Top             =   240
      Width           =   1695
   End
   Begin VB.CommandButton Command1 
      Caption         =   "作已知12个点的样条曲线"
      Height          =   615
      Left            =   1560
      TabIndex        =   1
      Top             =   240
      Width           =   1335
   End
   Begin VB.PictureBox Picture1 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00000000&
      Height          =   6000
      Left            =   720
      ScaleHeight     =   5940
      ScaleWidth      =   5940
      TabIndex        =   0
      Top             =   960
      Width           =   6000
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'每次只需要将下面的“Hypot”函数 和 “YangTiaoQuXian”过程
'原封不动地拷贝下，修改你所想要的点的大小、线宽、颜色 即可。
'调用“YangTiaoQuXian”过程可以参照，本程序中的两个例子。
Function Hypot(ByVal XHypot As Single, ByVal YHypot As Single)
      Hypot = Sqr(XHypot ^ 2 + YHypot ^ 2)
End Function

Private Sub YangTiaoQuXian(XSpline() As Single, YSpline() As Single)
'为了使得该过程中的变量不出现重名，所以该过程中的变量均加了Spline
Dim NumSpline As Integer, U1Spline() As Single, V1Spline() As Single, NSpline As Integer
Dim ASpline() As Single, BSpline() As Single, CSpline() As Single, DxSpline() As Single, DySpline() As Single
Dim QxSpline() As Single, QySpline() As Single
Dim ttSpline As Single, bx3Spline As Single, bx4Spline As Single, by3Spline As Single, by4Spline As Single
Dim cxSpline As Single, CySpline As Single, TSpline() As Single, PxSpline() As Single, PySpline() As Single
Dim ISpline As Integer

NSpline = UBound(XSpline)
ReDim ASpline(NSpline): ReDim BSpline(NSpline): ReDim CSpline(NSpline): ReDim DxSpline(NSpline)
ReDim DySpline(NSpline): ReDim QxSpline(NSpline): ReDim QySpline(NSpline): ReDim TSpline(NSpline)
ReDim PxSpline(NSpline): ReDim PySpline(NSpline)

Picture1.DrawWidth = 5                '可以设置点的大小
 
For ISpline = 0 To NSpline
    Picture1.PSet (XSpline(ISpline), YSpline(ISpline)), vbRed    '此处可根据需要设置颜色
Next ISpline
Picture1.DrawWidth = 1                 '可以设置线宽
 
NumSpline = 0: ReDim U1Spline(1): ReDim V1Spline(1)
For ISpline = 1 To NSpline
    TSpline(ISpline) = Hypot(XSpline(ISpline) - XSpline(ISpline - 1), YSpline(ISpline) - YSpline(ISpline - 1))
Next ISpline

ASpline(0) = 2: CSpline(0) = 1
DxSpline(0) = 3 * (XSpline(1) - XSpline(0)) / TSpline(1): DySpline(0) = 3 * (YSpline(1) - YSpline(0)) / TSpline(1)
ASpline(NSpline) = 2: BSpline(NSpline) = 1
DxSpline(NSpline) = 3 * (XSpline(NSpline) - XSpline(NSpline - 1)) / TSpline(NSpline): DySpline(NSpline) = 3 * (YSpline(NSpline) - YSpline(NSpline - 1)) / TSpline(NSpline)


For ISpline = 1 To NSpline - 1
    ASpline(ISpline) = 2 * (TSpline(ISpline) + TSpline(ISpline + 1)): BSpline(ISpline) = TSpline(ISpline + 1): CSpline(ISpline) = TSpline(ISpline)
    DxSpline(ISpline) = 3 * (TSpline(ISpline) * (XSpline(ISpline + 1) - XSpline(ISpline)) / TSpline(ISpline + 1) + TSpline(ISpline + 1) * (XSpline(ISpline) - XSpline(ISpline - 1)) / TSpline(ISpline))
    DySpline(ISpline) = 3 * (TSpline(ISpline) * (YSpline(ISpline + 1) - YSpline(ISpline)) / TSpline(ISpline + 1) + TSpline(ISpline + 1) * (YSpline(ISpline) - YSpline(ISpline - 1)) / TSpline(ISpline))
Next ISpline


CSpline(0) = CSpline(0) / ASpline(0)
For ISpline = 1 To NSpline - 1
    ASpline(ISpline) = ASpline(ISpline) - BSpline(ISpline) * CSpline(ISpline - 1): CSpline(ISpline) = CSpline(ISpline) / ASpline(ISpline)
Next ISpline
ASpline(NSpline) = ASpline(NSpline) - BSpline(NSpline) * CSpline(ISpline - 1)
QxSpline(0) = DxSpline(0) / ASpline(0): QySpline(0) = DySpline(0) / ASpline(0)
For ISpline = 1 To NSpline
    QxSpline(ISpline) = (DxSpline(ISpline) - BSpline(ISpline) * QxSpline(ISpline - 1)) / ASpline(ISpline)
    QySpline(ISpline) = (DySpline(ISpline) - BSpline(ISpline) * QySpline(ISpline - 1)) / ASpline(ISpline)
Next ISpline
PxSpline(NSpline) = QxSpline(NSpline): PySpline(NSpline) = QySpline(NSpline)
For ISpline = NSpline - 1 To 0 Step -1
    PxSpline(ISpline) = QxSpline(ISpline) - CSpline(ISpline) * PxSpline(ISpline + 1)
    PySpline(ISpline) = QySpline(ISpline) - CSpline(ISpline) * PySpline(ISpline + 1)
Next ISpline

For ISpline = 0 To NSpline - 1
    bx3Spline = (3 * (XSpline(ISpline + 1) - XSpline(ISpline)) / TSpline(ISpline + 1) - 2 * PxSpline(ISpline) - PxSpline(ISpline + 1)) / TSpline(ISpline + 1)
    bx4Spline = ((2 * (XSpline(ISpline) - XSpline(ISpline + 1)) / TSpline(ISpline + 1) + PxSpline(ISpline) + PxSpline(ISpline + 1)) / TSpline(ISpline + 1)) / TSpline(ISpline + 1)
    by3Spline = (3 * (YSpline(ISpline + 1) - YSpline(ISpline)) / TSpline(ISpline + 1) - 2 * PySpline(ISpline) - PySpline(ISpline + 1)) / TSpline(ISpline + 1)
    by4Spline = ((2 * (YSpline(ISpline) - YSpline(ISpline + 1)) / TSpline(ISpline + 1) + PySpline(ISpline) + PySpline(ISpline + 1)) / TSpline(ISpline + 1)) / TSpline(ISpline + 1)
    ttSpline = 0
 While (ttSpline <= TSpline(ISpline + 1))
    cxSpline = XSpline(ISpline) + (PxSpline(ISpline) + (bx3Spline + bx4Spline * ttSpline) * ttSpline) * ttSpline
    CySpline = YSpline(ISpline) + (PySpline(ISpline) + (by3Spline + by4Spline * ttSpline) * ttSpline) * ttSpline
    U1Spline(NumSpline) = cxSpline: V1Spline(NumSpline) = CySpline: NumSpline = NumSpline + 1
    ttSpline = ttSpline + 0.5: ReDim Preserve U1Spline(NumSpline): ReDim Preserve V1Spline(NumSpline)
 Wend
    U1Spline(NumSpline) = XSpline(ISpline + 1): V1Spline(NumSpline) = YSpline(ISpline + 1)
    NumSpline = NumSpline + 1: ReDim Preserve U1Spline(NumSpline): ReDim Preserve V1Spline(NumSpline)
Next ISpline
 
Picture1.PSet (U1Spline(0), V1Spline(0))
For ISpline = 1 To NumSpline - 1
   Picture1.Line -(U1Spline(ISpline), V1Spline(ISpline)), vbBlue   '此处可设置颜色。
Next ISpline
End Sub



'示例一：作已知12个点的样条曲线
Private Sub Command1_Click()
Dim X(0 To 10) As Single, Y(0 To 10) As Single

X(0) = 80: Y(0) = 280
X(1) = 350: Y(1) = 200
X(2) = 180: Y(2) = 140
X(3) = 200: Y(3) = 200
X(4) = 250: Y(4) = 400
X(5) = 450: Y(5) = 480
X(6) = 550: Y(6) = 650
X(7) = 650: Y(7) = 450
X(8) = 550: Y(8) = 450
X(9) = 430: Y(9) = 140
X(10) = 580: Y(10) = 340

Picture1.Scale (0, 700)-(700, 0)   '定义图片框的坐标

Picture1.Cls

Call YangTiaoQuXian(X, Y)  '调用"样条曲线"过程
End Sub


'示例二：随机产生43个点，并作样条曲线
Private Sub Command2_Click()
Dim X(0 To 42) As Single, Y(0 To 42) As Single
Dim I As Integer
For I = 0 To 42
   X(I) = 600 * Rnd + 50
   Y(I) = 600 * Rnd + 50
Next I

Picture1.Scale (0, 700)-(700, 0)   '定义图片框的坐标

Picture1.Cls

Call YangTiaoQuXian(X, Y)  '调用"样条曲线"过程
End Sub

'本程序我运行时发现只能作47个点，超过时将会溢出。
'可能与我设置变量的类型有关，还望多多指正。
'Email:[e-mail]