Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/axcool/axbutton.ctl

Text File | 1998-10-26 | 34.4 KB | 902 lines

VERSION 5.00
Begin VB.UserControl axCoolButton
   AutoRedraw      =   -1  'True
   CanGetFocus     =   0   'False
   ClientHeight    =   615
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2115
   DefaultCancel   =   -1  'True
   ForwardFocus    =   -1  'True
   ScaleHeight     =   41
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   141
   ToolboxBitmap   =   "axButton.ctx":0000
End
Attribute VB_Name = "axCoolButton"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'Default Property Values:
Const m_def_Style = 0
Const m_def_DropDown = False
Const m_def_MaskColor = vbButtonFace
Const m_def_PictureAlign = 2
Const m_def_Caption = ""

'Enums
Enum envbuPictureAlign
    vbPicLeft = 0
    vbPicRight = 1
    vbPicTop = 2
    vbPicBottom = 3
End Enum

'kdq 10/19/98 added new styles
Enum vbuStyle
    [Cool Button] = 0
    [Toolbar Button] = 1
    [Separator] = 2
    [Toolbar Handle] = 3
    [Standard Button] = 4
End Enum

'Property Variables:
Dim m_Style As vbuStyle
Dim m_DropDown As Boolean
Dim m_MaskColor As OLE_COLOR
Dim m_Picture As Picture
Dim m_PictureAlign As envbuPictureAlign
Dim m_Caption As String
'Event Declarations:
Event MouseEnter()
Attribute MouseEnter.VB_Description = "Fires when the mouse cursor enters the boundaries of the control."
Event MouseExit()
Attribute MouseExit.VB_Description = "Fires when the mouse leaves the boundaries of the control."
Event DropDownClick()
Attribute DropDownClick.VB_Description = "Fires whenever the Drop Down Button is Clicked."
Event Click() 'MappingInfo=UserControl,UserControl,-1,Click
Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
Event DblClick() 'MappingInfo=UserControl,UserControl,-1,DblClick
Attribute DblClick.VB_Description = "Occurs when the user presses and releases a mouse button and then presses and releases it again over an object."
Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyDown
Attribute KeyDown.VB_Description = "Occurs when the user presses a key while an object has the focus."
Event KeyPress(KeyAscii As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyPress
Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyUp
Attribute KeyUp.VB_Description = "Occurs when the user releases a key while an object has the focus."
Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown
Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp
Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."

Private mbButtonDown As Boolean
Private mbMouseDown As Boolean
Private miXOffset As Integer
Private miYOffset As Integer
Private mbHasFocus As Boolean
Private mbMouseOver As Boolean
Private mbDropDownPressed As Boolean
Private miCurrentButtonPressed As Integer
Private WithEvents ExitTimer As objTimer
Attribute ExitTimer.VB_VarHelpID = -1

Private miClientWidth As Integer
Private miClientHeight As Integer
Private miClientTop As Integer
Private miClientLeft As Integer
Private m_ButtonFace As OLE_COLOR, m_ButtonLightShadow As OLE_COLOR
Private m_ButtonDarkShadow As OLE_COLOR, m_ButtonHighlight As OLE_COLOR
Private m_DownPicture As Picture
Private m_FlatPicture As Picture, m_ShowFlatGrey As Boolean

Private Sub Leave()
    mbMouseOver = False

    Set ExitTimer = Nothing
    DrawButton

    RaiseEvent MouseExit
End Sub

Private Function UnderMouse() As Boolean
    Dim ptMouse As POINTAPI

    GetCursorPos ptMouse
    If WindowFromPoint(ptMouse.x, ptMouse.y) = UserControl.hwnd Then
        UnderMouse = True
    Else
        UnderMouse = False
    End If

End Function

Private Sub DrawButton()
    Dim iWidth As Integer
    Dim iHeight As Integer
    Dim iTextWidth As Integer, iTextHeight As Integer, iTextTop As Integer, iTextLeft As Integer
    Dim iPicWidth As Integer, iPicHeight As Integer, iPicTop As Integer, iPicLeft As Integer
    Dim iFocusOffset As Integer
    Dim clsPaint As New PaintEffects
    Dim iDownOffset As Integer
    Dim udtRect As RECT
    Dim udtTextRect As RECT
    Dim lReturn As Long
    Dim lArrowTop As Long
    Dim lArrowLeft As Long
    Dim picButton As Picture

    UserControl.Cls
    If m_DropDown Then
        iWidth = UserControl.ScaleWidth - 10
        iHeight = UserControl.ScaleHeight
    Else
        iWidth = UserControl.ScaleWidth
        iHeight = UserControl.ScaleHeight
    End If

    'These client variable describe the area
    'inside the button to draw the picture.
    'You can think of these like page margins
    'in a word processor
    miClientWidth = iWidth - 6
    miClientHeight = iHeight - 8
    miClientTop = 3
    miClientLeft = 3

    If (mbHasFocus Or UserControl.Ambient.DisplayAsDefault) And m_Style = [Standard Button] Then
        iFocusOffset = 1
        UserControl.Line (0, 0)-(UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1), vb3DDKShadow, B
    Else
        iFocusOffset = 0
    End If

    udtRect.Top = iFocusOffset
    udtRect.Left = iFocusOffset
    udtRect.Right = iWidth - iFocusOffset - IIf(iFocusOffset = 1, 1, 0)
    udtRect.Bottom = iHeight - iFocusOffset - IIf(iFocusOffset = 1, 1, 0)

    'kdq 10/19/98 added DrawShadowBox for new styles of buttons. Coolbutton should
    'have thinner border than a regular button
    Select Case m_Style
    Case [Cool Button]
        If mbMouseOver Or miCurrentButtonPressed > -1 Then
            If mbButtonDown Then
                'Draw Button Down State
                DrawShadowBox udtRect, True, False
                'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED)
                iDownOffset = 1
            Else
                'Draw Button Up State
                DrawShadowBox udtRect, False, False
                'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH)
                iDownOffset = 0
            End If
        End If

    Case [Toolbar Button]
        If mbButtonDown Then
            'Draw Button Down State
            DrawShadowBox udtRect, True, False
            'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED)
            iDownOffset = 1
        Else
            'Draw Button Up State
            DrawShadowBox udtRect, False, False
            'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH)
            iDownOffset = 0
        End If

    Case [Standard Button]
        If mbButtonDown Then
            'Draw Button Down State
            DrawShadowBox udtRect, True, True
            'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED)
            iDownOffset = 1
        Else
            'Draw Button Up State
            DrawShadowBox udtRect, False, True
            'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH)
            iDownOffset = 0
        End If

    Case [Separator]
        Line (0, 0)-(ScaleWidth, ScaleHeight), BackColor, BF
        DrawVLine ScaleWidth \ 2 - 1, 0, 2, ScaleHeight

    Case [Toolbar Handle]
        Line (0, 0)-(ScaleWidth, ScaleHeight), BackColor, BF
        DrawRaisedVLine ScaleWidth \ 2 - 4, 0, 3, ScaleHeight
        DrawRaisedVLine ScaleWidth \ 2, 0, 3, ScaleHeight

    End Select

    'Draw the DropDown button
    If m_DropDown Then
        udtRect.Top = iFocusOffset
        udtRect.Left = iWidth '- iFocusOffset
        udtRect.Right = 10 - iFocusOffset
        udtRect.Bottom = iHeight - iFocusOffset - IIf(iFocusOffset = 1, 1, 0)
        Select Case m_Style
        Case [Cool Button]   'Soft Button
            If mbMouseOver Or miCurrentButtonPressed > -1 Then
                If mbDropDownPressed Then
                    'Draw Button Down State
                    DrawShadowBox udtRect, True, False
                    'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED)
                    iDownOffset = 0
                Else
                    'Draw Button Up State
                    DrawShadowBox udtRect, False, False
                    'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH)
                End If
            End If
        Case [Toolbar Button], [Standard Button]       'toolbar, standard
            If mbDropDownPressed Then
                'Draw Button Down State
                DrawShadowBox udtRect, True, True
                'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED)
                iDownOffset = 0
            Else
                'Draw Button Up State
                DrawShadowBox udtRect, False, True
                'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH)
            End If
        End Select
    End If

    'Draw the Dropdown arrow
    If m_DropDown And (m_Style = [Cool Button] Or m_Style = [Toolbar Button] Or m_Style = [Standard Button]) Then
        lArrowTop = (UserControl.ScaleHeight / 2) '- 2
        lArrowLeft = iWidth + 1 - iFocusOffset
        UserControl.Line ((lArrowLeft) + 1, lArrowTop)-((lArrowLeft) + 6, lArrowTop), vbBlack
        UserControl.Line ((lArrowLeft) + 2, lArrowTop + 1)-((lArrowLeft) + 5, lArrowTop + 1), vbBlack
        UserControl.Line ((lArrowLeft) + 3, lArrowTop + 2)-((lArrowLeft) + 4, lArrowTop + 2), vbBlack
    End If
    'Draw The Button Face

    'Get the Caption Width and Height
    iTextWidth = UserControl.TextWidth(m_Caption)
    iTextHeight = UserControl.TextHeight(m_Caption)

    'kdq 10/19/98
    'figure out which picture to display
    If mbMouseOver And mbMouseDown And Not m_DownPicture Is Nothing And m_Style = [Cool Button] Then
      Set picButton = m_DownPicture
    ElseIf Not mbMouseOver And Not m_FlatPicture Is Nothing And m_Style = [Cool Button] Then
      Set picButton = m_FlatPicture
    Else
      Set picButton = m_Picture
    End If

    If Not picButton Is Nothing And m_Caption > "" Then
        'Get the Pictures Width and Height
        iPicWidth = ScaleX(picButton.Width, vbHimetric, vbPixels)
        iPicHeight = ScaleY(picButton.Height, vbHimetric, vbPixels)

        'Set locations for the Picture and the Caption
        Select Case m_PictureAlign
        Case vbPicLeft
            iPicLeft = miClientLeft
            iPicTop = miClientTop + (miClientHeight / 2) - (iPicHeight / 2) + 1
            udtTextRect.Top = miClientTop
            udtTextRect.Bottom = miClientTop + miClientHeight
            udtTextRect.Left = miClientLeft + iPicWidth
            udtTextRect.Right = miClientLeft + miClientWidth
        Case vbPicRight
            iPicLeft = miClientLeft + miClientWidth - iPicWidth
            iPicTop = miClientTop + (miClientHeight / 2) - (iPicHeight / 2) + 1
            udtTextRect.Top = miClientTop
            udtTextRect.Bottom = miClientTop + miClientHeight
            udtTextRect.Left = miClientLeft ' + iPicWidth
            udtTextRect.Right = miClientLeft + miClientWidth - iPicWidth
        Case vbPicTop
            iPicLeft = miClientLeft + (miClientWidth / 2) - (iPicWidth / 2) + 1
            iPicTop = miClientTop
            udtTextRect.Top = miClientTop + iPicHeight + iPicTop
            udtTextRect.Bottom = miClientTop + miClientHeight
            udtTextRect.Left = miClientLeft
            udtTextRect.Right = miClientLeft + miClientWidth
        Case vbPicBottom
            iPicLeft = miClientLeft + (miClientWidth / 2) - (iPicWidth / 2) + 1
            iPicTop = miClientTop + miClientHeight - iPicHeight
            udtTextRect.Top = miClientTop
            udtTextRect.Bottom = miClientTop + miClientHeight - iPicHeight
            udtTextRect.Left = miClientLeft
            udtTextRect.Right = miClientLeft + miClientWidth
        End Select
    'kdq 10/19/98 center picture if no caption
    ElseIf Not picButton Is Nothing And m_Caption = "" Then
            'Get the Pictures Width and Height
            iPicWidth = ScaleX(picButton.Width, vbHimetric, vbPixels)
            iPicHeight = ScaleY(picButton.Height, vbHimetric, vbPixels)
            iPicLeft = miClientLeft + (miClientWidth / 2) - (iPicWidth / 2)
            iPicTop = miClientTop + (miClientHeight / 2) - (iPicHeight / 2) + 1
            udtTextRect.Top = miClientTop
            udtTextRect.Bottom = miClientTop + miClientHeight
            udtTextRect.Left = miClientLeft
            udtTextRect.Right = miClientLeft + miClientWidth
    'kdq 10/19/98 center caption if not picture
    ElseIf picButton Is Nothing And m_Caption > "" Then
            udtTextRect.Top = miClientTop
            udtTextRect.Bottom = miClientTop + miClientHeight
            udtTextRect.Left = miClientLeft
            udtTextRect.Right = miClientLeft + miClientWidth
    End If

    '10/19/98 kdq the rect values were changed so Standard buttom displays correctly when it has focus
    'Draw The Dotted Focus lines, but not for the soft button
    If m_Style = [Standard Button] Then
        If mbHasFocus Then
            udtRect.Top = udtTextRect.Top    'iTextTop - 1
            udtRect.Left = udtTextRect.Left + 1 'iTextLeft - 1
            udtRect.Right = udtTextRect.Right - 1 'iTextLeft + iTextWidth + 1
            udtRect.Bottom = udtTextRect.Bottom + 1 'iTextTop + iTextHeight + 1
            lReturn = DrawFocusRect(UserControl.hdc, udtRect)
        Else
            UserControl.DrawWidth = 2
            UserControl.Line (miClientLeft - 1, miClientTop - 1)-(miClientLeft + miClientWidth, miClientTop + miClientHeight), vb3DFace, B
            UserControl.DrawWidth = 1
        End If
    End If

    'Draw the Picture
    If Not picButton Is Nothing And (m_Style = [Cool Button] Or m_Style = [Toolbar Button] Or m_Style = [Standard Button]) Then
        If UserControl.Enabled Then
            'kdq 10/19/98 added GreyScaling for Coolbutton when mouse is not over it (user defined)
            If m_Style = [Cool Button] And Not mbMouseOver And m_ShowFlatGrey Then
               'clsPaint.PaintGreyScaleCornerStdPic UserControl.hdc, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0, m_MaskColor
               clsPaint.PaintGreyScaleStdPic UserControl.hdc, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0
            Else
               'clsPaint.PaintTransparentStdPic UserControl.hdc, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0, m_MaskColor
               clsPaint.PaintNormalStdPic UserControl.hdc, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0
            End If
        Else
            clsPaint.PaintDisabledStdPic UserControl.hdc, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0, m_MaskColor
        End If
    End If

    'Print the caption on the button
    If m_Style = [Cool Button] Or m_Style = [Toolbar Button] Or m_Style = [Standard Button] Then
        udtTextRect.Top = udtTextRect.Top + iDownOffset ' + (udtTextRect.Top Mod 2)
        udtTextRect.Left = udtTextRect.Left + iDownOffset ' + (udtTextRect.Left Mod 2)
        udtTextRect.Bottom = udtTextRect.Bottom + iDownOffset
        udtTextRect.Right = udtTextRect.Right + iDownOffset
        If UserControl.Enabled Then
            lReturn = DrawText(UserControl.hdc, m_Caption, Len(m_Caption), udtTextRect, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER)
        Else
            UserControl.ForeColor = vbGrayText
            lReturn = DrawText(UserControl.hdc, m_Caption, Len(m_Caption), udtTextRect, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER)
            UserControl.ForeColor = vbButtonText
        End If
    End If

    Refresh
    Set clsPaint = Nothing
    Set picButton = Nothing
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
Attribute BackColor.VB_UserMemId = -501
    BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    UserControl.BackColor() = New_BackColor
    PropertyChanged "BackColor"
    DrawButton
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,ForeColor
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
    ForeColor = UserControl.ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    UserControl.ForeColor() = New_ForeColor
    PropertyChanged "ForeColor"
    DrawButton
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Enabled
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
    Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
    UserControl.Enabled() = New_Enabled
    PropertyChanged "Enabled"
    DrawButton
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Font
Public Property Get Font() As Font
Attribute Font.VB_Description = "Returns a Font object."
Attribute Font.VB_UserMemId = -512
    Set Font = UserControl.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set UserControl.Font = New_Font
    PropertyChanged "Font"
    DrawButton
End Property


'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Refresh
Public Sub Refresh()
Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
    UserControl.Refresh
End Sub

Private Sub ExitTimer_Timer()
    If Not UnderMouse Then Leave
End Sub

Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
    'kdq 10/19/98 only Click when control is a button
    If m_Style <> [Separator] And m_Style <> [Toolbar Handle] Then RaiseEvent Click
End Sub

Private Sub UserControl_AmbientChanged(PropertyName As String)
    If PropertyName = "DisplayAsDefault" Then
        DrawButton
    End If
End Sub

Private Sub UserControl_DblClick()
    RaiseEvent DblClick
End Sub

Private Sub UserControl_EnterFocus()
    mbHasFocus = True
    DrawButton
End Sub

Private Sub UserControl_ExitFocus()
    mbHasFocus = False
    DrawButton
    Refresh
End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 32 Then
      miCurrentButtonPressed = 0
      mbButtonDown = True
      DrawButton
    End If
    RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    If KeyCode = 32 Then
      miCurrentButtonPressed = -1
      mbButtonDown = False
      DrawButton
      'kdq 10/19/98 only Click when control is a button
      If m_Style <> [Separator] And m_Style <> [Toolbar Handle] Then RaiseEvent Click
    End If
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub UserControl_LostFocus()
    mbHasFocus = False
    DrawButton
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
    If m_DropDown Then
        If x > (UserControl.ScaleWidth - 11) Then
            mbDropDownPressed = True
            miCurrentButtonPressed = 1
        Else
            mbButtonDown = True
            miCurrentButtonPressed = 0
        End If
    Else
        mbButtonDown = True
        miCurrentButtonPressed = 0
    End If
    mbMouseDown = True
    DrawButton
    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 Button = 1 Then
        If (x < 0 Or y < 0 Or x >= UserControl.ScaleWidth Or y >= UserControl.ScaleHeight) Then
            If miCurrentButtonPressed = 0 Then
                mbButtonDown = False
            Else
                mbDropDownPressed = False
            End If
            DrawButton
        Else
            If miCurrentButtonPressed = 0 Then
                mbButtonDown = True
            Else
                mbDropDownPressed = True
            End If
            DrawButton
        End If
    End If

    If mbMouseOver Then
        If Not UnderMouse Then
            Leave
        End If
    Else
        If UnderMouse Then
            mbMouseOver = True
            RaiseEvent MouseEnter
            DrawButton

            'Set up the ExitTimer
            Set ExitTimer = New objTimer
            ExitTimer.Interval = 50
            ExitTimer.Enabled = True
        End If
    End If
    RaiseEvent MouseMove(Button, Shift, x, y)
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim bOverButton As Boolean

    RaiseEvent MouseUp(Button, Shift, x, y)

    'Check the position of the mouse when in was released.
    'We only want to call the click events when the
    'mouse was released over the button.
    If (x < 0 Or y < 0 Or x >= UserControl.ScaleWidth Or y >= UserControl.ScaleHeight) Then
        bOverButton = False
    Else
        bOverButton = True
    End If

    If miCurrentButtonPressed = 1 Then
        If bOverButton And x > (UserControl.ScaleWidth - 10) Then
            RaiseEvent DropDownClick
        End If
    End If
    mbButtonDown = False
    mbDropDownPressed = False
    mbMouseDown = False
    DrawButton
    If miCurrentButtonPressed = 0 Then
        If bOverButton And x < (UserControl.ScaleWidth - 10) And m_DropDown Then
                'kdq 10/19/98 only Click when control is a button
                If m_Style <> [Separator] And m_Style <> [Toolbar Handle] Then RaiseEvent Click
        'kdq 10/19/98 added this because click event wasnt firing for nondropdown buttons all the time
        ElseIf bOverButton And Not m_DropDown Then
                'kdq 10/19/98 only Click when control is a button
                If m_Style <> [Separator] And m_Style <> [Toolbar Handle] Then RaiseEvent Click
        End If
    End If
    miCurrentButtonPressed = -1
    DrawButton
End Sub


'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=11,0,0,0
Public Property Get Picture() As Picture
Attribute Picture.VB_Description = "Image to be displayed on the button."
    Set Picture = m_Picture
End Property

Public Property Set Picture(ByVal New_Picture As Picture)
    Set m_Picture = New_Picture
    PropertyChanged "Picture"
    DrawButton
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get PictureAlign() As envbuPictureAlign
Attribute PictureAlign.VB_Description = "Specifies alignment of the picture property."
    PictureAlign = m_PictureAlign
End Property

Public Property Let PictureAlign(ByVal New_PictureAlign As envbuPictureAlign)
    m_PictureAlign = New_PictureAlign
    PropertyChanged "PictureAlign"
    DrawButton
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,
Public Property Get Caption() As String
Attribute Caption.VB_Description = "Text displayed on the face of the button."
Attribute Caption.VB_UserMemId = -518
    Caption = m_Caption
End Property

Public Property Let Caption(ByVal New_Caption As String)
    m_Caption = New_Caption
    PropertyChanged "Caption"
    SetAccessKey
    DrawButton
End Property
Private Sub SetAccessKey()
    Dim iPos As Integer
    Dim sChar As String

    iPos = InStr(1, m_Caption, "&")
    If iPos > 0 Then
        sChar = Mid$(m_Caption, iPos + 1, 1)
        If sChar <> "&" Then
            UserControl.AccessKeys = LCase(sChar)
        End If
    End If
End Sub
'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    Set UserControl.Font = Ambient.Font
    Set m_Picture = LoadPicture("")
    m_PictureAlign = m_def_PictureAlign
    m_Caption = m_def_Caption
    m_MaskColor = m_def_MaskColor
    m_Style = m_def_Style
    m_DropDown = m_def_DropDown
    m_ButtonFace = vbButtonFace
    m_ButtonLightShadow = vbButtonShadow
    m_ButtonDarkShadow = vb3DDKShadow
    m_ButtonHighlight = vb3DHighlight
    m_ShowFlatGrey = False

    miCurrentButtonPressed = -1
    mbMouseOver = False
    mbButtonDown = False
    mbMouseDown = False
    mbHasFocus = False
    mbDropDownPressed = False
End Sub

Private Sub UserControl_Paint()
    DrawButton
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
    UserControl.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
    UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
    Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
'    UserControl.BackStyle = PropBag.ReadProperty("BackStyle", 1)
'    UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
    Set m_Picture = PropBag.ReadProperty("Picture", Nothing)
    Set m_DownPicture = PropBag.ReadProperty("DownPicture", Nothing)
    Set m_FlatPicture = PropBag.ReadProperty("FlatPicture", Nothing)
    m_PictureAlign = PropBag.ReadProperty("PictureAlign", m_def_PictureAlign)
    m_Caption = PropBag.ReadProperty("Caption", m_def_Caption)
    m_MaskColor = PropBag.ReadProperty("MaskColor", &HC0C0C0)
    m_Style = PropBag.ReadProperty("Style", m_def_Style)
    m_DropDown = PropBag.ReadProperty("DropDown", m_def_DropDown)
    m_ButtonDarkShadow = PropBag.ReadProperty("ColorDarkShadow", vb3DDKShadow)
    m_ButtonLightShadow = PropBag.ReadProperty("ColorLightShadow", vbButtonShadow)
    m_ButtonHighlight = PropBag.ReadProperty("ColorHighlight", vb3DHighlight)
    m_ShowFlatGrey = PropBag.ReadProperty("ShowFlatGrey", False)
    SetAccessKey
    miCurrentButtonPressed = -1
    DrawButton
End Sub

Private Sub UserControl_Resize()
    DrawButton
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)

    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
    Call PropBag.WriteProperty("ForeColor", UserControl.ForeColor, &H80000012)
    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
    Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
'    Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 1)
'    Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 0)
    Call PropBag.WriteProperty("Picture", m_Picture, Nothing)
    Call PropBag.WriteProperty("DownPicture", m_DownPicture, Nothing)
    Call PropBag.WriteProperty("FlatPicture", m_FlatPicture, Nothing)
    Call PropBag.WriteProperty("PictureAlign", m_PictureAlign, m_def_PictureAlign)
    Call PropBag.WriteProperty("Caption", m_Caption, m_def_Caption)
    Call PropBag.WriteProperty("MaskColor", m_MaskColor, &HC0C0C0)
    Call PropBag.WriteProperty("Style", m_Style, m_def_Style)
    Call PropBag.WriteProperty("DropDown", m_DropDown, m_def_DropDown)
    Call PropBag.WriteProperty("ColorDarkShadow", m_ButtonDarkShadow, vb3DDKShadow)
    Call PropBag.WriteProperty("ColorLightShadow", m_ButtonLightShadow, vbButtonShadow)
    Call PropBag.WriteProperty("ColorHighlight", m_ButtonHighlight, vb3DHighlight)
    Call PropBag.WriteProperty("ShowFlatGrey", m_ShowFlatGrey, False)
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=10,0,0,0
Public Property Get MaskColor() As OLE_COLOR
    MaskColor = m_MaskColor
End Property

Public Property Let MaskColor(ByVal New_MaskColor As OLE_COLOR)
    m_MaskColor = New_MaskColor
    PropertyChanged "MaskColor"
    DrawButton
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=7,0,0,0
Public Property Get Style() As vbuStyle
Attribute Style.VB_Description = "Gets/Sets the style of the button"
    Style = m_Style
End Property

Public Property Let Style(ByVal New_Style As vbuStyle)
    m_Style = New_Style
    PropertyChanged "Style"
    DrawButton
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,False
Public Property Get DropDown() As Boolean
Attribute DropDown.VB_Description = "Determines whether or not to display the Drop Down Button."
    DropDown = m_DropDown
End Property

Public Property Let DropDown(ByVal New_DropDown As Boolean)
    m_DropDown = New_DropDown
    PropertyChanged "DropDown"
    DrawButton
End Property

'kdq 10/19/98 added for seperator/handle
Private Sub DrawVLine(ByVal x As Single, ByVal y As Single, ByVal cx As Single, ByVal cy As Single)
    Line (x + 1, y)-(x + 1, y + cy), m_ButtonHighlight
    Line (x, y)-(x, y + cy), m_ButtonLightShadow
End Sub

'kdq 10/19/98 added for seperator/handle
Private Sub DrawRaisedVLine(ByVal x As Single, ByVal y As Single, ByVal cx As Single, ByVal cy As Single)
    Line (x, y)-(x, y + cy), m_ButtonHighlight
    Line (x + 1, y)-(x + 1, y + cy), m_ButtonHighlight
    Line (x + 2, y)-(x + 2, y + cy), m_ButtonHighlight
    Line (x, y + 1)-(x, y + cy), m_ButtonLightShadow
    Line (x + 1, y + 1)-(x + 1, y + cy), m_ButtonLightShadow
    Line (x + 2, y + 1)-(x + 2, y + cy), m_ButtonLightShadow
    Line (x, y)-(x, y + cy - 1), m_ButtonHighlight
    Line (x + 1, y + 1)-(x + 1, y + cy - 1), m_ButtonFace
End Sub

'kdq 10/19/98 added to make thinner border for CoolButton
Private Sub DrawShadowBox(RectSize As RECT, ByVal Pressed As Boolean, ByVal DKShadow As Boolean)
    Dim x As Integer, y As Integer, cx As Integer, cy As Integer
    x = RectSize.Left
    y = RectSize.Top
    cx = RectSize.Right
    cy = RectSize.Bottom

    If DKShadow Then
        If Pressed Then
            Line (x, y)-(x + cx - 1, y), m_ButtonDarkShadow
            Line (x, y)-(x, y + cy - 1), m_ButtonDarkShadow
            Line (x + 1, y + 1)-(x + cx - 2, y + 1), m_ButtonLightShadow
            Line (x + 1, y + 1)-(x + 1, y + cy - 2), m_ButtonLightShadow
            Line (x + cx - 1, y)-(x + cx - 1, y + cy), m_ButtonHighlight
            Line (x, y + cy - 1)-(x + cx, y + cy - 1), m_ButtonHighlight
        Else
            Line (x, y)-(x + cx - 1, y), m_ButtonHighlight
            Line (x, y)-(x, y + cy - 1), m_ButtonHighlight
            Line (x + cx - 2, y + 1)-(x + cx - 2, y + cy - 1), m_ButtonLightShadow
            Line (x + 1, y + cy - 2)-(x + cx - 1, y + cy - 2), m_ButtonLightShadow
            Line (x + cx - 1, y)-(x + cx - 1, y + cy), m_ButtonDarkShadow
            Line (x, y + cy - 1)-(x + cx, y + cy - 1), m_ButtonDarkShadow
        End If
    Else
        Dim Color1 As Long
        Dim Color2 As Long
        If Pressed Then
            Color1 = m_ButtonLightShadow
            Color2 = m_ButtonHighlight
        Else
            Color1 = m_ButtonHighlight
            Color2 = m_ButtonLightShadow
        End If
        Line (x, y)-(x + cx - 1, y), Color1
        Line (x, y)-(x, y + cy - 1), Color1
        Line (x + cx - 1, y)-(x + cx - 1, y + cy), Color2
        Line (x, y + cy - 1)-(x + cx, y + cy - 1), Color2
    End If
End Sub

Public Property Get ColorLightShadow() As OLE_COLOR
    ColorLightShadow = m_ButtonLightShadow
End Property

Public Property Let ColorLightShadow(ByVal New_Value As OLE_COLOR)
    If Not (m_ButtonLightShadow = New_Value) Then
        m_ButtonLightShadow = New_Value
        DrawButton
    End If
    PropertyChanged "ColorLightShadow"
End Property

'kdq 10/19/98
Public Property Get ColorDarkShadow() As OLE_COLOR
    ColorDarkShadow = m_ButtonDarkShadow
End Property

Public Property Let ColorDarkShadow(ByVal New_Value As OLE_COLOR)
    If Not (m_ButtonDarkShadow = New_Value) Then
        m_ButtonDarkShadow = New_Value
        DrawButton
    End If
    PropertyChanged "ColorDarkShadow"
End Property

'kdq 10/19/98
Public Property Get ColorHighlight() As OLE_COLOR
    ColorHighlight = m_ButtonHighlight
End Property

Public Property Let ColorHighlight(ByVal New_Value As OLE_COLOR)
    If Not (m_ButtonHighlight = New_Value) Then
        m_ButtonHighlight = New_Value
        DrawButton
    End If
    PropertyChanged "ColorHighlight"
End Property

'kdq 10/19/98
Public Sub ShowAbout()
Attribute ShowAbout.VB_UserMemId = -552
    frmAbout.Show vbModal
End Sub

'kdq 10/19/98 picture to display when mousedown on cool button
Public Property Get DownPicture() As Picture
    Set DownPicture = m_DownPicture
End Property

Public Property Set DownPicture(ByVal New_DownPicture As Picture)
    Set m_DownPicture = New_DownPicture
    PropertyChanged "DownPicture"
End Property

'kdq 10/19/98 picture to display when mouse is not over button on cool button
Public Property Get FlatPicture() As Picture
    Set FlatPicture = m_FlatPicture
End Property

Public Property Set FlatPicture(ByVal New_FlatPicture As Picture)
    Set m_FlatPicture = New_FlatPicture
    DrawButton
    PropertyChanged "FlatPicture"
End Property

'kdq 10/19/98 display picture as greyscale when mouse is not over Cool Button
Public Property Get ShowFlatGrey() As Boolean
    ShowFlatGrey = m_ShowFlatGrey
End Property

Public Property Let ShowFlatGrey(ByVal New_Value As Boolean)
    m_ShowFlatGrey = New_Value
    PropertyChanged "DropDown"
    DrawButton
End Property