Visual Basic 6 Unleashed…sional Reference Edition)/Visual_Basic_6_Unleashed_Professional_Reference_Edition_Sams_1999.iso/Source/CHAP05/Lightb1.ctl

Text File | 1998-05-27 | 19.4 KB | 591 lines

VERSION 5.00
Begin VB.UserControl LightButton
   Appearance      =   0  'Flat
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   1  'Fixed Single
   ClientHeight    =   525
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   3690
   ScaleHeight     =   525
   ScaleWidth      =   3690
   ToolboxBitmap   =   "LightButton.ctx":0000
   Begin VB.Timer tmrChkStatus
      Interval        =   250
      Left            =   3120
      Top             =   0
   End
   Begin VB.Label lblCaption
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "Label1"
      BeginProperty Font
         Name            =   "Arial"
         Size            =   20.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H80000008&
      Height          =   480
      Left            =   720
      TabIndex        =   0
      Top             =   0
      Width           =   1335
   End
End
Attribute VB_Name = "LightButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True

Public Enum lbModeTypes
    [Text Only Mode] = 0
    [Image Mode]
End Enum

Public Enum lbBorderStyleTypes
    None = 0
    [Fixed Single]
End Enum

' Expose the control's events as a part of its
' interface.
Public Event Click()
Public Event DblClick()
Public Event KeyDown(KeyCode As Integer, Shift As Integer)
Public Event KeyPress(KeyAscii As Integer)
Public Event KeyUp(KeyCode As Integer, Shift As Integer)
Public Event MouseDown(Button As Integer, Shift As Integer, _
    X As Single, Y As Single)
Public Event MouseMove(Button As Integer, Shift As Integer, _
    X As Single, Y As Single)
Public Event MouseUp(Button As Integer, Shift As Integer, _
    X As Single, Y As Single)
Public Event StatusChanged(NewStatus As Integer)
Attribute StatusChanged.VB_Description = "Triggered if the control's status changes from selected to unselected, or vice versa."
Attribute StatusChanged.VB_MemberFlags = "200"

Private mbooButtonLighted As Boolean
Private mfonFont As StdFont
Private mmodButtonMode As lbModeTypes
Private molcBackColor As OLE_COLOR
Private molcSelColor As OLE_COLOR
Private mpicPicture As New StdPicture
Private mpicSelPicture As New StdPicture
Private mpoiCursorPos As POINTAPI

Private Sub tmrChkStatus_Timer()

    ' This event will fire about 4 times per second,
    ' and is used to see if the control's status
    ' changes from selected ("lighted") to
    ' un-selected, and vice-versa.

    Dim lonCStat As Long
    Dim lonCurrhWnd As Long

    ' Disable the timer temporarily.
    tmrChkStatus.Enabled = False

    ' Using two Windows API functions, determine the
    ' handle of the window that the cursor is
    ' currently positioned on.
    lonCStat = GetCursorPos&(mpoiCursorPos)
    lonCurrhWnd = WindowFromPoint(mpoiCursorPos.X, _
        mpoiCursorPos.Y)

    If mbooButtonLighted = False Then
        ' If the control is not currently "lighted",
        ' and it matches the handle of the window that
        ' the cursor is on, light it up (if
        ' ButtonMode = Text Only Mode) or switch its
        ' background image to the one that indicates
        ' that the button is selected.
        If lonCurrhWnd = UserControl.hWnd Then
            mbooButtonLighted = True
            If mmodButtonMode = [Text Only Mode] Then
                UserControl.BackColor = molcSelColor
            Else
                Set UserControl.Picture = mpicSelPicture
            End If
            RaiseEvent StatusChanged(1)
        End If
    Else
        ' If the control is "lit", and it no longer
        ' matches the handle of the window that the
        ' cursor is on, un-light it (if
        ' ButtonMode = Text Only Mode) or switch
        ' its background image to the one that indicates
        ' that the button is not selected.
        If lonCurrhWnd <> UserControl.hWnd Then
            mbooButtonLighted = False
            If mmodButtonMode = [Text Only Mode] Then
                UserControl.BackColor = molcBackColor
            Else
                Set UserControl.Picture = mpicPicture
            End If
            RaiseEvent StatusChanged(0)
        End If
    End If

    ' Re-enable the timer.
    tmrChkStatus.Enabled = True

End Sub

Private Sub UserControl_Click()

    ' If UserControl's Click event is triggered,
    ' LightButton's Click event is in turn raised.
    RaiseEvent Click

End Sub

Private Sub UserControl_DblClick()

    ' If UserControl's Click event is triggered,
    ' LightButton's DblClick event is in turn raised.
    RaiseEvent DblClick

End Sub

Private Sub UserControl_Initialize()

    ' When the control initializes, the button is
    ' not "lighted".
    mbooButtonLighted = False

    ' Since the control's status has just been
    ' initialized, the StatusChanged event should
    ' be raised.
    RaiseEvent StatusChanged(0)

    ' Since UserControl's BackColor property will
    ' be changed if the control is "selected", its
    ' initial value must be stored in a temporary
    ' variable.
    molcBackColor = UserControl.BackColor

End Sub

Private Sub UserControl_InitProperties()

    ' If the control's container is in design mode,
    ' disable the Timer, which causes the control to
    ' not function.
    tmrChkStatus.Enabled = Ambient.UserMode

    ' Set the default values for some properties.

    ' The Caption property defaults to the name
    ' assigned to the control by its container.
    Caption = Ambient.DisplayName

    ' The SelColor property defaults to the color
    ' yellow.
    SelColor = &H80FFFF

    ' The ButtonMode property defaults to
    ' Text Only Mode (0).
    ButtonMode = [Text Only Mode]

End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)

    ' If UserControl's KeyDown event is triggered,
    ' LightButton's KeyDown event is in turn raised
    ' and the KeyCode and Shift arguments are passed
    ' to that event.
    RaiseEvent KeyDown(KeyCode, Shift)

End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)

    ' If UserControl's KeyPress event is triggered,
    ' LightButton's KeyPress event is in turn raised,
    ' and the KeyAscii argument is passed to that
    ' event.
    RaiseEvent KeyPress(KeyAscii)

End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)

    ' If UserControl's KeyUp event is triggered,
    ' LightButton's KeyUp event is in turn raised,
    ' and the KeyCode and Shift arguments are
    ' passed to that event.
    RaiseEvent KeyUp(KeyCode, Shift)

End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

    ' If UserControl's MouseDown event is triggered,
    ' LightButton's MouseDown event is in turn raised,
    ' and the Button, Shift, X, and Y arguments are
    ' passed to that event.
    RaiseEvent MouseDown(Button, Shift, X, Y)

End Sub

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)

    ' If UserControl's MouseMove event is triggered,
    ' LightButton's MouseMove event is in turn raised,
    ' and the Button, Shift, X, and Y arguments are
    ' passed to that event.
    RaiseEvent MouseMove(Button, Shift, X, Y)

End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

    ' If UserControl's MouseUp event is triggered,
    ' LightButton's MouseUp event is in turn raised,
    ' and the Button, Shift, X, and Y arguments are
    ' passed to that event.
    RaiseEvent MouseUp(Button, Shift, X, Y)

End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    ' If the control's container is in design mode,
    ' disable the Timer, which causes the control to
    ' not function.
    tmrChkStatus.Enabled = Ambient.UserMode

    ' Get properties from the property bag.
    BackColor = PropBag.ReadProperty("BackColor", &HFFFFFF)
    BorderStyle = PropBag.ReadProperty("BorderStyle", 1)
    ButtonMode = PropBag.ReadProperty("ButtonMode", mmonButtonMode)
    Caption = PropBag.ReadProperty("Caption", Ambient.DisplayName)
    Enabled = PropBag.ReadProperty("Enabled", True)
    ForeColor = PropBag.ReadProperty("ForeColor", &H80000008)
    SelColor = PropBag.ReadProperty("SelColor", &H80FFFF)

    Set Font = PropBag.ReadProperty("Font", mfonFont)
    Set Picture = PropBag.ReadProperty("Picture", Nothing)
    Set SelPicture = PropBag.ReadProperty("SelPicture", Nothing)

End Sub

Private Sub UserControl_Resize()

    ' Reposition the Label constituent control so it
    ' is centered within the UserControl.
    lblCaption.Top = (Height - lblCaption.Height) / 2
    lblCaption.Left = (Width - lblCaption.Width) / 2

End Sub

Public Property Get Caption() As String
Attribute Caption.VB_Description = "The text that is displayed on the control. Only used if the ButtonMode property is set to Text Only Mode (0)."
Attribute Caption.VB_ProcData.VB_Invoke_Property = ";Appearance"

    ' The Caption property comes directly from
    ' lblCaption's Caption property.
    Caption = lblCaption.Caption

End Property

Public Property Let Caption(ByVal vNewValue As String)

    ' Caption's new value is passed directly to
    ' lblCaption's Caption property.
    lblCaption.Caption = vNewValue
    UserControl.PropertyChanged "Caption"

End Property

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    ' Save properties to the property bag.
    PropBag.WriteProperty "BackColor", BackColor, &HFFFFFF
    PropBag.WriteProperty "BorderStyle", BorderStyle, 1
    PropBag.WriteProperty "ButtonMode", ButtonMode, mmodButtonMode
    PropBag.WriteProperty "Caption", Caption, Ambient.DisplayName
    PropBag.WriteProperty "Enabled", Enabled, True
    PropBag.WriteProperty "ForeColor", ForeColor, &H80000008
    PropBag.WriteProperty "SelColor", SelColor, &H80FFFF

    PropBag.WriteProperty "Font", Font, mfonFont
    PropBag.WriteProperty "Picture", Picture, Nothing
    PropBag.WriteProperty "SelPicture", SelPicture, Nothing

End Sub

Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Specifies the control's background color. Only used if the ButtonMode property is set to Text Only Mode (0)."
Attribute BackColor.VB_ProcData.VB_Invoke_Property = ";Appearance"

    ' The control's BackColor property is "stored" in
    ' the UserControl object's BackColor property.
    BackColor = UserControl.BackColor

End Property

Public Property Let BackColor(ByVal NewValue As OLE_COLOR)

    ' The control's new BackColor value is passed
    ' directly to the UserControl object's BackColor
    ' property.
    UserControl.BackColor = NewValue
    UserControl.PropertyChanged "BackColor"

    ' Store the new BackColor value in a "holding"
    ' variable for later use.
    molcBackColor = NewValue

End Property

Public Property Get BorderStyle() As lbBorderStyleTypes
Attribute BorderStyle.VB_Description = "Specifies the type of border the control should have (0=None, 1=Fixed Single)."
Attribute BorderStyle.VB_ProcData.VB_Invoke_Property = ";Appearance"

    ' The control's BorderStyle property is "stored" in
    ' the UserControl object's BorderStyle property.
    BorderStyle = UserControl.BorderStyle

End Property

Public Property Let BorderStyle(ByVal NewValue As lbBorderStyleTypes)

    ' Make sure that the value being assigned to the
    ' BorderStyle property is valid.
    If NewValue = None Or NewValue = [Fixed Single] Then
        ' The control's new BorderStyle value is passed
        ' directly to the UserControl object's BorderStyle
        ' property.
        UserControl.BorderStyle = NewValue
        UserControl.PropertyChanged "BorderStyle"
    Else
        ' Invalid BorderStyle value - raise an error.
        Err.Raise Number:=vbObjectError + 32112, _
            Description:="Invalid BorderStyle value (0 or 1 only)"
    End If

End Property

Public Property Get ButtonMode() As lbModeTypes
Attribute ButtonMode.VB_Description = "Determines how the control will function. Text Only Mode (0) uses the background color to indicate the control's state, and ImageMode (1) uses images to indicate state."
Attribute ButtonMode.VB_ProcData.VB_Invoke_Property = ";Behavior"

    ' The ButtonMode property is stored in a "holding"
    ' variable, mmodButtonMode.
    ButtonMode = mmodButtonMode

End Property

Public Property Let ButtonMode(ByVal NewValue As lbModeTypes)

    ' Don't let a new value be assigned to
    ' mmodButtonMode (ButtonMode's "holding" variable)
    ' unless it is valid.
    If NewValue = [Text Only Mode] Or NewValue = [Image Mode] Then
        mmodButtonMode = NewValue
        ' If ButtonMode is Text Only Mode (0), show
        ' the lblCaption object. If ButtonMode is
        ' Image Mode (1), hide the lblCaption object.
        If mmodButtonMode = [Text Only Mode] Then lblCaption.Visible = True
        If mmodButtonMode = [Image Mode] Then lblCaption.Visible = False
        UserControl.PropertyChanged "ButtonMode"
    Else
        ' Invalid ButtonMode value - raise an error.
        Err.Raise Number:=vbObjectError + 32113, _
            Description:="Invalid ButtonMode value (0 or 1 only)"
    End If

End Property

Public Property Get Font() As StdFont
Attribute Font.VB_Description = "The font used to display the control's caption."
Attribute Font.VB_ProcData.VB_Invoke_Property = ";Font"

    ' The value for the control's Font property is
    ' "stored" in the lblCaption object's Font property.
    Set Font = lblCaption.Font

End Property

Public Property Set Font(ByVal NewValue As StdFont)

    ' Store the control's new Font value in the
    ' lblCaption object's Font property.
    Set lblCaption.Font = NewValue
    UserControl.PropertyChanged "Font"

End Property

Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "The color of the control's caption. Only used if the ButtonMode property is set to Text Only Mode (0)."
Attribute ForeColor.VB_ProcData.VB_Invoke_Property = ";Appearance"

    ' The control's ForeColor property is "stored" in
    ' lblCaption's ForeColor property.
    ForeColor = lblCaption.ForeColor

End Property

Public Property Let ForeColor(ByVal NewValue As OLE_COLOR)

    ' The control's new ForeColor value is passed
    ' directly to lblCaption's ForeColor property.
    lblCaption.ForeColor = NewValue
    UserControl.PropertyChanged "ForeColor"

End Property

Public Property Get Picture() As StdPicture
Attribute Picture.VB_Description = "The image displayed when the control is in an unselected state. Only used if the ButtonMode property is set to ImageMode (1)."
Attribute Picture.VB_ProcData.VB_Invoke_Property = ";Appearance"

    ' The control's Picture property is "stored" in
    ' the UserControl object's Picture property.
    Set Picture = UserControl.Picture

End Property

Public Property Set Picture(ByVal NewValue As StdPicture)

    ' First, change UserControl's Picture property to
    ' display the image selected.
    Set UserControl.Picture = NewValue

    ' Then store the new image in a "holding"
    ' picture object.
    Set mpicPicture = NewValue

    ' If Picture's image is Nothing, set the ButtonMode
    ' property back to Text Only Mode (0). If Picture
    ' does contain an image, set the ButtonMode
    ' property to Image Mode (1).
    If NewValue Is Nothing Then
        ButtonMode = [Text Only Mode]
    Else
        ButtonMode = [Image Mode]
    End If

    UserControl.PropertyChanged "Picture"

End Property

Public Property Get SelColor() As OLE_COLOR
Attribute SelColor.VB_Description = "The background color used to indicate that the control is in a selected state. Only used if ButtonMode property is set to Text Only Mode (0)."
Attribute SelColor.VB_ProcData.VB_Invoke_Property = ";Appearance"

    ' The control's SelColor property is stored in a
    ' "holding" variable, molcSelColor.
    SelColor = molcSelColor

End Property

Public Property Let SelColor(ByVal NewValue As OLE_COLOR)

    ' Store SelColor's new value in a "holding"
    ' variable, molcSelColor.
    molcSelColor = NewValue
    UserControl.PropertyChanged "SelColor"

End Property

Public Property Get SelPicture() As StdPicture
Attribute SelPicture.VB_Description = "The image displayed when the control is in a selected state. Only used if the ButtonMode property is set to ImageMode (1)."
Attribute SelPicture.VB_ProcData.VB_Invoke_Property = ";Appearance"

    ' SelPicture's image is retrieved from a "holding"
    ' picture object, mpicSelPicture.
    Set SelPicture = mpicSelPicture

End Property

Public Property Set SelPicture(ByVal NewValue As StdPicture)

    ' Store SelPicture's new value in a "holding"
    ' picture object, mpicSelPicture.
    Set mpicSelPicture = NewValue
    UserControl.PropertyChanged "SelPicture"

End Property

Public Property Get Enabled() As Boolean
Attribute Enabled.VB_ProcData.VB_Invoke_Property = ";Behavior"
Attribute Enabled.VB_UserMemId = -514

    Enabled = UserControl.Enabled

End Property

Public Property Let Enabled(ByVal NewValue As Boolean)

    UserControl.Enabled = NewValue
    UserControl.PropertyChanged "Enabled"

End Property

Public Sub Refresh()

    UserControl.Refresh

End Sub

Public Sub Flash(NumTimes As Integer)
Attribute Flash.VB_Description = "Used to ""flash"" the control (switch it from a selected to an unselected state) a specified number of times."

    Dim booButtonLighted As Boolean
    Dim intFlashLoop As Integer
    Dim sinOldTimer As Single

    ' If an invalid argument was passed to the
    ' method, exit now.
    If NumTimes <= 0 Then Exit Sub

    booButtonLighted = mbooButtonLighted

    For intFlashLoop = 1 To (NumTimes * 2)
        ' Switch the button's status.
        booButtonLighted = Not booButtonLighted
        If booButtonLighted = True Then
            ' Change the control's background color or
            ' image to reflect a "selected" state.
            If mmodButtonMode = [Text Only Mode] Then
                UserControl.BackColor = molcSelColor
            Else
                Set UserControl.Picture = mpicSelPicture
            End If
        Else
            ' Change the control's background color or
            ' image to reflect an "unselected" state.
            If mmodButtonMode = [Text Only Mode] Then
                UserControl.BackColor = molcBackColor
            Else
                Set UserControl.Picture = mpicPicture
            End If
        End If
        ' Wait a short amount of time before changing the
        ' control's status again.
        sinOldTimer = Timer
        Do
            DoEvents
        Loop Until (Timer >= sinOldTimer + 0.5)
    Next intFlashLoop

End Sub

Public Sub DisplayAboutBox()
Attribute DisplayAboutBox.VB_UserMemId = -552

    frmAbout.Show vbModal

End Sub