编写一个浮动按钮控件(如何给控件添加MouseOut事件)

王朝other·作者佚名  2006-01-09
窄屏简体版  字體: |||超大  

'lblCtlFloatButton.ctl 文件内容如下

VERSION 5.00

Begin VB.UserControl lblCtlFloatButton

ClientHeight = 405

ClientLeft = 0

ClientTop = 0

ClientWidth = 1965

ScaleHeight = 405

ScaleWidth = 1965

Begin VB.Label lblCaption

AutoSize = -1 'True

Height = 195

Index = 0

Left = 480

TabIndex = 1

Top = 120

Width = 45

End

Begin VB.Line Line1

BorderColor = &H80000005&

Index = 0

X1 = 0

X2 = 1920

Y1 = 0

Y2 = 0

End

Begin VB.Line Line1

BorderColor = &H80000005&

Index = 1

X1 = 0

X2 = 0

Y1 = 0

Y2 = 360

End

Begin VB.Line Line1

BorderColor = &H80000003&

Index = 2

X1 = 0

X2 = 1920

Y1 = 360

Y2 = 360

End

Begin VB.Line Line1

BorderColor = &H80000003&

Index = 3

X1 = 1920

X2 = 1920

Y1 = 0

Y2 = 360

End

Begin VB.Label lblCaption

BackStyle = 0 'Transparent

Height = 345

Index = 1

Left = 15

TabIndex = 0

Top = 15

Width = 1905

End

End

Attribute VB_Name = "lblCtlFloatButton"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = True

Attribute VB_PredeclaredId = False

Attribute VB_Exposed = True

Option Explicit

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As Long

Private Type POINTAPI

x As Long

y As Long

End Type

Private m_Float As Boolean

Public Event Click()

Public Event MouseOut()

Private Sub lblCaption_Click(Index As Integer)

RaiseEvent Click

End Sub

Private Sub lblCaption_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)

'模拟按钮被按下的效果

Line1(0).BorderColor = vbButtonShadow

Line1(1).BorderColor = vbButtonShadow

Line1(2).BorderColor = vbWhite

Line1(3).BorderColor = vbWhite

lblCaption(0).Move lblCaption(0).Left + 15, lblCaption(0).Top + 15

End Sub

Private Sub lblCaption_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)

Dim Pos1 As POINTAPI

Dim pos2 As POINTAPI

Dim i As Integer

Static Out As Boolean

'鼠标旋于按钮上,若Float属性为True,则显示浮动效果

If Float = True Then

For i = 0 To 3

Line1(i).Visible = True

Next

End If

Out = False

'当鼠标悬停于按钮上时,通过API函数GetCursorPos和ScreenToClient判断鼠标何时移出

Do While Out = False

GetCursorPos Pos1

pos2.x = Pos1.x: pos2.y = Pos1.y

ScreenToClient UserControl.hwnd, pos2

If pos2.x< 0 Or pos2.y< 0 Or pos2.x>UserControl.Width/15 Or pos2.y>UserControl.Height/15 Then '判断鼠标是否仍在按钮的范围内

Out = True

'鼠标移出按钮,若Float属性为True,则消去浮动效果

If Float = True Then

For i = 0 To 3

Line1(i).Visible = False

Next

End If

RaiseEvent MouseOut '触发MouseOut事件

Exit Do

End If

DoEvents

Loop

End Sub

Private Sub lblCaption_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single)

'模拟按钮被抬起的效果

Line1(2).BorderColor = vbButtonShadow

Line1(3).BorderColor = vbButtonShadow

Line1(0).BorderColor = vbWhite

Line1(1).BorderColor = vbWhite

lblCaption(0).Move (UserControl.Width - lblCaption(0).Width) / 2, (UserControl.Height - lblCaption(0).Height) / 2

End Sub

Private Sub UserControl_InitProperties()

Caption = Extender.Name

End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

Caption = PropBag.ReadProperty("Caption", Extender.Name)

Float = PropBag.ReadProperty("Float", False)

End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

PropBag.WriteProperty "Caption", Caption, Extender.Name

PropBag.WriteProperty "Float", Float, False

End Sub

Private Sub UserControl_Resize()

Line1(0).X2 = UserControl.Width

Line1(2).X2 = UserControl.Width

Line1(1).Y2 = UserControl.Height

Line1(3).Y2 = UserControl.Height

Line1(3).X1 = UserControl.Width - 15

Line1(3).X2 = UserControl.Width - 15

Line1(2).Y1 = UserControl.Height - 15

Line1(2).Y2 = UserControl.Height - 15

lblCaption(1).Move 15, 15, UserControl.Width - 30, UserControl.Height - 30

lblCaption(0).Move (UserControl.Width - lblCaption(0).Width) / 2, (UserControl.Height - lblCaption(0).Height) / 2

End Sub

Public Property Get Caption() As String

Caption = lblCaption(0).Caption

End Property

Public Property Let Caption(ByVal vNewValue As String)

lblCaption(0).Caption = vNewValue

PropertyChanged "Caption"

Call UserControl_Resize

End Property

Public Property Get Float() As Boolean

Float = m_Float

End Property

Public Property Let Float(ByVal vNewValue As Boolean)

Dim i As Integer

m_Float = vNewValue

For i = 0 To 3

Line1(i).Visible = Not vNewValue

Next

PropertyChanged "Float"

End Property

 
 
 
免责声明:本文为网络用户发布,其观点仅代表作者个人观点,与本站无关,本站仅提供信息存储服务。文中陈述内容未经本站证实,其真实性、完整性、及时性本站不作任何保证或承诺,请读者仅作参考,并请自行核实相关内容。
 
 
© 2005- 王朝網路 版權所有 導航