cline.vb

苏金明编写的《用VB.NET和VC#.NET开发交互式CAD系统》一书的源代码

'直线段类

Imports System.Math

<Serializable()> Public Class CLine
    Inherits CGElement

    Private m_Begin, m_End As PointF

    '直线段的起点属性
    Public Property LBegin() As PointF
        Get
            Return m_Begin
        End Get
        Set(ByVal Value As PointF)
            m_Begin = Value
        End Set
    End Property

    '直线段的终点属性
    Public Property LEnd() As PointF
        Get
            Return m_End
        End Get
        Set(ByVal Value As PointF)
            m_End = Value
        End Set
    End Property

    '无参构造函数
    Public Sub New()
        Init()
    End Sub

    '构造函数，用已知的两点构造直线段
    Public Sub New(ByVal pBegin As PointF, ByVal pEnd As PointF)
        Init()
        m_Begin = pBegin
        m_End = pEnd
    End Sub

    '构造函数，用已知的直线段构造直线段
    Public Sub New(ByVal aline As CLine)
        m_Begin = aline.LBegin
        m_End = aline.LEnd
    End Sub

    '初始化直线段
    Private Shadows Sub Init()
        MyBase.Init()
        With m_Begin
            .X = 0
            .Y = 0
        End With
        m_End = m_Begin
    End Sub

    '绘直线段
    Public Overrides Sub Draw(ByVal g As Graphics, ByVal aDrawMode As geDrawMode)

        '将直线段的起点和终点坐标转换为页面坐标
        Dim eb As PointF = WorldtoPage(m_Begin)
        Dim ee As PointF = WorldtoPage(m_End)

        '获取绘图环境的句柄
        Dim hdc As IntPtr
        hdc = g.GetHdc()
        '设置画笔参数
        Dim penPara As Integer() = DrawSettings(hdc, aDrawMode)
        '创建画笔
        Dim aPen As Long = Win32API.CreatePen(penPara(0), penPara(1), penPara(2))
        '把画笔选入绘图环境，并返回原来的画笔
        Dim oldP As Long = Win32API.SelectObject(hdc, aPen)
        '把画笔移动到直线段的起点处
        Win32API.MoveToEx(hdc, eb.X, eb.Y, Nothing)
        '绘直线段到终点
        Win32API.LineTo(hdc, ee.X, ee.Y)
        '把原来的画笔选入绘图环境
        Win32API.SelectObject(hdc, oldP)
        '删除新创建的画笔
        Win32API.DeleteObject(aPen)
        '释放绘图环境句柄
        g.ReleaseHdc(hdc)

    End Sub

    '计算包围矩形
    Public Overrides Function GetBox() As CBox
        Dim aBox As New CBox()
        '分竖直、水平和倾斜三种情况计算直线段的包围矩形
        If m_Begin.X = m_End.X Then
            aBox.minX = m_Begin.X - PickRadius
            aBox.minY = Min(m_Begin.Y, m_End.Y)
            aBox.maxX = m_Begin.X + PickRadius
            aBox.maxY = Max(m_Begin.Y, m_End.Y)
        ElseIf m_Begin.Y = m_End.Y Then
            aBox.minX = Min(m_Begin.X, m_End.X)
            aBox.minY = m_Begin.Y - PickRadius
            aBox.maxX = Max(m_Begin.X, m_End.X)
            aBox.maxY = m_Begin.Y + PickRadius
        Else
            aBox.minX = Min(m_Begin.X, m_End.X)
            aBox.minY = Min(m_Begin.Y, m_End.Y)
            aBox.maxX = Max(m_Begin.X, m_End.X)
            aBox.maxY = Max(m_Begin.Y, m_End.Y)
        End If
        Return aBox
    End Function

    '计算点到直线段的距离
    Private Function distPtoL(ByVal aPos As PointF, ByVal pB As PointF, _
        ByVal pE As PointF) As Single
        Dim kc(1) As Single
        Dim px As Single = aPos.X
        Dim py As Single = aPos.Y
        Dim distX As Single
        Dim distY As Single
        Dim dist As Single

        '获取直线段的截距式方程，返回斜率和截距
        kc = LineKX(pB, pE)
        '如果为水平直线段
        If kc(0) = 0 Then
            distX = 10000
            distY = Abs(py - pB.Y)
            '如果为竖直直线段
        ElseIf kc(0) = 10000 Then
            distX = Abs(px - pB.X)
            distY = 10000
            '如果为斜线
        Else
            distX = Abs(px - (py - kc(1)) / kc(0))
            distY = Abs(py - (kc(0) * px + kc(1)))
        End If
        '返回水平距离和竖直距离之间的小值
        dist = Min(distX, distY)
        Return dist
    End Function

    '计算直线段的截距式方程
    Private Function LineKX(ByVal pB As PointF, ByVal pE As PointF) As Single()
        Dim kc(1) As Single
        '若直线段不为竖直线段
        If pB.X <> pE.X Then
            'Console.WriteLine(Str(pB.X) & Str(pB.Y))
            kc(0) = (pE.Y - pB.Y) / (pE.X - pB.X)
            '如果是竖直线段
        Else
            kc(0) = 10000
        End If
        '计算截距
        kc(1) = pB.Y - kc(0) * pB.X
        Return kc
    End Function

    '拾取直线段
    Public Overrides Function Pick(ByVal aPos As PointF) As Boolean
        Dim geBox As New CBox()

        '判断拾取点是否在测试包围矩形中，若不是，
        '则直线段不被拾取
        If (Not InBox(GetBox, aPos)) Then
            Return False
        Else
            '如果拾取点位于包围矩形中，且到直线段的距离小于拾取半径，
            '则直线段被拾取；否则不被拾取
            If distPtoL(aPos, m_Begin, m_End) <= PickRadius Then
                Return True
            Else
                Return False
            End If
        End If
    End Function


    '平移变换
    Public Overrides Sub Move(ByVal g As Graphics, ByVal basePos As PointF, ByVal desPos As PointF)
        Dim xx As Single
        Dim yy As Single
        '计算偏移量
        xx = desPos.X - basePos.X
        yy = desPos.Y - basePos.Y
        '偏移后的起点和终点坐标
        m_Begin.X += xx
        m_Begin.Y += yy
        m_End.X += xx
        m_End.Y += yy

        'Dim aMatrix As New Matrix()
        'Dim gp As New GraphicsPath()
        'aMatrix.Translate(xx, yy)
        'gp.AddLine(m_Begin.X, m_Begin.Y, m_End.X, m_End.Y)
        'gp.Transform(aMatrix)
        'Dim p() As PointF = gp.PathPoints
        'm_Begin = p(0)
        'm_End = p(1)
        'gp.Dispose()
    End Sub

    '旋转变换
    Public Overrides Sub Rotate(ByVal g As Graphics, ByVal basePos As PointF, ByVal aAngle As Single)
        m_Begin = pRotate(basePos, m_Begin, aAngle)
        m_End = pRotate(basePos, m_End, aAngle)


        'Dim gp As New GraphicsPath()
        'Dim cossita As Single
        'Dim sinsita As Single
        'cossita = Cos(aAngle)
        'sinsita = Sin(aAngle)
        'Dim aa As Single
        'Dim bb As Single
        'aa = -basePos.X * cossita + basePos.Y * sinsita + basePos.X
        'bb = -basePos.X * sinsita - basePos.Y * cossita + basePos.Y
        'Dim aMatrix As New Matrix(cossita, sinsita, -sinsita, cossita, aa, bb)
        'gp.AddLine(m_Begin.X, m_Begin.Y, m_End.X, m_End.Y)
        'gp.Transform(aMatrix)

        'Dim P() As PointF = gp.PathPoints
        'm_Begin = P(0)
        'm_End = P(1)

        'gp.Dispose()

    End Sub

    '镜像变换
    Public Overrides Sub Mirror(ByVal g As Graphics, ByVal pPos1 As PointF, ByVal pPos2 As PointF)
        m_Begin = pMirror(pPos1, pPos2, m_Begin)
        m_End = pMirror(pPos1, pPos2, m_End)


        'Dim gp As New GraphicsPath()
        'Dim x1 As Single
        'Dim y1 As Single
        'Dim x2 As Single
        'Dim y2 As Single
        'x1 = pPos1.X
        'y1 = pPos1.Y
        'x2 = pPos2.X
        'y2 = pPos2.Y
        'Dim a As Single
        'Dim sita As Single
        'a = (x2 * y1 - x1 * y2) / (x2 - x1)
        'If x1 <> x2 Then
        '    sita = Atan(Abs((y2 - y1) / (x2 - x1)))
        'Else
        '    sita = 1000000
        'End If

        'Dim sin2v As Single
        'Dim cos2v As Single
        'sin2v = Sin(sita * 2)
        'cos2v = Cos(sita * 2)
        'Dim aMatrix As New Matrix(cos2v, sin2v, sin2v, -cos2v, -a * sin2v, a * cos2v + a)
        'gp.AddLine(m_Begin.X, m_Begin.Y, m_End.X, m_End.Y)
        'gp.Transform(aMatrix)

        'Dim p() As PointF = gp.PathPoints()
        'm_Begin = p(0)
        'm_End = p(1)

        'gp.Dispose()

    End Sub

    '比例变换
    Public Overrides Sub Scale(ByVal g As Graphics, ByVal sx As Single, ByVal sy As Single)
        With m_Begin
            .X = .X * sx
            .Y = .Y * sy
        End With
        With m_End
            .X = .X * sx
            .Y = .Y * sy
        End With
    End Sub

End Class