可双击，可拖动，半透明效果按钮实现[VB.NET]

因为按钮可以拖动，所以拖动事件会和鼠标单击事件重合，不希望拖动鼠标的时候还发生其他事件的话。

那就只有把点击鼠标的处理放鼠标双击事件了。

可VB.NET里按钮没有双击事件(或者说是不响应)。咋整，自己写吧！看代码。

 ''' <summary> ''' Author:Sugar_Tiger ''' 2010.08.03 ''' </summary> ''' <remarks></remarks> Public Class CustomizeButton Inherits Button 'inherits the system button 'define api messages Const WM_LBUTTONDBLCLK As Integer = &H203 'mouse's left dbclick 'define a mouseEvent parameter to receive the click information Public e As System.Windows.Forms.MouseEventArgs 'define the basic transpant color Protected m_OriColor = Color.FromArgb(10, 0, 140, 150) 'define the original position Protected m_OriPosition As Point = Nothing 'define a delegate for handling mouse double click Public Delegate Sub CstmDoubleClick(ByVal e As System.Windows.Forms.MouseEventArgs) Public delDbClk As CstmDoubleClick = Nothing Protected Overrides Sub WndProc(ByRef m As System.Windows.Forms.Message) ' If it Is dbclick Then If m.Msg = WM_LBUTTONDBLCLK Then If Not delDbClk = Nothing Then delDbClk(e) End If End If MyBase.WndProc(m) End Sub Protected Overrides Sub OnMouseEnter(ByVal e As System.EventArgs) MyBase.OnMouseEnter(e) 'set back color Me.BackColor = Color.LightSkyBlue End Sub Protected Overrides Sub OnMouseLeave(ByVal e As System.EventArgs) MyBase.OnMouseLeave(e) 'set back color Me.BackColor = m_OriColor End Sub Protected Overrides Sub OnMouseDown(ByVal mevent As System.Windows.Forms.MouseEventArgs) 'get original position m_OriPosition = mevent.Location MyBase.OnMouseDown(mevent) 'set back color Me.BackColor = Color.Blue End Sub Protected Overrides Sub OnMouseUp(ByVal mevent As System.Windows.Forms.MouseEventArgs) MyBase.OnMouseUp(mevent) 'set back color Me.BackColor = Color.LightSkyBlue 'set mouse move event Try If mevent.Button = Windows.Forms.MouseButtons.Left Then Dim newPst As Point = Me.Location newPst.Offset(mevent.X - m_OriPosition.X, mevent.Y - m_OriPosition.Y) If New Drawing.Rectangle(New Drawing.Point(0, 0), Me.Parent.Size).Contains(newPst) Then Me.Location = newPst Else MsgBox("Out of border!", MsgBoxStyle.Information, "warning") End If End If Catch End Try End Sub Protected Overrides Sub OnMouseMove(ByVal mevent As System.Windows.Forms.MouseEventArgs) 'set mouse move event If mevent.Button = Windows.Forms.MouseButtons.Left Then Dim newPst As Point = Me.Location newPst.Offset(mevent.X - m_OriPosition.X, mevent.Y - m_OriPosition.Y) If New Drawing.Rectangle(New Drawing.Point(0, 0), Me.Parent.Size).Contains(newPst) Then Me.Location = newPst Else MsgBox("Out of border!", MsgBoxStyle.Information, "warning") End If End If MyBase.OnMouseMove(mevent) End Sub Protected Overrides Sub InitLayout() 'do initial Me.FlatAppearance.BorderSize = 0 Me.FlatStyle = Windows.Forms.FlatStyle.Flat MyBase.InitLayout() 'set back color Me.BackColor = System.Drawing.Color.Transparent Me.BringToFront() End Sub Protected Overrides Sub OnPaint(ByVal pevent As System.Windows.Forms.PaintEventArgs) MyBase.OnPaint(pevent) 'to draw side line and fill button Dim brush As Brush = New SolidBrush(m_OriColor) Dim g As Graphics = pevent.Graphics g.DrawRectangle(New Pen(Color.LightBlue, 1), New Rectangle(1, 1, Me.Width - 1, Me.Height - 1)) g.FillRectangle(brush, New RectangleF(1, 1, Me.Width - 1, Me.Height - 1)) End Sub End Class

 

 

双击事件由单击事件来委托(Delegate)唤醒

看使用按钮方代码

 

  Private Sub Button8_MouseClick(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Button8.MouseClick 'send e for delegate parameter Button8.e = e 'go to the handle for dbclick Button8.delDbClk = AddressOf Button8_CstmDoubleClick End Sub Public Sub Button8_CstmDoubleClick(ByVal e As System.Windows.Forms.MouseEventArgs) MsgBox("Dbclick") 'do you handle here End Sub