[attach]751[/attach]
'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
[此贴子已经被作者于2004-09-05 14:35:22编辑过]
