自定义控件--xp风格按钮（可设置文字颜色）

Imports System.Drawing

Imports System.ComponentModel

Public Class winxpbutton

Inherits System.Windows.Forms.Button

Private my_mouseDown As Boolean = False '鼠标按下

Private my_mouseHover As Boolean = False '鼠标移到上面

Private m_textcolor As Color = System.Drawing.Color.Black '字体颜色

<Description("字体颜色。")> _

Public Property textcolor() As Color

  Get

   Return m_textcolor

  End Get

  Set(ByVal Value As Color)

   m_textcolor = Value

   Me.Invalidate()

  End Set

End Property

Public Sub New()

  MyBase.New()

  '该调用是 Windows 窗体设计器所必需的。

  InitializeComponent()

  '在 InitializeComponent() 调用之后添加任何初始化,true表示将指定的样式应用到控件

  '设置控件样式位能够充分地更改控件行为

  Me.SetStyle(ControlStyles.UserPaint, True)

  '关联事件委托

  AddHandler Me.MouseDown, AddressOf my_OnMouseDown

  AddHandler Me.MouseUp, AddressOf my_OnMouseUp

  AddHandler Me.MouseEnter, AddressOf my_OnMouseEnter

  AddHandler Me.MouseLeave, AddressOf my_OnMouseLeave

 Height = 23  

Width = 75

End Sub

Protected Overrides Sub OnPaint(ByVal pevent As System.Windows.Forms.PaintEventArgs)

  'pevent.ClipRectangle指在其中绘制的矩形,即使用父控件的背景色来画这个矩形按钮

  pevent.Graphics.FillRectangle(New SolidBrush(Me.Parent.BackColor), pevent.ClipRectangle)

  If (Enabled = False) Then

   '画不可用状态

   DrawDisableButton(pevent.Graphics)

  ElseIf (my_mouseDown) Then '画鼠标按下状态

   DrawMouseDownButton(pevent.Graphics)

  ElseIf (my_mouseHover) Then '画鼠标移动到其上状态

   DrawMouseHoverButton(pevent.Graphics)

  ElseIf (Focused) Then '有焦点，但鼠标未移动到其上

   DrawContainFocusButton(pevent.Graphics)

  Else '一般情况下

   DrawNormalButton(pevent.Graphics)

  End If

  '写文本

  WriteText(pevent.Graphics)

End Sub

'鼠标按下的状态处理

Private Sub my_OnMouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)

  my_mouseDown = True '鼠标按下

End Sub

'鼠标松开状态的处理

Private Sub my_OnMouseUp(ByVal sender As Object, ByVal e As MouseEventArgs)

  my_mouseDown = False '鼠标松开

  '重新绘制控件时发生 Paint 事件。PaintEventArgs 指定绘制控件所用的 Graphics

  '以及绘制控件所在的 ClipRectangle。

  Dim pe As PaintEventArgs = New PaintEventArgs(CreateGraphics(), ClientRectangle)

  OnPaint(pe)

End Sub

'鼠标进入

Private Sub my_OnMouseEnter(ByVal sender As Object, ByVal e As EventArgs)

  my_mouseHover = True '鼠标移动到其上

  '

  Dim pe As PaintEventArgs = New PaintEventArgs(CreateGraphics(), ClientRectangle)

  OnPaint(pe)

End Sub

'鼠标移动开

Private Sub my_OnMouseLeave(ByVal sender As Object, ByVal e As EventArgs)

  my_mouseHover = False '鼠标移动开

  '

  Dim pe As PaintEventArgs = New PaintEventArgs(CreateGraphics(), ClientRectangle)

  OnPaint(pe)

End Sub

Private Sub DrawBorder(ByVal g As Graphics, ByVal state As Integer)

  If (state = 1) Then '绘制一般边框

   '绘制一个画笔，高光点，宽度2

   Dim p As Pen = New Pen(SystemColors.ControlLightLight, 2)

   'g.DrawLine画线，p是画笔，后面是第一个点的坐标，第二个点的坐标

   g.DrawLine(p, 1, 1, 1, Height - 2) '绘制左侧竖线

   g.DrawLine(p, 1, 1, Width - 2, 1) '绘制上面横线

   g.DrawLine(p, Width - 1, 2, Width - 1, Height - 2) '绘制右侧竖线，由于已经在上面绘制了横线（纵坐标为1），所以从2开始

   g.DrawLine(p, 2, Height - 1, Width - 2, Height - 1) '绘制下面横线

  ElseIf (state = 2) Then '绘制移动到其上的边框

   '与一般边框用高光区别的是显示黄色

   Dim p As Pen = New Pen(Color.Yellow, 2)

   g.DrawLine(p, 1, 1, 1, Height - 2)

   g.DrawLine(p, 1, 1, Width - 2, 1)

   g.DrawLine(p, Width - 1, 2, Width - 1, Height - 2)

   g.DrawLine(p, 2, Height - 1, Width - 2, Height - 1)

  ElseIf (state = 3) Then '绘制按下的显示边框

   '与一般边框用高光区别的是显示暗褐色

   Dim p As Pen = New Pen(SystemColors.ControlDark, 2)

   g.DrawLine(p, 1, 1, 1, Height - 2)

   g.DrawLine(p, 1, 1, Width - 2, 1)

   g.DrawLine(p, Width - 1, 2, Width - 1, Height - 2)

   g.DrawLine(p, 2, Height - 1, Width - 2, Height - 1)

  ElseIf (state = 4) Then '绘制不可用状态边框

   '与一般边框用高光区别的是显示亮色

   Dim p As Pen = New Pen(SystemColors.ControlLight, 2)

   g.DrawLine(p, 1, 1, 1, Height - 2)

   g.DrawLine(p, 1, 1, Width - 2, 1)

   g.DrawLine(p, Width - 1, 2, Width - 1, Height - 2)

   g.DrawLine(p, 2, Height - 1, Width - 2, Height - 1)

  ElseIf (state = 5) Then '绘制有焦点但鼠标不在其上的状态

   '与一般边框用高光区别的是显示兰色

   Dim p As Pen = New Pen(Color.SkyBlue, 2)

   g.DrawLine(p, 1, 1, 1, Height - 2)

   g.DrawLine(p, 1, 1, Width - 2, 1)

   g.DrawLine(p, Width - 1, 2, Width - 1, Height - 2)

   g.DrawLine(p, 2, Height - 1, Width - 2, Height - 1)

  End If

  '//做完如上的处理后再对可用和不可用做圆化边缘处理（也就是把按钮的4个角进行圆化处理）

  If (state = 4) Then '不可用时

   '使用画笔，Color.FromArgb(161, 161, 146)是从一个32位的ARGB值创建系统颜色，宽度为1

   Dim p As Pen = New Pen(Color.FromArgb(161, 161, 146), 1)

   g.DrawLine(p, 0, 2, 0, Height - 3) '左侧竖线（除了两个边角剩下的线）

   g.DrawLine(p, 2, 0, Width - 3, 0) '上面横线（除了两个边角剩下的线）

   g.DrawLine(p, Width - 1, 2, Width - 1, Height - 3) '右侧竖线（除了两个边角剩下的线）

   g.DrawLine(p, 2, Height - 1, Width - 3, Height - 1) '下面的横线

   g.DrawLine(p, 0, 2, 2, 0) '左上角

   g.DrawLine(p, 0, Height - 3, 2, Height - 1) '左下角

   g.DrawLine(p, Width - 3, 0, Width - 1, 2) '右上角

   g.DrawLine(p, Width - 3, Height - 1, Width - 1, Height - 3) '右下角

  Else 'draw normal style border

   '采用默认的黑色进行绘制边角

   g.DrawLine(Pens.Black, 0, 2, 0, Height - 3)

   g.DrawLine(Pens.Black, 2, 0, Width - 3, 0)

   g.DrawLine(Pens.Black, Width - 1, 2, Width - 1, Height - 3)

   g.DrawLine(Pens.Black, 2, Height - 1, Width - 3, Height - 1)

   g.DrawLine(Pens.Black, 0, 2, 2, 0)

   g.DrawLine(Pens.Black, 0, Height - 3, 2, Height - 1)

   g.DrawLine(Pens.Black, Width - 3, 0, Width - 1, 2)

   g.DrawLine(Pens.Black, Width - 3, Height - 1, Width - 1, Height - 3)

  End If

End Sub

'一般状态

Private Sub DrawNormalButton(ByVal g As Graphics)

  '绘制边框，宽度为1

  DrawBorder(g, 1)

  '绘制背景，用高光点颜色

  PaintBack(g, SystemColors.ControlLightLight)

End Sub

'鼠标移动到其上的状态

Private Sub DrawMouseHoverButton(ByVal g As Graphics)

  DrawBorder(g, 2)

  PaintBack(g, SystemColors.ControlLightLight)

End Sub

Private Sub DrawMouseDownButton(ByVal g As Graphics)

  DrawBorder(g, 3)

  '绘制背景，用三维元素的亮色

  PaintBack(g, SystemColors.ControlLight)

End Sub

Private Sub DrawDisableButton(ByVal g As Graphics)

  DrawBorder(g, 4)

  '亮色

  PaintBack(g, SystemColors.ControlLight)

End Sub

Private Sub DrawContainFocusButton(ByVal g As Graphics)

  DrawBorder(g, 5)

  '高光点

  PaintBack(g, SystemColors.ControlLightLight)

End Sub

'绘制背景色

Private Sub PaintBack(ByVal g As Graphics, ByVal c As Color)

  '填充时采用：单色画刷，相对与（0，0）坐标（3，3）的位置，大小为宽-6，高-6

  g.FillRectangle(New SolidBrush(c), 3, 3, Width - 6, Height - 6)

End Sub

'写文本

Private Sub WriteText(ByVal g As Graphics)

  '计算文本的位置

  Dim x As Integer = 0

  Dim y As Integer = 0

  'size用宽高有序对表示矩形区域

  Dim s As Size = g.MeasureString(Text, Font).ToSize()

  x = (Width - s.Width) / 2 '文字相对控件x偏移

  y = (Height - s.Height) / 2 '文字相对控件y偏移

  '写文本

  If (Enabled) Then '如果控件可用，则黑色文字

   'g.DrawString(Text, Font, Brushes.Black, x, y)

   Dim b As New SolidBrush(m_textcolor)

   g.DrawString(Text, Font, b, x, y)

  Else '如果控件不可用，则灰色文字

   g.DrawString(Text, Font, Brushes.Gray, x, y)

  End If

End Sub

End Class