编写一个浮动按钮控件(如何给控件添加MouseOut事件)
来源:互联网 发布:cms2.0监控软件 编辑:程序博客网 时间:2024/05/06 01:01
'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
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
- 编写一个浮动按钮控件(如何给控件添加MouseOut事件)
- 编写一个浮动按钮控件(如何给控件添加MouseOut事件)
- 如何给自定义控件添加事件
- 给用户控件添加事件
- 给用户控件添加事件
- 给动态控件添加事件
- 给控件添加复制事件
- 如何给服务器端控件(TextBox)添加JavaScritp脚本事件
- 给 按钮 链接 添加快捷键(C#控件)
- 如何给ActiveX控件添加“事件”“属性”“标准事件”“自定义事件”等一些相关操作
- 给MFC对话框控件添加鼠标浮动提示
- asp.net(c#)给控件添加事件
- .NET----给用户控件添加事件
- JS 脚本动态给控件添加事件
- 关于给控件动态添加事件
- 给AccordionPane中的控件添加事件
- c# winform 给自定义控件添加事件
- c# winform 给自定义控件添加事件
- 字节顺序
- 从WEB SERVICE 上返回大数据量的DATASET
- 功能强大的Validator验证表单
- 一切都是为了提高自己...
- linux 之间做共享的本地映射
- 编写一个浮动按钮控件(如何给控件添加MouseOut事件)
- DirectX9.0矩阵
- 要求把屏幕的一个矩形区域抓成bmp图象怎么办
- DES(Data Encryption Standard)加密解密整理
- Asp.net中多彩下拉框的实现
- 第二人生 what is the second life? Is that the E-game ?
- 用 Xml 来存储网站设定
- UML系列学习之——活动图
- 1111