clsline.cls

办公流程定制

                            Exit Function
                        End If
                    Else
                        If X < X1 And X > X2 Then
                            ExistState = 0
                            If mvarSetActiveFlag = False Then
                                DrawPoint
                                mvarSetActiveFlag = True
                            End If
                            Exit Function
                        End If
                    End If
                End If
            End If
        Next i
    If mvarSetActiveFlag = True Then
        mvarSetActiveFlag = False
        DrawPoint
    End If
End Function

Public Sub DrawPoint()
Dim MidPoint As POINTAPI
Dim X1, X2, Y1, Y2 As Long
Dim i As Integer
    mvarDrawFrm.DrawMode = 7
    mvarDrawFrm.DrawWidth = 1
    mvarDrawFrm.DrawStyle = 0
    mvarDrawFrm.FillStyle = 0
    '============================
    For i = 1 To mvarMidPointCount - 1
        MidPoint = mvarMidPoint(i)
        X1 = MidPoint.X - 30
        X2 = MidPoint.X + 30
        Y1 = MidPoint.Y - 30
        Y2 = MidPoint.Y + 30
        mvarDrawFrm.Line (X1, Y1)-(X2, Y2), RGB(0, 200, 0), B
    Next i
    If mvarLineType = 4 Then
        MidPoint = mvarEndPoint
        X1 = MidPoint.X - 30
        X2 = MidPoint.X + 30
        Y1 = MidPoint.Y - 30
        Y2 = MidPoint.Y + 30
        mvarDrawFrm.Line (X1, Y1)-(X2, Y2), RGB(0, 200, 0), B
    Else
        DrawArrow
    End If
End Sub
Private Sub DrawArrow()
Dim X1, X2, Y1, Y2 As Long
    mvarDrawFrm.DrawMode = 13
    mvarDrawFrm.DrawWidth = 1
    mvarDrawFrm.DrawStyle = 0
    mvarDrawFrm.FillStyle = 0
    If mvarMidPoint(mvarMidPointCount).X = mvarMidPoint(mvarMidPointCount - 1).X Then
        X1 = mvarMidPoint(mvarMidPointCount).X - 40
        X2 = mvarMidPoint(mvarMidPointCount).X + 40
        If mvarMidPoint(mvarMidPointCount).Y >= mvarMidPoint(mvarMidPointCount - 1).Y Then
            Y1 = mvarMidPoint(mvarMidPointCount).Y - 100
        Else
            Y1 = mvarMidPoint(mvarMidPointCount).Y + 100
        End If
        Y2 = Y1
        mvarDrawFrm.DrawWidth = 3
        mvarDrawFrm.Line (X1, Y1)-(mvarMidPoint(mvarMidPointCount).X, mvarMidPoint(mvarMidPointCount).Y), RGB(100, 100, 100)
        mvarDrawFrm.Line (X2, Y2)-(mvarMidPoint(mvarMidPointCount).X, mvarMidPoint(mvarMidPointCount).Y), RGB(100, 100, 100)
    Else
        Y1 = mvarMidPoint(mvarMidPointCount).Y - 40
        Y2 = mvarMidPoint(mvarMidPointCount).Y + 40
        If mvarMidPoint(mvarMidPointCount).X >= mvarMidPoint(mvarMidPointCount - 1).X Then
            X1 = mvarMidPoint(mvarMidPointCount).X - 100
        Else
            X1 = mvarMidPoint(mvarMidPointCount).X + 100
        End If
        X2 = X1
        mvarDrawFrm.DrawWidth = 3
        mvarDrawFrm.Line (X1, Y1)-(mvarMidPoint(mvarMidPointCount).X, mvarMidPoint(mvarMidPointCount).Y), RGB(100, 100, 100)
        mvarDrawFrm.Line (X2, Y2)-(mvarMidPoint(mvarMidPointCount).X, mvarMidPoint(mvarMidPointCount).Y), RGB(100, 100, 100)
    End If
    mvarDrawFrm.DrawWidth = 1
End Sub
Private Sub Class_Initialize()
mvarMidPointCount = 0
mvarClsName = "LINE"
End Sub



'**********************************************************
Public Sub ReDraw(Button As Integer)
Dim MidPoint As POINTAPI
Dim EndPoint As POINTAPI
Dim i As Integer

    '============================
    If mvarEndPoint.X = mvarBeginPoint.X Or mvarBeginPoint.Y = mvarEndPoint.Y Then
        ReDim Preserve mvarMidPoint(3) '设置点的保存结构
        mvarMidPointCount = 3
        '============================1
        mvarMidPoint(1) = mvarBeginPoint
        '============================2
        MidPoint.X = (mvarEndPoint.X + mvarBeginPoint.X) / 2
        MidPoint.Y = (mvarEndPoint.Y + mvarBeginPoint.Y) / 2
        mvarMidPoint(2) = MidPoint
        '============================3
        mvarMidPoint(3) = mvarEndPoint
    Else
        If Button = 50 Then
            ReDim Preserve mvarMidPoint(7) '设置点的保存结构
            mvarMidPointCount = 7
            '============================1
            mvarMidPoint(1) = mvarBeginPoint
            '============================4
            MidPoint.X = (mvarEndPoint.X + mvarBeginPoint.X) / 2
            MidPoint.Y = (mvarEndPoint.Y + mvarBeginPoint.Y) / 2
            mvarMidPoint(4) = MidPoint
            '===========================3
            MidPoint.X = mvarMidPoint(4).X
            MidPoint.Y = mvarBeginPoint.Y
            mvarMidPoint(3) = MidPoint
            '============================5
            MidPoint.X = mvarMidPoint(4).X
            MidPoint.Y = mvarEndPoint.Y
            mvarMidPoint(5) = MidPoint
            '============================2
            MidPoint.X = (mvarBeginPoint.X + mvarMidPoint(3).X) / 2
            MidPoint.Y = mvarBeginPoint.Y
            mvarMidPoint(2) = MidPoint
            '============================6
            MidPoint.X = (mvarEndPoint.X + mvarMidPoint(5).X) / 2
            MidPoint.Y = mvarEndPoint.Y
            mvarMidPoint(6) = MidPoint
            '============================7
            mvarMidPoint(7) = mvarEndPoint
        ElseIf Button = 60 Then
            ReDim Preserve mvarMidPoint(5) '设置点的保存结构
            mvarMidPointCount = 5
            '============================1
            mvarMidPoint(1) = mvarBeginPoint
            '===========================3
            MidPoint.X = mvarBeginPoint.X
            MidPoint.Y = mvarEndPoint.Y
            mvarMidPoint(3) = MidPoint
            '============================2
            MidPoint.X = mvarBeginPoint.X
            MidPoint.Y = (mvarBeginPoint.Y + mvarMidPoint(3).Y) / 2
            mvarMidPoint(2) = MidPoint
            '============================4
            MidPoint.X = (mvarEndPoint.X + mvarMidPoint(3).X) / 2
            MidPoint.Y = mvarEndPoint.Y
            mvarMidPoint(4) = MidPoint
            '============================5
            mvarMidPoint(5) = mvarEndPoint
        ElseIf Button = 70 Then
            ReDim Preserve mvarMidPoint(5) '设置点的保存结构
            mvarMidPointCount = 5
            '============================1
            mvarMidPoint(1) = mvarBeginPoint
            '===========================3
            MidPoint.X = mvarEndPoint.X
            MidPoint.Y = mvarBeginPoint.Y
            mvarMidPoint(3) = MidPoint
            '============================2
            MidPoint.X = (mvarBeginPoint.X + mvarMidPoint(3).X) / 2
            MidPoint.Y = mvarBeginPoint.Y
            mvarMidPoint(2) = MidPoint
            '============================4
            MidPoint.X = mvarEndPoint.X
            MidPoint.Y = (mvarEndPoint.Y + mvarMidPoint(3).Y) / 2
            mvarMidPoint(4) = MidPoint
            '============================5
            mvarMidPoint(5) = mvarEndPoint
        Else
            ReDim Preserve mvarMidPoint(7) '设置点的保存结构
            mvarMidPointCount = 7
            '============================1
            mvarMidPoint(1) = mvarBeginPoint
            '============================4
            MidPoint.X = (mvarEndPoint.X + mvarBeginPoint.X) / 2
            MidPoint.Y = (mvarEndPoint.Y + mvarBeginPoint.Y) / 2
            mvarMidPoint(4) = MidPoint
            '============================2
            MidPoint.X = mvarBeginPoint.X
            MidPoint.Y = (mvarEndPoint.Y - mvarBeginPoint.Y) / 4 + mvarBeginPoint.Y
            mvarMidPoint(2) = MidPoint
            '===========================3
            MidPoint.X = mvarBeginPoint.X
            MidPoint.Y = mvarMidPoint(4).Y
            mvarMidPoint(3) = MidPoint
            '============================5
            MidPoint.X = mvarEndPoint.X
            MidPoint.Y = mvarMidPoint(4).Y
            mvarMidPoint(5) = MidPoint
            '============================6
            MidPoint.X = mvarEndPoint.X
            MidPoint.Y = (mvarEndPoint.Y - mvarBeginPoint.Y) * 3 / 4 + mvarBeginPoint.Y
            mvarMidPoint(6) = MidPoint
            '============================7
            mvarMidPoint(7) = mvarEndPoint
        End If
    End If
End Sub




Function hypot(ByVal X As Single, ByVal Y As Single)
 hypot = Sqr(X ^ 2 + Y ^ 2)
End Function

Private Sub drawcir()
Dim i As Integer
'mvarDrawFrm.Scale (0, 0)-(640, 480)
X(0) = mvarBeginPoint.X
Y(0) = mvarBeginPoint.Y
X(1) = mvarLineMidPoint.X
Y(1) = mvarLineMidPoint.Y
X(2) = mvarEndPoint.X
Y(2) = mvarEndPoint.Y
mvarMidPoint(1) = mvarBeginPoint
mvarMidPoint(3) = mvarEndPoint
mvarMidPoint(2) = mvarLineMidPoint

mvarDrawFrm.DrawWidth = 3

For i = 0 To 2
    mvarDrawFrm.PSet (X(i), Y(i))
Next i

mvarDrawFrm.DrawWidth = 1
tspLine 2, 2, 0, 0, 0, 0
mvarDrawFrm.PSet (u1(0), v1(0))

For i = 1 To num - 1
    mvarDrawFrm.Line -(u1(i), v1(i)) ', RGB(255, 255, 0)
Next i
End Sub
Private Sub tspLine(ByVal n As Integer, ByVal ch As Integer, ByVal tx1 As Single, ByVal tx2 As Single, ByVal ty1 As Single, ByVal ty2 As Single)
Dim a(10) As Single, b(10) As Single, c(10) As Single, dx(10) As Single, dy(10) As Single
Dim qx(10) As Single, qy(10) As Single
Dim tt As Single, bx3 As Single, bx4 As Single, by3 As Single, by4 As Single
Dim cx As Single, cy As Single, t(10) As Single, px(10) As Single, py(10) As Single
Dim u(3) As Single, v(3) As Single, i As Integer
num = 0
For i = 1 To n
 t(i) = hypot(X(i) - X(i - 1), Y(i) - Y(i - 1))
Next i
Select Case ch
 Case 0 '抛物条件
   u(0) = (X(1) - X(0)) / t(1): u(1) = (X(2) - X(1)) / t(2)
   u(2) = (u(1) - u(0)) / (t(2) + t(1))
   tx1 = u(0) - u(2) * t(1)
   u(0) = (Y(1) - Y(0)) / t(1): u(1) = (Y(2) - Y(1)) / t(2)
   u(2) = (u(1) - u(0)) / (t(2) + t(1))
   ty1 = u(0) - u(2) * t(1)
   u(0) = (X(n) - X(n - 1)) / t(n): u(1) = (X(n - 1) - X(n - 2)) / t(n - 1)
   u(2) = (u(0) - u(1)) / (t(n) + t(n - 1))
   tx2 = u(0) + u(2) * t(n)
   u(0) = (Y(n) - Y(n - 1)) / t(n): u(1) = (Y(n - 1) - Y(n - 2)) / t(n - 1)
   u(2) = (u(0) - u(1)) / (t(n) + t(n - 1))
   ty2 = u(0) + u(2) * t(n)
 Case 1 '夹持条件
  a(0) = 1: c(0) = 0: dx(0) = tx1: dy(0) = ty1
  a(n) = 1: b(n) = 0: dx(n) = tx2: dy(n) = ty2
 Case 2 '自由条件
  a(0) = 2: c(0) = 1
  dx(0) = 3 * (X(1) - X(0)) / t(1): dy(0) = 3 * (Y(1) - Y(0)) / t(1)
  a(n) = 2: b(n) = 1
  dx(n) = 3 * (X(n) - X(n - 1)) / t(n): dy(n) = 3 * (Y(n) - Y(n - 1)) / t(n)
 Case 3 '循环条件
  a(0) = 2: c(0) = 1
  dx(0) = 3 * (X(1) - X(0)) / t(1) - (t(1) * (X(2) - X(1)) / t(2) - X(1) + X(0)) / (t(1) + t(2))
  dy(0) = 3 * (Y(1) - Y(0)) / t(1) - (t(1) * (Y(2) - Y(1)) / t(2) - Y(1) + Y(0)) / (t(1) + t(2))
  a(n) = 2: b(n) = 1
  dx(n) = 3 * (X(n) - X(n - 1)) / t(n)
  dx(n) = dx(n) + (X(n) - X(n - 1) - t(n) * (X(n - 1) - X(n - 2)) / t(n - 1)) / (t(n) + t(n - 1))
  dy(n) = 3 * (Y(n) - Y(n - 1)) / t(n)
  dy(n) = dy(n) + (Y(n) - Y(n - 1) - t(n) * (Y(n - 1) - Y(n - 2)) / t(n - 1)) / (t(n) + t(n - 1))
End Select

'计算方程组系数阵和常数阵
For i = 1 To n - 1
 a(i) = 2 * (t(i) + t(i + 1)): b(i) = t(i + 1): c(i) = t(i)
 dx(i) = 3 * (t(i) * (X(i + 1) - X(i)) / t(i + 1) + t(i + 1) * (X(i) - X(i - 1)) / t(i))
 dy(i) = 3 * (t(i) * (Y(i + 1) - Y(i)) / t(i + 1) + t(i + 1) * (Y(i) - Y(i - 1)) / t(i))
Next i

'采用追赶法解方程组
c(0) = c(0) / a(0)
For i = 1 To n - 1
 a(i) = a(i) - b(i) * c(i - 1): c(i) = c(i) / a(i)
Next i
a(n) = a(n) - b(n) * c(i - 1)
qx(0) = dx(0) / a(0): qy(0) = dy(0) / a(0)
For i = 1 To n
  qx(i) = (dx(i) - b(i) * qx(i - 1)) / a(i)
  qy(i) = (dy(i) - b(i) * qy(i - 1)) / a(i)
Next i
px(n) = qx(n): py(n) = qy(n)
For i = n - 1 To 0 Step -1
 px(i) = qx(i) - c(i) * px(i + 1)
 py(i) = qy(i) - c(i) * py(i + 1)
Next i
'计算曲线上点的坐标
For i = 0 To n - 1
 bx3 = (3 * (X(i + 1) - X(i)) / t(i + 1) - 2 * px(i) - px(i + 1)) / t(i + 1)
 bx4 = ((2 * (X(i) - X(i + 1)) / t(i + 1) + px(i) + px(i + 1)) / t(i + 1)) / t(i + 1)
 by3 = (3 * (Y(i + 1) - Y(i)) / t(i + 1) - 2 * py(i) - py(i + 1)) / t(i + 1)
 by4 = ((2 * (Y(i) - Y(i + 1)) / t(i + 1) + py(i) + py(i + 1)) / t(i + 1)) / t(i + 1)
 tt = 0
 While (tt <= t(i + 1))
  cx = X(i) + (px(i) + (bx3 + bx4 * tt) * tt) * tt
  cy = Y(i) + (py(i) + (by3 + by4 * tt) * tt) * tt
  u1(num) = cx: v1(num) = cy: num = num + 1: tt = tt + 0.5
 Wend
 u1(num) = X(i + 1): v1(num) = Y(i + 1): num = num + 1
Next i
End Sub