carc.vb

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

'圆弧类
Imports System.Drawing.Drawing2D
Imports System.Math

<Serializable()> Public Class CArc
    Inherits CGElement

    Private m_Center, m_Begin, m_End As PointF

    '圆心属性
    Public Property Center() As PointF
        Get
            Return m_Center
        End Get
        Set(ByVal Value As PointF)
            m_Center = Value
        End Set
    End Property

    '圆弧起点属性
    Public Property ABegin() As PointF
        Get
            Return m_Begin
        End Get
        Set(ByVal Value As PointF)
            m_Begin = Value
        End Set
    End Property

    '圆弧终点属性
    Public Property AEnd() As PointF
        Get
            Return m_End
        End Get
        Set(ByVal Value As PointF)
            m_End = Value
        End Set
    End Property

    '圆弧半径属性，只读
    Public ReadOnly Property Radius() As Single
        Get
            Dim r As Single
            r = DistPtoP(m_Center, m_Begin)
            Return r
        End Get
    End Property

    '圆弧起点的方位角
    Public ReadOnly Property AngleBegin() As Single
        Get
            Dim aAngle As Single
            aAngle = GetAngle(m_Center, m_Begin)
            Return aAngle
        End Get
    End Property

    '圆弧终点的方位角
    Public ReadOnly Property AngleEnd() As Single
        Get
            Dim aAngle As Single
            aAngle = GetAngle(m_Center, m_End)
            Return aAngle
        End Get
    End Property

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

    '构造函数，用已知的圆心、起点和另一点进行构造
    Public Sub New(ByVal pCenter As PointF, ByVal p1 As PointF, ByVal p2 As PointF)
        Init()
        m_Center = pCenter
        m_Begin = p1
        Dim r As Single = DistPtoP(m_Center, m_Begin)
        Dim angle2 As Single = GetAngle(m_Center, p2)
        m_End.X = r * Cos(angle2) + m_Center.X
        m_End.Y = r * Sin(angle2) + m_Center.Y
    End Sub

    '构造函数，用已知的一个圆弧进行构造
    Public Sub New(ByVal aArc As CArc)
        With aArc
            m_Center = .Center
            m_Begin = .ABegin
            m_End = .AEnd
        End With
    End Sub

    '初始化圆弧
    Private Shadows Sub Init()
        MyBase.Init()
        With m_Center
            .X = 0
            .Y = 0
        End With
        m_Begin = m_Center
        m_End = m_Center
    End Sub

    '绘图
    Public Overrides Sub Draw(ByVal g As Graphics, ByVal aDrawMode As geDrawMode)

        '将控制点的坐标由世界坐标转换为页面坐标
        Dim ec As PointF = WorldtoPage(m_Center)
        Dim eb As PointF = WorldtoPage(m_Begin)
        Dim ee As PointF = WorldtoPage(m_End)

        '获得当前绘图环境的句柄
        Dim hdc As IntPtr
        hdc = g.GetHdc()

        '得到圆弧终点的坐标
        Dim X As Single = Radius * Cos(AngleEnd) + m_Center.X
        Dim Y As Single = Radius * Sin(AngleEnd) + m_Center.Y
        Dim pEnd As New PointF(X, Y)
        '设置画笔参数
        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.Arc(hdc, ec.X - Radius, ec.Y + Radius, _
            ec.X + Radius, ec.Y - Radius, eb.X, _
            eb.Y, ee.X, ee.Y)
        '把原来的画笔选入绘图环境
        Win32API.SelectObject(hdc, oldP)
        '删除新创建的画笔
        Win32API.DeleteObject(aPen)
        '释放绘图环境句柄
        g.ReleaseHdc(hdc)
    End Sub

    '计算圆弧的包围矩形
    Public Overrides Function GetBox() As CBox
        Dim x1, y1, x2, y2 As Single
        Dim i As Integer
        Dim aBox As New CBox()
        With m_Begin
            x1 = Min(.X, m_End.X)
            y1 = Min(.Y, m_End.Y)
            x2 = Max(.X, m_End.X)
            y2 = Max(.Y, m_End.Y)
        End With
        For i = 0 To 3
            If (InArc(AngleBegin, AngleEnd, PI / 2 * i)) Then
                '如果圆弧与X轴正向相交
                If i = 0 Then
                    x2 = m_Center.X + Radius
                    '如果圆弧与Y轴正向相交
                ElseIf i = 1 Then
                    y2 = m_Center.Y + Radius
                    '如果圆弧与X轴负向相交
                ElseIf i = 2 Then
                    x1 = m_Center.X - Radius
                    '如果圆弧与Y轴负向相交
                ElseIf i = 3 Then
                    y1 = m_Center.Y - Radius
                End If
            End If
        Next i

        With aBox
            .minX = x1
            .minY = y1
            .maxX = x2
            .maxY = y2
        End With

        Return aBox

    End Function


    '判断角度Angle对应的点是否在Angle1至Angle2的圆弧上
    Private Function InArc(ByVal Angle1 As Single, ByVal Angle2 As Single, ByVal Angle As Single) As Boolean
        '如果起始角小于终止角
        If Angle1 < Angle2 Then
            '如果方向角在起始角与终止角之间，则返回True，
            '否则返回False
            If Angle >= Angle1 And Angle <= Angle2 Then
                Return True
            Else
                Return False
            End If
            '如果起始角小于终止角
        Else
            '如果方向角大于起始角或小于终止角，则返回True，
            '否则返回False
            If Angle >= Angle1 Or Angle <= Angle2 Then
                Return True
            Else
                Return False
            End If
        End If
    End Function

    '拾取圆弧
    Public Overrides Function Pick(ByVal aPos As PointF) As Boolean
        Dim angle, dist As Single

        '如果拾取点不在包围矩形中，则该圆弧不被拾取
        If Not InBox(GetBox(), aPos) Then
            Return False
            '否则，进一步判断
        Else
            '计算拾取点与圆心之间的距离
            dist = DistPtoP(aPos, m_Center)
            '计算拾取点的方位角
            angle = GetAngle(m_Center, aPos)

            '如果起始角小于终止角
            If AngleBegin < AngleEnd Then
                '如果拾取点的方位角界于起始角和终止角之间，
                '则拾取点到圆心的距离与圆弧的半径接近，
                '则圆弧被拾取，否则不被拾取
                If (angle >= AngleBegin And angle <= AngleEnd) _
                  And Abs(Radius - dist) <= PickRadius Then
                    Return True
                Else
                    Return False
                End If
                '如果起始角大于终止角
            Else
                '如果拾取点的方位角大于等于起始角或小于等于终止角
                '且拾取点到圆心的距离与圆弧的半径接近，
                '则该圆弧被拾取；否则不被拾取
                If (angle >= AngleBegin Or angle <= AngleEnd) And _
                  Abs(Radius - dist) <= PickRadius Then
                    Return True
                Else
                    Return False
                End If
            End If
        End If
    End Function

    '平移变换
    Public Overrides Sub Move(ByVal g As Graphics, ByVal basePos As PointF, ByVal desPos As PointF)
        Dim xx, yy As Single
        '计算在X和Y两个方向上的位移量
        xx = desPos.X - basePos.X
        yy = desPos.Y - basePos.Y
        With m_Center
            .X += xx
            .Y += yy
        End With
        With m_Begin
            .X += xx
            .Y += yy
        End With
        With m_End
            .X += xx
            .Y += yy
        End With
    End Sub


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

    '镜像变换
    Public Overrides Sub Mirror(ByVal g As Graphics, ByVal pPos1 As PointF, ByVal pPos2 As PointF)
        '注意，圆弧的镜像变换要交换起点和终点的坐标
        m_Center = pMirror(pPos1, pPos2, m_Center)
        Dim pt As PointF
        pt = pMirror(pPos1, pPos2, m_Begin)
        m_Begin = pMirror(pPos1, pPos2, m_End)
        m_End = pt
    End Sub

    '比例变换
    Public Overrides Sub Scale(ByVal g As Graphics, ByVal sx As Single, ByVal sy As Single)
        With m_Center
            .X = .X * sx
            .Y = .Y * sy
        End With
        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