四点式曲线.frm

用VB编的关于四点画曲线的程序

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   7770
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   9315
   LinkTopic       =   "Form1"
   ScaleHeight     =   7770
   ScaleWidth      =   9315
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton Command1 
      Caption         =   "显示坐标"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   7200
      TabIndex        =   5
      Top             =   480
      Width           =   1575
   End
   Begin VB.CommandButton Command2 
      Caption         =   "刷新"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   495
      Left            =   7320
      TabIndex        =   4
      Top             =   2040
      Width           =   1335
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      Left            =   7320
      TabIndex        =   1
      Text            =   "0.05"
      Top             =   1560
      Width           =   1335
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H80000009&
      BorderStyle     =   0  'None
      Height          =   6735
      Left            =   120
      ScaleHeight     =   30
      ScaleMode       =   0  'User
      ScaleWidth      =   30
      TabIndex        =   0
      Top             =   120
      Width           =   6735
   End
   Begin VB.Label Label2 
      Caption         =   "Label2"
      Height          =   495
      Left            =   960
      TabIndex        =   3
      Top             =   6960
      Width           =   3255
   End
   Begin VB.Label Label1 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "  点间距："
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   7320
      TabIndex        =   2
      Top             =   1200
      Width           =   1335
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Base 1
Dim N(4, 4) As Single
Dim T(1, 4) As Single
Dim PX(4, 1) As Single, PY(4, 1) As Single

 
Private Sub Command1_Click()
 Call zuobiaoxi
 
End Sub

Sub zuobiaoxi() '画坐标系
 Picture1.Scale (-15, 15)-(15, -15)
 Picture1.DrawWidth = 2
 Picture1.ForeColor = RGB(80, 80, 80)
 Picture1.Line (-15, 0)-(15, 0)
 Picture1.Line (0, -15)-(0, 15)
 Picture1.Line (14.5, -0.5)-(15, 0)
 Picture1.Line (14.5, 0.5)-(15, 0)
 Picture1.Line (0.5, 14.5)-(0, 15)
 Picture1.Line (-0.5, 14.5)-(0, 15)
 Picture1.CurrentX = -1
 Picture1.CurrentY = 15
 Picture1.Print "Y"
 Picture1.CurrentX = 14
 Picture1.CurrentY = -1
 Picture1.Print "X"

End Sub

Private Sub Command2_Click()
  
 Picture1.Refresh
 Call zuobiaoxi
End Sub

Private Sub Form_Load()
 Combo1.AddItem "0.01"
 Combo1.AddItem "0.02"
 Combo1.AddItem "0.05"
 
End Sub

Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 Static pointnum As Integer
 If Combo1.Text = "" Then
    MsgBox ("在combo1中输入值：")
 End If
 If Button = 1 Then
    pointnum = pointnum + 1
    PX(pointnum, 1) = X: PY(pointnum, 1) = Y
    Picture1.Circle (PX(pointnum, 1), PY(pointnum, 1)), 0.1, RGB(200, 80, 200)
 End If
 If pointnum = 4 Then
    Call drawcurve
    pointnum = 0
 End If
 
End Sub

Sub drawcurve()
 '对矩阵N附值
 N(1, 1) = -9 / 2:   N(1, 2) = 27 / 2:  N(1, 3) = -27 / 2:  N(1, 4) = 9 / 2
 N(2, 1) = 9:  N(2, 2) = -45 / 2:  N(2, 3) = 18:  N(2, 4) = -9 / 2
 N(3, 1) = -11 / 2:  N(3, 2) = 9:  N(3, 3) = -9 / 2:  N(3, 4) = 1
 N(4, 1) = 1:  N(4, 2) = 0:  N(4, 3) = 0:  N(4, 4) = 0
 
 Dim t1 As Single, i As Integer
 Dim M() As Single
 Dim QX() As Single, QY() As Single
 Dim qx1() As Single, qy1() As Single
 Static point As Integer
 t1 = 0
 Do While (t1 < 1.000001)
    point = point + 1
    ReDim Preserve qx1(point)
    ReDim Preserve qy1(point)
    For i = 1 To 4
       T(1, i) = t1 ^ (4 - i)
    Next
    Call Juzhenmulti(T(), N(), M(), UBound(T, 1), UBound(N, 2), UBound(T, 2))
    Call Juzhenmulti(M(), PX(), QX(), UBound(M, 1), UBound(PX, 2), UBound(M, 2))
    Call Juzhenmulti(M(), PY(), QY(), UBound(M, 1), UBound(PY, 2), UBound(M, 2))
    qx1(point) = QX(1, 1): qy1(point) = QY(1, 1)
    If point > 1 Then
       Picture1.Line (qx1(point - 1), qy1(point - 1))-(qx1(point), qy1(point)), RGB(200, 80, 200)
    End If
    t1 = t1 + Combo1.Text
 Loop
 point = 0
End Sub

Sub Juzhenmulti(a() As Single, b() As Single, c() As Single, d As Integer, e As Integer, f As Integer)
 Dim i As Integer
 Dim j As Integer
 Dim k As Integer
 ReDim c(d, e) As Single
 For i = 1 To d
    For j = 1 To e
       c(i, j) = 0
       For k = 1 To f
          c(i, j) = c(i, j) + a(i, k) * b(k, j)
       Next
    Next
 Next
          
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
 Label2.Caption = "X;" & Str(X) & "  " & "Y:" & Str(Y)
 
End Sub