'//----------------------------------------------------------------------
'//【リッチラベル・コントロール】- RichLabel
'//
'//
'//                                                       by Masato Hirai         
'//----------------------------------------------------------------------
Imports System
Imports System.Drawing
Imports System.Drawing.Text
Imports System.Drawing.Drawing2D
Imports System.Windows.Forms
Imports System.ComponentModel

<ToolboxBitmap(GetType(RichLabel), "RichLabelToolbox.bmp")> _
Public Class RichLabel : Inherits Label
  '//
  '//
  '//
  Public Enum EffectConstant
    Sunken = 0
    Emboss = 1
    Outline = 2
    Fill = 3
  End Enum
  Private ef As EffectConstant = EffectConstant.Sunken
  Private bdc As Color = Color.Black
  '//
  '// コンストラクタ
  '//
  Public Sub New()
    MyBase.New()
    Me.SetStyle(ControlStyles.ResizeRedraw _
             Or ControlStyles.Opaque _
             Or ControlStyles.AllPaintingInWmPaint _
             Or ControlStyles.UserPaint _
             Or ControlStyles.DoubleBuffer, True)
  End Sub
  '//
  '// Dispose
  '//
  Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
    If disposing Then
    End If
    MyBase.Dispose(disposing)
  End Sub
  '//
  '// OnPaint イベント
  '//
  Protected Overrides Sub OnPaint(ByVal e As System.Windows.Forms.PaintEventArgs)
    '背景の描画
    MyBase.OnPaintBackground(e)
    'アライメント
    Dim fmt As New StringFormat
    Select Case (Me.TextAlign Mod 10)
      Case 2
        fmt.Alignment = StringAlignment.Center
      Case 4
        fmt.Alignment = StringAlignment.Far
      Case Else
        fmt.Alignment = StringAlignment.Near
    End Select
    Select Case Me.TextAlign
      Case 1 To 4
        fmt.LineAlignment = StringAlignment.Near
      Case 16 To 64
        fmt.LineAlignment = StringAlignment.Center
      Case 256 To 1024
        fmt.LineAlignment = StringAlignment.Far
    End Select
    'テキストの描画
    e.Graphics.SmoothingMode = SmoothingMode.AntiAlias
    e.Graphics.TextRenderingHint = TextRenderingHint.AntiAlias
    Dim f As New Font(Me.Font.FontFamily, Me.Font.GetHeight(), Me.Font.Style)
    Dim pth As New GraphicsPath
    Dim a As Single = _
      (Me.Font.FontFamily.GetCellAscent(Me.Font.Style) _
      + Me.Font.FontFamily.GetCellDescent(Me.Font.Style) * 2 _
      ) * Me.Font.Size / Me.Font.FontFamily.GetEmHeight(Me.Font.Style)
    pth.AddString(Me.Text, Me.Font.FontFamily, Me.Font.Style, a, Me.ClientRectangle, fmt)
    Select Case Me.Effect
      Case EffectConstant.Sunken
        e.Graphics.DrawString(Me.Text, Me.Font, New SolidBrush(Color.DimGray), New RectangleF(-1, -1, Me.Width, Me.Height), fmt)
        e.Graphics.DrawString(Me.Text, Me.Font, New SolidBrush(Color.White), New RectangleF(1, 1, Me.Width, Me.Height), fmt)
        e.Graphics.DrawString(Me.Text, Me.Font, New SolidBrush(Me.ForeColor), New RectangleF(0, 0, Me.Width, Me.Height), fmt)
      Case EffectConstant.Emboss
        e.Graphics.DrawString(Me.Text, Me.Font, New SolidBrush(Color.DimGray), New RectangleF(1, 1, Me.Width, Me.Height), fmt)
        e.Graphics.DrawString(Me.Text, Me.Font, New SolidBrush(Color.White), New RectangleF(-1, -1, Me.Width, Me.Height), fmt)
        e.Graphics.DrawString(Me.Text, Me.Font, New SolidBrush(Me.ForeColor), New RectangleF(0, 0, Me.Width, Me.Height), fmt)
    End Select
    Select Case Me.Effect
      Case EffectConstant.Outline
        e.Graphics.DrawPath(New Pen(Me.BorderColor), pth)
      Case EffectConstant.Fill
        e.Graphics.FillPath(New SolidBrush(Me.ForeColor), pth)
        e.Graphics.DrawPath(New Pen(Me.BorderColor), pth)
    End Select
    pth.Dispose()
    f.Dispose()
    fmt.Dispose()
  End Sub
  '//
  '// Effect プロパティ
  '//
  <Browsable(True), DefaultValue(GetType(EffectConstant), "Sunken")> _
  Public Property Effect() As EffectConstant
    Get
      Return ef
    End Get
    Set(ByVal Value As EffectConstant)
      ef = Value
      Me.Invalidate()
    End Set
  End Property
  '//
  '// BorderColor プロパティ
  '//
  <Browsable(True), DefaultValue(GetType(Color), "Black")> _
  Public Property BorderColor() As Color
    Get
      Return bdc
    End Get
    Set(ByVal Value As Color)
      bdc = Value
      Me.Invalidate()
    End Set
  End Property

End Class
