[分享]仿手绘系列－仿手绘按钮

dylike 2013-01-29 08:41:59

没技术含量，无意中发现去年做的一些旧文件，于是干脆发上来，分享一下。

效果图

设计时

默认事件

代码如下：

Imports System.Drawing.Drawing2D

Imports System.ComponentModel

'设置默认事件为单击

<DefaultEvent("MClick")> _

Public Class DSButton

    '单击事件

    Public Event MClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)

    Dim R As New Random()

    Private _Title As String = "仿手绘按钮"

    Private _Bdw As Integer = 1

    '手绘边框粗细

    Public Property BorderWidth As Integer

        Get

            Return _Bdw

        End Get

        Set(ByVal value As Integer)

            _Bdw = value

            MakeBg()

        End Set

    End Property

    '按钮文本

    Public Property Title As String

        Get

            Return _Title

        End Get

        Set(ByVal value As String)

            _Title = value

            MakeBg()

        End Set

    End Property



    Private Sub DSButton_MouseClick(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseClick

        If e.Button = Windows.Forms.MouseButtons.Left Then

            RaiseEvent MClick(sender, e)

        End If

    End Sub



    Private Sub DSButton_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown

        If e.Button = Windows.Forms.MouseButtons.Left Then

            Me.BackColor = Color.Orange

        End If

    End Sub



    Private Sub DSButton_MouseEnter(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.MouseEnter

        Me.BackColor = Color.Lavender

    End Sub



    Private Sub DSButton_MouseLeave(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.MouseLeave

        Me.BackColor = Color.Transparent

    End Sub



    Private Sub DSButton_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseUp

        Me.BackColor = Color.Lavender

    End Sub

    '生成一个随机灰度的笔触

    Private Function GetPen() As Pen

        Dim A As Integer = R.Next(1, 20)

        Return New Pen(Color.FromArgb(255 / 20 * A, 0, 0, 0), _Bdw)

    End Function

    '绘制仿手绘边框，使用至少3种随机元素，更贴近自然化

    Private Sub DrawRect(ByVal G As Graphics, ByVal Ct As Control)

        Dim Gs As GraphicsState

        Gs = G.Save

        G.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias

        Dim T As Integer = Rnd() * 20 + 10

        Dim Pts As New List(Of Point)

        '这是一个数值，每次随机都增加相应的数，以便判断是否已达控件边缘

        Dim Add As Integer = 0

        '---上边线，线条曲折度为每边1像素范围，下同

        While Add < Ct.Width

            Pts.Add(New Point(Add, _Bdw))

            Add += Rnd() * (Ct.Width / T)

        End While

        For I As Integer = 1 To Pts.Count - 1

            Dim P As New Point(Pts(I))

            P.Y += R.Next(-_Bdw, _Bdw)

            Pts(I) = P

            G.DrawLine(GetPen, Pts(I - 1), Pts(I))

        Next

        '---下边线

        Add = 0

        Pts.Clear()

        While Add < Ct.Width

            Pts.Add(New Point(Add, Ct.Height - _Bdw))

            Add += Rnd() * (Ct.Width / T)

        End While

        For I As Integer = 1 To Pts.Count - 1

            Dim P As New Point(Pts(I))

            P.Y += R.Next(-_Bdw, _Bdw)

            Pts(I) = P

            G.DrawLine(GetPen, Pts(I - 1), Pts(I))

        Next

        '---左边线

        Add = 0

        Pts.Clear()

        While Add < Ct.Height

            Pts.Add(New Point(_Bdw, Add))

            Add += Rnd() * (Ct.Height / T)

        End While

        For I As Integer = 1 To Pts.Count - 1

            Dim P As New Point(Pts(I))

            P.X += R.Next(-_Bdw, _Bdw)

            Pts(I) = P

            G.DrawLine(GetPen, Pts(I), Pts(I - 1))

        Next

        '---右边线

        Add = 0

        Pts.Clear()

        While Add < Ct.Height

            Pts.Add(New Point(Ct.Width - _Bdw, Add))

            Add += Rnd() * (Ct.Height / T)

        End While

        For I As Integer = 1 To Pts.Count - 1

            Dim P As New Point(Pts(I))

            P.X += R.Next(-_Bdw, _Bdw)

            Pts(I) = P

            G.DrawLine(GetPen, Pts(I), Pts(I - 1))

        Next

        G.Restore(Gs)

        '-------

    End Sub

    '生成背景

    Private Sub MakeBg()

        '在重生成新背景前先释放旧的背景以避免吃内存现象

        If Me.BackgroundImage IsNot Nothing Then Me.BackgroundImage.Dispose()

        Me.BackgroundImage = New Bitmap(Me.Width, Me.Height)

        Using G As Graphics = Graphics.FromImage(Me.BackgroundImage)

            G.SmoothingMode = Drawing2D.SmoothingMode.AntiAlias

            '---绘制两次边缘，以更逼真

            DrawRect(G, Me)

            DrawRect(G, Me)

            Using Sf As New Drawing.StringFormat

                '---文本垂直和水平居中显示

                With Sf

                    .Alignment = StringAlignment.Center

                    .LineAlignment = StringAlignment.Center

                End With

                G.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias

                If _Title IsNot Nothing Then

                    '绘制按钮文本

                    G.DrawString(_Title, GetFont, Brushes.Black, New Rectangle(0, 0, Me.Width, Me.Height), Sf)

                End If

            End Using

        End Using

    End Sub



    Private Sub DSButton_SizeChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.SizeChanged

        '在控件被更改尺寸后自动重新生成背景

        MakeBg()

    End Sub

End Class