ctext.vb

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

'文本类
Imports System.Drawing.Drawing2D

Public Class CText
    Inherits CGElement

    Private m_Font As Font
    Private m_Pos As PointF
    Private m_Content As String
    Private m_Size, m_Angle As Single
    Private m_Color As Color
    Private m_Style As FontStyle

    '字体属性
    Public Property Font() As Font
        Get
            Return m_Font
        End Get
        Set(ByVal Value As Font)
            m_Font = Value
        End Set
    End Property

    '位置属性
    Public Property Pos() As PointF
        Get
            Return m_Pos
        End Get
        Set(ByVal Value As PointF)
            m_Pos = Value
        End Set
    End Property

    '大小属性
    Public Property Size() As Single
        Get
            Return m_Size
        End Get
        Set(ByVal Value As Single)
            m_Size = Value
        End Set
    End Property

    '内容属性
    Public Property Content() As String
        Get
            Return m_Content
        End Get
        Set(ByVal Value As String)
            m_Content = Value
        End Set
    End Property

    '旋转角度属性
    Public Property Angle() As Single
        Get
            Return m_Angle
        End Get
        Set(ByVal Value As Single)
            m_Angle = Value
        End Set
    End Property

    '颜色属性
    Public Shadows Property Color() As Color
        Get
            Return m_Color
        End Get
        Set(ByVal Value As Color)
            m_Color = Value
        End Set
    End Property

    '字体模式
    Public Shadows Property Style() As FontStyle
        Get
            Return m_Style
        End Get
        Set(ByVal Value As FontStyle)
            m_Style = Value
        End Set
    End Property

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

    '构造函数，用已知的字符串进行构造
    Public Sub New(ByVal str As String, ByVal aPos As PointF)
        Init()
        m_Content = str
        m_Pos = aPos
    End Sub

    '构造函数
    Public Sub New(ByVal str As String, ByVal f As Font, _
                   ByVal size As Single, _
                   ByVal aPos As PointF, ByVal ang As Single, _
                   ByVal c As Color, ByVal sty As FontStyle)
        m_Content = str
        m_Font = f
        m_Size = size
        m_Pos = aPos
        m_Angle = ang
        m_Color = c
        m_Style = sty
    End Sub

    '构造函数，用已知的文本进行构造
    Public Sub New(ByVal text As CText)
        With text
            m_Content = .Content
            m_Font = .Font
            m_Pos = .Pos
            m_Size = .Size
            m_Angle = .Angle
            m_Color = .Color
            m_Style = .Style
        End With
    End Sub

    '初始化文本
    Private Shadows Sub Init()
        m_Content = " "
        m_Size = 20
        m_Font = New Font("宋体", m_Size, m_Style, GraphicsUnit.Pixel)
        m_Pos = New PointF(0, 0)
        m_Angle = 0
        m_Color = Color.Black
        m_Style = FontStyle.Regular
    End Sub

    '绘文本
    Public Overrides Sub Draw(ByVal g As Graphics, ByVal aDrawMode As geDrawMode)
        Select Case aDrawMode
            Case CGElement.geDrawMode.Normal
                m_Color = Color.Black
            Case CGElement.geDrawMode.Selec
                m_Color = Color.Red
            Case CGElement.geDrawMode.Delete
                m_Color = Color.White
        End Select
        Dim Pos As PointF = WorldtoPage(m_Pos)
        Dim sf As New StringFormat(StringFormatFlags.NoWrap)
        g.DrawString(m_Content, m_Font, New SolidBrush(m_Color), Pos.X, Pos.Y, sf)
    End Sub

    '计算文本的包围矩形
    Public Overrides Function GetBox() As CBox
        Dim aBox As New CBox()
        Dim gp As New GraphicsPath()
        Dim fm As New FontFamily("宋体")
        Dim sf As New StringFormat(StringFormatFlags.NoWrap)
        gp.AddString(m_Content, fm, m_Style, m_Size, m_Pos, sf)
        Dim rect As RectangleF = gp.GetBounds()
        With aBox
            .minX = rect.Left
            .minY = rect.Top - rect.Height
            .maxX = rect.Right
            .maxY = rect.Bottom - rect.Height
        End With
        gp.Dispose()
        Return aBox
    End Function

    '拾取文本
    Public Overrides Function Pick(ByVal aPos As PointF) As Boolean
        If InBox(GetBox(), aPos) Then
            Return True
        Else
            Return False
        End If
    End Function

End Class