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

End Class