'LblCtlFloatButton.ctl document follows VERSION 5.00Begin 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 EndEndAttribute VB_Name = "lblCtlFloatButton" Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = TrueAttribute VB_PredeclaredId = FalseAttribute VB_Exposed = TrueOption Explicit
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As LongPrivate Declare Function ScreenToClient Lib "user32" (ByVal hwnd As Long, lpPoint As POINTAPI) As LongPrivate Type POINTAPI x As Long y As LongEnd Type
Private m_float as boolean
Public Event Click () public evenet mouseout ()
Private sub lblcaption_click (index as integer) RaiseEvent Clickend Sub
Private Sub lblCaption_MouseDown (Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) 'button is pressed simulated effect Line1 (0) .BorderColor = vbButtonShadow Line1 (1) .BorderColor = vbButtonShadow Line1 ( 2). Brordercolor = vbwhite line1 (3) .bordercolor = vbwhite lblcaption (0) .MOVE LBLCAPTION (0) .left 15, lblcaption (0) .top 15nd Sub
Private Sub lblCaption_MouseMove (Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) Dim Pos1 As POINTAPIDim pos2 As POINTAPIDim i As IntegerStatic Out As Boolean 'mouse spin-on button, when Float property is True, Display floating effect if float = true1en for i = 0 to 3 line1 (i) .visible = true next end if out = false 'When the mouse is hovering on the button, Judgment the mouse is removed by the API function getcursorpos and 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 TEN 'Judging whether the mouse is still in the button range Out = true' mouse removes the button, if the float property is True, then the floating effect if float = True Then for i = 0 TO 3 LINE1 (i) .visible = false Next End if raiseelent mouseout 'Trigger Mouseout Event EXIT DO END IFEVENTS LOOPEND SUBPRIVATE SUB LBLCAPTION_MOUSEUP (INDEGER, Button As INTEGER, S Hift as integer, x askLE, Y askLE) 'The effect of the analog button is lifted LINE1 (2). brordercolor = 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) / 2END SUB
PRIVATE SUB UserControl_initproperties () CAPTION = Extender.nameEnd 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, FalseEnd SubPrivate 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) / 2nd Sub
Public property get caption () AS STRING CAPTION = LBLCAPTION (0) .caption Producty
Public Property Let Caption (Byval VNewValue As String) LBLCAPTION (0) .caption = VNewValue PropertyChanged "CAPTION" CALL UserControl_ResizeEnd Property
Public property get float () as boolean float = m_floatend print
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
