'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