crectangle.vb

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

Imports System.Math

Public Class CRectangle
    Inherits CGElement

    Private m_basePos, m_desPos As PointF

    '绘矩形时的起点
    Public Property basePos() As PointF
        Get
            Return m_basePos
        End Get
        Set(ByVal Value As PointF)
            m_basePos = Value
        End Set
    End Property

    '绘矩形时的终点
    Public Property desPos() As PointF
        Get
            Return m_desPos
        End Get
        Set(ByVal Value As PointF)
            m_desPos = Value
        End Set
    End Property

    '矩形的左上角点
    Public ReadOnly Property LT() As PointF
        Get
            Return (New PointF(Min(m_basePos.X, m_desPos.X), _
                  Max(m_basePos.Y, m_desPos.Y)))
        End Get
    End Property

    '矩形的右下角点
    Public ReadOnly Property RB() As PointF
        Get
            Return (New PointF(Max(m_basePos.X, m_desPos.X), _
                  Min(m_basePos.Y, m_desPos.Y)))
        End Get
    End Property

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

    '构造函数，用已知的两点构造矩形
    Public Sub New(ByVal pBase As PointF, ByVal pDes As PointF)
        Init()
        m_basePos = pBase
        m_desPos = pDes
    End Sub

    '构造函数，用已知的矩形构造矩形
    Public Sub New(ByVal arectangle As CRectangle)
        m_basePos = arectangle.basePos
        m_desPos = arectangle.desPos
    End Sub

    '初始化矩形
    Private Shadows Sub Init()
        MyBase.Init()
        With m_basePos
            .X = 0
            .Y = 0
        End With
        m_desPos = m_basePos
    End Sub

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

        '将绘矩形时的起点和终点坐标转换为页面坐标
        Dim eb As PointF = WorldtoPage(m_basePos)
        Dim ed As PointF = WorldtoPage(m_desPos)

        Dim minX As Single, minY As Single
        Dim maxX As Single, maxY As Single
        minX = Min(eb.X, ed.X)
        minY = Min(eb.Y, ed.Y)
        maxX = Max(eb.X, ed.X)
        maxY = Max(eb.Y, ed.Y)

        '获取绘图环境的句柄
        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.SelectObject(hdc, Win32API.GetStockObject(5))
        '绘制矩形
        Win32API.Rectangle(hdc, minX, maxY, maxX, minY)
        '把原来的画笔选入绘图环境
        Win32API.SelectObject(hdc, oldP)
        '删除新创建的画笔
        Win32API.DeleteObject(aPen)
        '释放绘图环境句柄
        g.ReleaseHdc(hdc)

    End Sub

    '计算包围矩形
    Public Overrides Function GetBox() As CBox
        Dim aBox As New CBox()
        With aBox
            .minX = Me.LT.X
            .minY = Me.RB.Y
            .maxX = Me.RB.X
            .maxY = Me.LT.Y
        End With
        Return aBox
    End Function

    '拾取矩形
    Public Overrides Function Pick(ByVal aPos As PointF) As Boolean

        '首先把要拾取的矩形分解为四条直线段，
        Dim line0 As New CLine()
        Dim line1 As New CLine()
        Dim line2 As New CLine()
        Dim line3 As New CLine()
        line0 = New CLine(Me.LT, New PointF(Me.LT.X, Me.RB.Y))
        line1 = New CLine(New PointF(Me.LT.X, Me.RB.Y), Me.RB)
        line2 = New CLine(Me.RB, New PointF(Me.RB.X, Me.LT.Y))
        line3 = New CLine(New PointF(Me.RB.X, Me.LT.Y), Me.LT)

        '如果有一条直线段被拾取，则整个矩形被拾取
        If line0.Pick(aPos) Or _
            line1.Pick(aPos) Or _
            line2.Pick(aPos) Or _
            line3.Pick(aPos) Then
            Return True
        Else
            Return False
        End If

    End Function
End Class