自訂控制項--xp風格按鈕(可設定文字顏色)

來源:互聯網
上載者:User
按鈕|控制項

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



相關文章

E-Commerce Solutions

Leverage the same tools powering the Alibaba Ecosystem

Learn more >

Apsara Conference 2019

The Rise of Data Intelligence, September 25th - 27th, Hangzhou, China

Learn more >

Alibaba Cloud Free Trial

Learn and experience the power of Alibaba Cloud with a free trial worth $300-1200 USD

Learn more >

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。