[分享]仿手绘系列－仿手绘按钮
没技术含量，无意中发现去年做的一些旧文件，于是干脆发上来，分享一下。![[分享]仿手绘系列－仿手绘旋钮](http://img.reader8.com/uploadfile/jiaocheng/20140130/2626/2014012617261228673.jpg)
效果图![[分享]仿手绘系列－仿手绘旋钮](http://img.reader8.com/uploadfile/jiaocheng/20140130/2626/2014012617261228674.jpg)
设计时![[分享]仿手绘系列－仿手绘旋钮](http://img.reader8.com/uploadfile/jiaocheng/20140130/2626/2014012617261228675.jpg)
默认事件
代码如下：
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
