home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / axbutton / axbutton.ctl < prev    next >
Encoding:
Visual Basic user-defined control file  |  1999-03-12  |  48.8 KB  |  1,245 lines

  1. VERSION 5.00
  2. Begin VB.UserControl axButton 
  3.    AutoRedraw      =   -1  'True
  4.    ClientHeight    =   615
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   2115
  8.    DefaultCancel   =   -1  'True
  9.    ScaleHeight     =   41
  10.    ScaleMode       =   3  'Pixel
  11.    ScaleWidth      =   141
  12.    ToolboxBitmap   =   "axButton.ctx":0000
  13. End
  14. Attribute VB_Name = "axButton"
  15. Attribute VB_GlobalNameSpace = False
  16. Attribute VB_Creatable = True
  17. Attribute VB_PredeclaredId = False
  18. Attribute VB_Exposed = True
  19. Option Explicit
  20. 'Default Property Values:
  21. Const m_def_Style = 0
  22. Const m_def_DropDown = False
  23. Const m_def_MaskColor = vbButtonFace
  24. Const m_def_PictureAlign = 2
  25. Const m_def_Caption = ""
  26. Const m_def_ButtonGroup = ""
  27. Const m_def_ButtonGroupDefault = False
  28. Const m_def_ButtonGroupDefault2 = False
  29.  
  30. 'Enums
  31. Enum envbuPictureAlign
  32.     vbPicLeft = 0
  33.     vbPicRight = 1
  34.     vbPicTop = 2
  35.     vbPicBottom = 3
  36. End Enum
  37.  
  38. 'kdq 10/19/98 added new styles
  39. Enum vbuStyle
  40.     [Cool Button] = 0
  41.     [Toolbar Button] = 1
  42.     [Seperator] = 2
  43.     [SeperatorH] = 3
  44.     [Toolbar Handle] = 4
  45.     [Toolbar HandleH] = 5
  46.     [Standard Button] = 6
  47.     [Up-Down Button] = 7
  48. End Enum
  49.  
  50. 'Property Variables:
  51. Dim HaveCapture As Boolean
  52. Dim PaintedUp As Boolean
  53. Dim m_Style As vbuStyle
  54. Dim m_DropDown As Boolean
  55. Dim m_MaskColor As OLE_COLOR
  56. Dim m_Picture As Picture
  57. Dim m_PictureAlign As envbuPictureAlign
  58. Dim m_Caption As String
  59. Dim m_Value As Boolean
  60. Dim m_ButtonGroupDefault As Boolean
  61. Dim m_ButtonGroupDefault2 As Boolean
  62. Dim m_ButtonGroup As String
  63. Private hUpDownDitherBrush As Long
  64. Private UpDownButtonFace As Long
  65.  
  66. 'Event Declarations:
  67. Event MouseEnter()
  68. Attribute MouseEnter.VB_Description = "Fires when the mouse cursor enters the boundaries of the control."
  69. Event MouseExit()
  70. Attribute MouseExit.VB_Description = "Fires when the mouse leaves the boundaries of the control."
  71. Event DropDownClick()
  72. Attribute DropDownClick.VB_Description = "Fires whenever the Drop Down Button is Clicked."
  73. Event Click() 'MappingInfo=UserControl,UserControl,-1,Click
  74. Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
  75. Event DblClick() 'MappingInfo=UserControl,UserControl,-1,DblClick
  76. Attribute DblClick.VB_Description = "Occurs when the user presses and releases a mouse button and then presses and releases it again over an object."
  77. Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyDown
  78. Attribute KeyDown.VB_Description = "Occurs when the user presses a key while an object has the focus."
  79. Event KeyPress(KeyAscii As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyPress
  80. Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
  81. Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyUp
  82. Attribute KeyUp.VB_Description = "Occurs when the user releases a key while an object has the focus."
  83. Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown
  84. Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
  85. Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
  86. Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
  87. Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp
  88. Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
  89.  
  90. Private mbButtonDown As Boolean
  91. Private mbMouseDown As Boolean
  92. Private miXOffset As Integer
  93. Private miYOffset As Integer
  94. Private mbHasFocus As Boolean
  95. Private mbMouseOver As Boolean
  96. Private mbDropDownPressed As Boolean
  97. Private miCurrentButtonPressed As Integer
  98. Private WithEvents ExitTimer As objTimer
  99. Attribute ExitTimer.VB_VarHelpID = -1
  100.  
  101. Private miClientWidth As Integer
  102. Private miClientHeight As Integer
  103. Private miClientTop As Integer
  104. Private miClientLeft As Integer
  105. Private m_ButtonFace As OLE_COLOR, m_ButtonLightShadow As OLE_COLOR
  106. Private m_ButtonDarkShadow As OLE_COLOR, m_ButtonHighlight As OLE_COLOR
  107. Private m_DownPicture As Picture, m_DisabledPicture As Picture
  108. Private m_FlatPicture As Picture, m_ShowFlatGrey As Boolean
  109.  
  110. Private Sub Leave()
  111.     mbMouseOver = False
  112.     
  113.     Set ExitTimer = Nothing
  114.     DrawButton
  115.     
  116.     RaiseEvent MouseExit
  117. End Sub
  118.  
  119. Private Function UnderMouse() As Boolean
  120.     Dim ptMouse As POINTAPI
  121.  
  122.     GetCursorPos ptMouse
  123.     If WindowFromPoint(ptMouse.x, ptMouse.y) = UserControl.hWnd Then
  124.         UnderMouse = True
  125.     Else
  126.         UnderMouse = False
  127.     End If
  128.  
  129. End Function
  130.  
  131. Private Sub DrawButton()
  132.     Dim iWidth As Integer
  133.     Dim iHeight As Integer
  134.     Dim iTextWidth As Integer, iTextHeight As Integer, iTextTop As Integer, iTextLeft As Integer
  135.     Dim iPicWidth As Integer, iPicHeight As Integer, iPicTop As Integer, iPicLeft As Integer
  136.     Dim iFocusOffset As Integer
  137.     Dim clsPaint As New PaintEffects
  138.     Dim iDownOffset As Integer
  139.     Dim udtRect As RECT
  140.     Dim udtTextRect As RECT
  141.     Dim lReturn As Long
  142.     Dim lArrowTop As Long
  143.     Dim lArrowLeft As Long
  144.     Dim picButton As Picture
  145.     Dim ret As Integer
  146.     Dim xPixels As Long, yPixels As Long
  147.     
  148.     UserControl.Cls
  149.     If m_DropDown Then
  150.         iWidth = UserControl.ScaleWidth - 10
  151.         iHeight = UserControl.ScaleHeight
  152.     Else
  153.         iWidth = UserControl.ScaleWidth
  154.         iHeight = UserControl.ScaleHeight
  155.     End If
  156.     
  157.     'These client variable describe the area
  158.     'inside the button to draw the picture.
  159.     'You can think of these like page margins
  160.     'in a word processor
  161.     miClientWidth = iWidth - 6
  162.     miClientHeight = iHeight - 8
  163.     miClientTop = 3
  164.     miClientLeft = 3
  165.     
  166.     'If (mbHasFocus Or UserControl.Ambient.DisplayAsDefault) And m_Style = [Standard Button] Then
  167.     If mbHasFocus And m_Style = [Standard Button] Then
  168.         iFocusOffset = 1
  169.         UserControl.Line (0, 0)-(UserControl.ScaleWidth - 1, UserControl.ScaleHeight - 1), vb3DDKShadow, B
  170.     Else
  171.         iFocusOffset = 0
  172.     End If
  173.     
  174.     udtRect.Top = iFocusOffset
  175.     udtRect.Left = iFocusOffset
  176.     udtRect.Right = iWidth - iFocusOffset - IIf(iFocusOffset = 1, 1, 0)
  177.     udtRect.Bottom = iHeight - iFocusOffset - IIf(iFocusOffset = 1, 1, 0)
  178.     
  179.     'kdq 10/19/98 added DrawShadowBox for new styles of buttons. Coolbutton should
  180.     'have thinner border than a regular button
  181.     Select Case m_Style
  182.     Case [Cool Button]
  183.         If mbMouseOver Or miCurrentButtonPressed > -1 Then
  184.             If mbButtonDown Then
  185.                 'Draw Button Down State
  186.                 DrawShadowBox udtRect, True, False
  187.                 'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED)
  188.                 iDownOffset = 1
  189.             Else
  190.                 'Draw Button Up State
  191.                 DrawShadowBox udtRect, False, False
  192.                 'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH)
  193.                 iDownOffset = 0
  194.             End If
  195.         End If
  196.  
  197.     Case [Toolbar Button]
  198.         If mbButtonDown Then
  199.             'Draw Button Down State
  200.             DrawShadowBox udtRect, True, False
  201.             'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED)
  202.             iDownOffset = 1
  203.         Else
  204.             'Draw Button Up State
  205.             DrawShadowBox udtRect, False, False
  206.             'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH)
  207.             iDownOffset = 0
  208.         End If
  209.     
  210.     Case [Standard Button]
  211.         If mbButtonDown Then
  212.             'Draw Button Down State
  213.             DrawShadowBox udtRect, True, True
  214.             'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED)
  215.             iDownOffset = 1
  216.         Else
  217.             'Draw Button Up State
  218.             DrawShadowBox udtRect, False, True
  219.             'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH)
  220.             iDownOffset = 0
  221.         End If
  222.     
  223.     Case [Seperator]
  224.         Line (0, 0)-(ScaleWidth, ScaleHeight), BackColor, BF
  225.         DrawVLine ScaleWidth \ 2 - 1, 0, 2, ScaleHeight
  226.     
  227.     Case [SeperatorH]
  228.         Line (0, 0)-(ScaleWidth, ScaleHeight), BackColor, BF
  229.         DrawHLine 0, ScaleHeight \ 2 - 1, ScaleWidth, 2
  230.     
  231.     Case [Toolbar Handle]
  232.         Line (0, 0)-(ScaleWidth, ScaleHeight), BackColor, BF
  233.         DrawRaisedVLine ScaleWidth \ 2 - 4, 0, 3, ScaleHeight
  234.         DrawRaisedVLine ScaleWidth \ 2, 0, 3, ScaleHeight
  235.     
  236.     Case [Toolbar HandleH]
  237.         Line (0, 0)-(ScaleWidth, ScaleHeight), BackColor, BF
  238.         DrawRaisedHLine 0, ScaleHeight \ 2 - 4, ScaleWidth, 3
  239.         DrawRaisedHLine 0, ScaleHeight \ 2, ScaleWidth, 3
  240.     
  241.     Case [Up-Down Button]
  242.         If m_Value Then
  243.           If mbMouseOver Then
  244.             PaintUpDownDither 1, 1, ScaleWidth - 2, ScaleHeight - 2
  245.             DrawShadowBox udtRect, True, False
  246.           Else
  247.             DrawShadowBox udtRect, True, False
  248.           End If
  249.         Else
  250.           If mbMouseOver Or miCurrentButtonPressed > -1 Then
  251.             If mbButtonDown Then
  252.                 'Draw Button Down State
  253.                 DrawShadowBox udtRect, True, False
  254.                 'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED)
  255.                 iDownOffset = 1
  256.             Else
  257.                 'Draw Button Up State
  258.                 DrawShadowBox udtRect, False, False
  259.                 'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH)
  260.                 iDownOffset = 0
  261.             End If
  262.           End If
  263.         End If
  264.     
  265.     End Select
  266.     
  267.     'Draw the DropDown button
  268.     If m_DropDown Then
  269.         udtRect.Top = iFocusOffset
  270.         udtRect.Left = iWidth '- iFocusOffset
  271.         udtRect.Right = 10 - iFocusOffset
  272.         udtRect.Bottom = iHeight - iFocusOffset - IIf(iFocusOffset = 1, 1, 0)
  273.         Select Case m_Style
  274.         Case [Cool Button]   'Soft Button
  275.             If mbMouseOver Or miCurrentButtonPressed > -1 Then
  276.                 If mbDropDownPressed Then
  277.                     'Draw Button Down State
  278.                     DrawShadowBox udtRect, True, False
  279.                     'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED)
  280.                     iDownOffset = 0
  281.                 Else
  282.                     'Draw Button Up State
  283.                     DrawShadowBox udtRect, False, False
  284.                     'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH)
  285.                 End If
  286.             End If
  287.         Case [Toolbar Button], [Standard Button]       'toolbar, standard
  288.             If mbDropDownPressed Then
  289.                 'Draw Button Down State
  290.                 DrawShadowBox udtRect, True, True
  291.                 'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH Or DFCS_PUSHED)
  292.                 iDownOffset = 0
  293.             Else
  294.                 'Draw Button Up State
  295.                 DrawShadowBox udtRect, False, True
  296.                 'lReturn = DrawFrameControl(UserControl.hDC, udtRect, DFC_BUTTON, DFCS_BUTTONPUSH)
  297.             End If
  298.         End Select
  299.     End If
  300.  
  301.     'Draw the Dropdown arrow
  302.     If m_DropDown And (m_Style = [Cool Button] Or m_Style = [Toolbar Button] Or m_Style = [Standard Button]) Then
  303.         lArrowTop = (UserControl.ScaleHeight / 2) '- 2
  304.         lArrowLeft = iWidth + 1 - iFocusOffset
  305.         UserControl.Line ((lArrowLeft) + 1, lArrowTop)-((lArrowLeft) + 6, lArrowTop), vbBlack
  306.         UserControl.Line ((lArrowLeft) + 2, lArrowTop + 1)-((lArrowLeft) + 5, lArrowTop + 1), vbBlack
  307.         UserControl.Line ((lArrowLeft) + 3, lArrowTop + 2)-((lArrowLeft) + 4, lArrowTop + 2), vbBlack
  308.     End If
  309.     'Draw The Button Face
  310.  
  311.     'Get the Caption Width and Height
  312.     iTextWidth = UserControl.TextWidth(m_Caption)
  313.     iTextHeight = UserControl.TextHeight(m_Caption)
  314.  
  315.     'kdq 10/19/98
  316.     'figure out which picture to display
  317.     If mbMouseOver And mbMouseDown And Not m_DownPicture Is Nothing And m_Style = [Cool Button] Then
  318.       Set picButton = m_DownPicture
  319.     ElseIf Not mbMouseOver And Not m_FlatPicture Is Nothing And m_Style = [Cool Button] Then
  320.       Set picButton = m_FlatPicture
  321.     ElseIf Not UserControl.Enabled And Not m_DisabledPicture Is Nothing Then
  322.       Set picButton = m_DisabledPicture
  323.     Else
  324.       Set picButton = m_Picture
  325.     End If
  326.     
  327.     If Not picButton Is Nothing And m_Caption > "" Then
  328.         'Get the Pictures Width and Height
  329.         iPicWidth = ScaleX(picButton.Width, vbHimetric, vbPixels)
  330.         iPicHeight = ScaleY(picButton.Height, vbHimetric, vbPixels)
  331.  
  332.         'Set locations for the Picture and the Caption
  333.         Select Case m_PictureAlign
  334.         Case vbPicLeft
  335.             iPicLeft = miClientLeft
  336.             iPicTop = miClientTop + (miClientHeight / 2) - (iPicHeight / 2) + 1
  337.             udtTextRect.Top = miClientTop
  338.             udtTextRect.Bottom = miClientTop + miClientHeight
  339.             udtTextRect.Left = miClientLeft + iPicWidth
  340.             udtTextRect.Right = miClientLeft + miClientWidth
  341.         Case vbPicRight
  342.             iPicLeft = miClientLeft + miClientWidth - iPicWidth
  343.             iPicTop = miClientTop + (miClientHeight / 2) - (iPicHeight / 2) + 1
  344.             udtTextRect.Top = miClientTop
  345.             udtTextRect.Bottom = miClientTop + miClientHeight
  346.             udtTextRect.Left = miClientLeft ' + iPicWidth
  347.             udtTextRect.Right = miClientLeft + miClientWidth - iPicWidth
  348.         Case vbPicTop
  349.             iPicLeft = miClientLeft + (miClientWidth / 2) - (iPicWidth / 2) + 1
  350.             iPicTop = miClientTop
  351.             udtTextRect.Top = miClientTop + iPicHeight + iPicTop
  352.             udtTextRect.Bottom = miClientTop + miClientHeight
  353.             udtTextRect.Left = miClientLeft
  354.             udtTextRect.Right = miClientLeft + miClientWidth
  355.         Case vbPicBottom
  356.             iPicLeft = miClientLeft + (miClientWidth / 2) - (iPicWidth / 2) + 1
  357.             iPicTop = miClientTop + miClientHeight - iPicHeight
  358.             udtTextRect.Top = miClientTop
  359.             udtTextRect.Bottom = miClientTop + miClientHeight - iPicHeight
  360.             udtTextRect.Left = miClientLeft
  361.             udtTextRect.Right = miClientLeft + miClientWidth
  362.         End Select
  363.     'kdq 10/19/98 center picture if no caption
  364.     ElseIf Not picButton Is Nothing And m_Caption = "" Then
  365.             'Get the Pictures Width and Height
  366.             iPicWidth = ScaleX(picButton.Width, vbHimetric, vbPixels)
  367.             iPicHeight = ScaleY(picButton.Height, vbHimetric, vbPixels)
  368.             iPicLeft = miClientLeft + (miClientWidth / 2) - (iPicWidth / 2)
  369.             iPicTop = miClientTop + (miClientHeight / 2) - (iPicHeight / 2) + 1
  370.             udtTextRect.Top = miClientTop
  371.             udtTextRect.Bottom = miClientTop + miClientHeight
  372.             udtTextRect.Left = miClientLeft
  373.             udtTextRect.Right = miClientLeft + miClientWidth
  374.     'kdq 10/19/98 center caption if not picture
  375.     ElseIf picButton Is Nothing And m_Caption > "" Then
  376.             udtTextRect.Top = miClientTop
  377.             udtTextRect.Bottom = miClientTop + miClientHeight
  378.             udtTextRect.Left = miClientLeft
  379.             udtTextRect.Right = miClientLeft + miClientWidth
  380.     End If
  381.  
  382.     '10/19/98 kdq the rect values were changed so Standard buttom displays correctly when it has focus
  383.     'Draw The Dotted Focus lines, but not for the soft button
  384.     If m_Style = [Standard Button] Then
  385.         If mbHasFocus Then
  386.             udtRect.Top = udtTextRect.Top    'iTextTop - 1
  387.             udtRect.Left = udtTextRect.Left + 1 'iTextLeft - 1
  388.             udtRect.Right = udtTextRect.Right - 1 'iTextLeft + iTextWidth + 1
  389.             udtRect.Bottom = udtTextRect.Bottom + 1 'iTextTop + iTextHeight + 1
  390.             lReturn = DrawFocusRect(UserControl.hDC, udtRect)
  391.         Else
  392.             UserControl.DrawWidth = 2
  393.             UserControl.Line (miClientLeft - 1, miClientTop - 1)-(miClientLeft + miClientWidth, miClientTop + miClientHeight), vb3DFace, B
  394.             UserControl.DrawWidth = 1
  395.         End If
  396.     End If
  397.  
  398.     'Draw the Picture
  399.     If Not picButton Is Nothing And (m_Style = [Cool Button] Or m_Style = [Toolbar Button] Or m_Style = [Standard Button] Or m_Style = [Up-Down Button]) Then
  400.         If UserControl.Enabled Then
  401.             'kdq 10/19/98 added GreyScaling for Coolbutton when mouse is not over it (user defined)
  402.             If m_Style = [Cool Button] And Not mbMouseOver And m_ShowFlatGrey Then
  403.                clsPaint.PaintGreyScaleCornerStdPic UserControl.hDC, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0
  404.                'clsPaint.PaintGreyScaleStdPic UserControl.hDC, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0
  405.             Else
  406.                'clsPaint.PaintTransCornerStdPic UserControl.hDC, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0
  407.                clsPaint.PaintTransparentStdPic UserControl.hDC, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0, m_MaskColor
  408.             End If
  409.         Else
  410.             If Not m_DisabledPicture Is Nothing Then
  411.                clsPaint.PaintTransparentStdPic UserControl.hDC, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0, m_MaskColor
  412.             Else
  413.               'clsPaint.PaintDisabledCornerStdPic UserControl.hDC, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0
  414.               clsPaint.PaintDisabledStdPic UserControl.hDC, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0, m_MaskColor
  415.             End If
  416.         End If
  417.     End If
  418.  
  419.     'Print the caption on the button
  420.     If m_Style = [Cool Button] Or m_Style = [Toolbar Button] Or m_Style = [Standard Button] Or m_Style = [Up-Down Button] Then
  421.         udtTextRect.Top = udtTextRect.Top + iDownOffset ' + (udtTextRect.Top Mod 2)
  422.         udtTextRect.Left = udtTextRect.Left + iDownOffset ' + (udtTextRect.Left Mod 2)
  423.         udtTextRect.Bottom = udtTextRect.Bottom + iDownOffset
  424.         udtTextRect.Right = udtTextRect.Right + iDownOffset
  425.         If UserControl.Enabled Then
  426.             lReturn = DrawText(UserControl.hDC, m_Caption, Len(m_Caption), udtTextRect, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER)
  427.         Else
  428.             UserControl.ForeColor = vbGrayText
  429.             lReturn = DrawText(UserControl.hDC, m_Caption, Len(m_Caption), udtTextRect, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER)
  430.             UserControl.ForeColor = vbButtonText
  431.         End If
  432.     End If
  433.     
  434.     Refresh
  435.     Set clsPaint = Nothing
  436.     Set picButton = Nothing
  437. End Sub
  438.  
  439. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  440. 'MappingInfo=UserControl,UserControl,-1,BackColor
  441. Public Property Get BackColor() As OLE_COLOR
  442. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  443. Attribute BackColor.VB_UserMemId = -501
  444.     BackColor = UserControl.BackColor
  445. End Property
  446.  
  447. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  448.     UserControl.BackColor() = New_BackColor
  449.     PropertyChanged "BackColor"
  450.     DrawButton
  451. End Property
  452.  
  453. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  454. 'MappingInfo=UserControl,UserControl,-1,ForeColor
  455. Public Property Get ForeColor() As OLE_COLOR
  456. Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
  457.     ForeColor = UserControl.ForeColor
  458. End Property
  459.  
  460. Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  461.     UserControl.ForeColor() = New_ForeColor
  462.     PropertyChanged "ForeColor"
  463.     DrawButton
  464. End Property
  465.  
  466. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  467. 'MappingInfo=UserControl,UserControl,-1,Enabled
  468. Public Property Get Enabled() As Boolean
  469. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  470.     Enabled = UserControl.Enabled
  471. End Property
  472.  
  473. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  474.     UserControl.Enabled() = New_Enabled
  475.     PropertyChanged "Enabled"
  476.     DrawButton
  477. End Property
  478.  
  479. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  480. 'MappingInfo=UserControl,UserControl,-1,Font
  481. Public Property Get Font() As Font
  482. Attribute Font.VB_Description = "Returns a Font object."
  483. Attribute Font.VB_UserMemId = -512
  484.     Set Font = UserControl.Font
  485. End Property
  486.  
  487. Public Property Set Font(ByVal New_Font As Font)
  488.     Set UserControl.Font = New_Font
  489.     PropertyChanged "Font"
  490.     DrawButton
  491. End Property
  492.  
  493.  
  494. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  495. 'MappingInfo=UserControl,UserControl,-1,Refresh
  496. Public Sub Refresh()
  497. Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
  498.     UserControl.Refresh
  499. End Sub
  500.  
  501. Private Sub ExitTimer_Timer()
  502.     If Not UnderMouse Then Leave
  503. End Sub
  504.  
  505. Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
  506.     'kdq 10/19/98 only Click when control is a button
  507.     If m_Style <> [Seperator] And m_Style <> SeperatorH And m_Style <> [Toolbar Handle] And m_Style <> [Toolbar HandleH] Then RaiseEvent Click
  508. End Sub
  509.  
  510. Private Sub UserControl_AmbientChanged(PropertyName As String)
  511.     If PropertyName = "DisplayAsDefault" Then
  512.         DrawButton
  513.     End If
  514.     
  515. End Sub
  516.  
  517. Private Sub UserControl_DblClick()
  518.     RaiseEvent DblClick
  519. End Sub
  520.  
  521. Private Sub UserControl_EnterFocus()
  522.     mbHasFocus = True
  523.     DrawButton
  524. End Sub
  525.  
  526. Private Sub UserControl_ExitFocus()
  527.     mbHasFocus = False
  528.     DrawButton
  529.     Refresh
  530. End Sub
  531.  
  532. Private Sub UserControl_Initialize()
  533. InitializeUpDownDither
  534. End Sub
  535.  
  536. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  537.     If KeyCode = 32 Then
  538.       miCurrentButtonPressed = 0
  539.       mbButtonDown = True
  540.       DrawButton
  541.     End If
  542.     RaiseEvent KeyDown(KeyCode, Shift)
  543. End Sub
  544.  
  545. Private Sub UserControl_KeyPress(KeyAscii As Integer)
  546.     RaiseEvent KeyPress(KeyAscii)
  547. End Sub
  548.  
  549. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  550.     If KeyCode = 32 Then
  551.       miCurrentButtonPressed = -1
  552.       mbButtonDown = False
  553.       DrawButton
  554.       'kdq 10/19/98 only Click when control is a button
  555.        If m_Style <> [Seperator] And m_Style <> SeperatorH And m_Style <> [Toolbar Handle] And m_Style <> [Toolbar HandleH] Then RaiseEvent Click
  556.     End If
  557.     RaiseEvent KeyUp(KeyCode, Shift)
  558. End Sub
  559.  
  560. Private Sub UserControl_LostFocus()
  561.     mbHasFocus = False
  562.     DrawButton
  563. End Sub
  564.  
  565. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  566.     If m_DropDown Then
  567.         If x > (UserControl.ScaleWidth - 11) Then
  568.             mbDropDownPressed = True
  569.             miCurrentButtonPressed = 1
  570.         Else
  571.             mbButtonDown = True
  572.             miCurrentButtonPressed = 0
  573.         End If
  574.     Else
  575.         mbButtonDown = True
  576.         miCurrentButtonPressed = 0
  577.     End If
  578.     mbMouseDown = True
  579.     DrawButton
  580.     RaiseEvent MouseDown(Button, Shift, x, y)
  581. End Sub
  582.  
  583. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  584.     If Button = 1 Then
  585.         If (x < 0 Or y < 0 Or x >= UserControl.ScaleWidth Or y >= UserControl.ScaleHeight) Then
  586.             If miCurrentButtonPressed = 0 Then
  587.                 mbButtonDown = False
  588.             Else
  589.                 mbDropDownPressed = False
  590.             End If
  591.             DrawButton
  592.         Else
  593.             If miCurrentButtonPressed = 0 Then
  594.                 mbButtonDown = True
  595.             Else
  596.                 mbDropDownPressed = True
  597.             End If
  598.             DrawButton
  599.         End If
  600.     End If
  601.     
  602.     If mbMouseOver Then
  603.         If Not UnderMouse Then
  604.             Leave
  605.         End If
  606.     Else
  607.         If UnderMouse Then
  608.             mbMouseOver = True
  609.             RaiseEvent MouseEnter
  610.             DrawButton
  611.             
  612.             'Set up the ExitTimer
  613.             Set ExitTimer = New objTimer
  614.             ExitTimer.Interval = 50
  615.             ExitTimer.Enabled = True
  616.         End If
  617.     End If
  618.     RaiseEvent MouseMove(Button, Shift, x, y)
  619. End Sub
  620.  
  621. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  622.     Dim bOverButton As Boolean
  623.     
  624.     RaiseEvent MouseUp(Button, Shift, x, y)
  625.     
  626.     'Check the position of the mouse when in was released.
  627.     'We only want to call the click events when the
  628.     'mouse was released over the button.
  629.     If (x < 0 Or y < 0 Or x >= UserControl.ScaleWidth Or y >= UserControl.ScaleHeight) Then
  630.         bOverButton = False
  631.     Else
  632.         bOverButton = True
  633.     End If
  634.     
  635.     If miCurrentButtonPressed = 1 Then
  636.         If bOverButton And x > (UserControl.ScaleWidth - 10) Then RaiseEvent DropDownClick
  637.     End If
  638.     mbButtonDown = False
  639.     mbDropDownPressed = False
  640.     mbMouseDown = False
  641.     
  642.     If m_Style = [Up-Down Button] Then
  643.         m_Value = Not m_Value
  644.         CheckButtonGroup
  645.     End If
  646.     
  647.     DrawButton
  648.     If miCurrentButtonPressed = 0 Then
  649.         If bOverButton And x < (UserControl.ScaleWidth - 10) And m_DropDown Then
  650.                 'kdq 10/19/98 only Click when control is a button
  651.                 If m_Style <> [Seperator] And m_Style <> SeperatorH And m_Style <> [Toolbar Handle] And m_Style <> [Toolbar HandleH] Then RaiseEvent Click
  652.         'kdq 10/19/98 added this because click event wasnt firing for nondropdown buttons all the time
  653.         ElseIf bOverButton And Not m_DropDown Then
  654.                 'kdq 10/19/98 only Click when control is a button
  655.                 If m_Style <> [Seperator] And m_Style <> SeperatorH And m_Style <> [Toolbar Handle] And m_Style <> [Toolbar HandleH] Then RaiseEvent Click
  656.         End If
  657.     End If
  658.     miCurrentButtonPressed = -1
  659.     DrawButton          ' added so flatbutton gets redrawn
  660. End Sub
  661.  
  662. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  663. 'MemberInfo=11,0,0,0
  664. Public Property Get Picture() As Picture
  665. Attribute Picture.VB_Description = "Image to be displayed on the button."
  666.     Set Picture = m_Picture
  667. End Property
  668.  
  669. Public Property Set Picture(ByVal New_Picture As Picture)
  670.     Set m_Picture = New_Picture
  671.     PropertyChanged "Picture"
  672.     DrawButton
  673. End Property
  674.  
  675. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  676. 'MemberInfo=7,0,0,0
  677. Public Property Get PictureAlign() As envbuPictureAlign
  678. Attribute PictureAlign.VB_Description = "Specifies alignment of the picture property."
  679.     PictureAlign = m_PictureAlign
  680. End Property
  681.  
  682. Public Property Let PictureAlign(ByVal New_PictureAlign As envbuPictureAlign)
  683.     m_PictureAlign = New_PictureAlign
  684.     PropertyChanged "PictureAlign"
  685.     DrawButton
  686. End Property
  687.  
  688. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  689. 'MemberInfo=13,0,0,
  690. Public Property Get Caption() As String
  691. Attribute Caption.VB_Description = "Text displayed on the face of the button."
  692. Attribute Caption.VB_UserMemId = -518
  693.     Caption = m_Caption
  694. End Property
  695.  
  696. Public Property Let Caption(ByVal New_Caption As String)
  697.     m_Caption = New_Caption
  698.     PropertyChanged "Caption"
  699.     SetAccessKey
  700.     DrawButton
  701. End Property
  702. Private Sub SetAccessKey()
  703.     Dim iPos As Integer
  704.     Dim sChar As String
  705.     
  706.     iPos = InStr(1, m_Caption, "&")
  707.     If iPos > 0 Then
  708.         sChar = Mid$(m_Caption, iPos + 1, 1)
  709.         If sChar <> "&" Then
  710.             UserControl.AccessKeys = LCase(sChar)
  711.         End If
  712.     End If
  713. End Sub
  714. 'Initialize Properties for User Control
  715. Private Sub UserControl_InitProperties()
  716.     Set UserControl.Font = Ambient.Font
  717.     Set m_Picture = Nothing
  718.     Set m_FlatPicture = Nothing
  719.     Set m_DownPicture = Nothing
  720.     Set m_DisabledPicture = Nothing
  721.     m_PictureAlign = m_def_PictureAlign
  722.     m_Caption = m_def_Caption
  723.     m_MaskColor = m_def_MaskColor
  724.     m_Style = m_def_Style
  725.     m_Value = False
  726.     m_DropDown = m_def_DropDown
  727.     m_ButtonFace = vbButtonFace
  728.     m_ButtonLightShadow = vbButtonShadow
  729.     m_ButtonDarkShadow = vb3DDKShadow
  730.     m_ButtonHighlight = vb3DHighlight
  731.     m_ShowFlatGrey = False
  732.     m_ButtonGroup = m_def_ButtonGroup
  733.     m_ButtonGroupDefault = m_def_ButtonGroupDefault
  734.     m_ButtonGroupDefault2 = m_def_ButtonGroupDefault2
  735.     
  736.     miCurrentButtonPressed = -1
  737.     mbMouseOver = False
  738.     mbButtonDown = False
  739.     mbMouseDown = False
  740.     mbHasFocus = False
  741.     mbDropDownPressed = False
  742.     End Sub
  743.  
  744. Private Sub UserControl_Paint()
  745.     DrawButton
  746. End Sub
  747.  
  748. 'Load property values from storage
  749. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  750.  
  751.     UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
  752.     UserControl.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
  753.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  754.     Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
  755. '    UserControl.BackStyle = PropBag.ReadProperty("BackStyle", 1)
  756. '    UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
  757.     Set m_Picture = PropBag.ReadProperty("Picture", Nothing)
  758.     Set m_DownPicture = PropBag.ReadProperty("DownPicture", Nothing)
  759.     Set m_FlatPicture = PropBag.ReadProperty("FlatPicture", Nothing)
  760.     Set m_DisabledPicture = PropBag.ReadProperty("DisabledPicture", Nothing)
  761.     m_PictureAlign = PropBag.ReadProperty("PictureAlign", m_def_PictureAlign)
  762.     m_Caption = PropBag.ReadProperty("Caption", m_def_Caption)
  763.     m_MaskColor = PropBag.ReadProperty("MaskColor", &HC0C0C0)
  764.     m_Style = PropBag.ReadProperty("Style", m_def_Style)
  765.     m_DropDown = PropBag.ReadProperty("DropDown", m_def_DropDown)
  766.     m_ButtonDarkShadow = PropBag.ReadProperty("ColorDarkShadow", vb3DDKShadow)
  767.     m_ButtonLightShadow = PropBag.ReadProperty("ColorLightShadow", vbButtonShadow)
  768.     m_ButtonHighlight = PropBag.ReadProperty("ColorHighlight", vb3DHighlight)
  769.     m_ShowFlatGrey = PropBag.ReadProperty("ShowFlatGrey", False)
  770.     m_ButtonGroup = PropBag.ReadProperty("ButtonGroup", m_def_ButtonGroup)
  771.     m_ButtonGroupDefault = PropBag.ReadProperty("ButtonGroupDefault", m_def_ButtonGroupDefault)
  772.     m_ButtonGroupDefault2 = PropBag.ReadProperty("ButtonGroupDefault2", m_def_ButtonGroupDefault2)
  773.     m_Value = PropBag.ReadProperty("Value", False)
  774.  
  775.     SetAccessKey
  776.     miCurrentButtonPressed = -1
  777.     DrawButton
  778. End Sub
  779.  
  780. Private Sub UserControl_Resize()
  781.     DrawButton
  782. End Sub
  783.  
  784. 'Write property values to storage
  785. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  786.  
  787.     Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
  788.     Call PropBag.WriteProperty("ForeColor", UserControl.ForeColor, &H80000012)
  789.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  790.     Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
  791. '    Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 1)
  792. '    Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 0)
  793.     Call PropBag.WriteProperty("Picture", m_Picture, Nothing)
  794.     Call PropBag.WriteProperty("DownPicture", m_DownPicture, Nothing)
  795.     Call PropBag.WriteProperty("FlatPicture", m_FlatPicture, Nothing)
  796.     Call PropBag.WriteProperty("DisabledPicture", m_DisabledPicture, Nothing)
  797.     Call PropBag.WriteProperty("PictureAlign", m_PictureAlign, m_def_PictureAlign)
  798.     Call PropBag.WriteProperty("Caption", m_Caption, m_def_Caption)
  799.     Call PropBag.WriteProperty("MaskColor", m_MaskColor, &HC0C0C0)
  800.     Call PropBag.WriteProperty("Style", m_Style, m_def_Style)
  801.     Call PropBag.WriteProperty("DropDown", m_DropDown, m_def_DropDown)
  802.     Call PropBag.WriteProperty("ColorDarkShadow", m_ButtonDarkShadow, vb3DDKShadow)
  803.     Call PropBag.WriteProperty("ColorLightShadow", m_ButtonLightShadow, vbButtonShadow)
  804.     Call PropBag.WriteProperty("ColorHighlight", m_ButtonHighlight, vb3DHighlight)
  805.     Call PropBag.WriteProperty("ShowFlatGrey", m_ShowFlatGrey, False)
  806.     Call PropBag.WriteProperty("ButtonGroup", m_ButtonGroup, m_def_ButtonGroup)
  807.     Call PropBag.WriteProperty("ButtonGroupDefault", m_ButtonGroupDefault, m_def_ButtonGroupDefault)
  808.     Call PropBag.WriteProperty("ButtonGroupDefault2", m_ButtonGroupDefault2, m_def_ButtonGroupDefault2)
  809.     Call PropBag.WriteProperty("Value", m_Value, False)
  810. End Sub
  811.  
  812. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  813. 'MemberInfo=10,0,0,0
  814. Public Property Get MaskColor() As OLE_COLOR
  815. Attribute MaskColor.VB_Description = "Sets/gets mask color to use when drawing picture"
  816.     MaskColor = m_MaskColor
  817. End Property
  818.  
  819. Public Property Let MaskColor(ByVal New_MaskColor As OLE_COLOR)
  820.     m_MaskColor = New_MaskColor
  821.     PropertyChanged "MaskColor"
  822.     DrawButton
  823. End Property
  824.  
  825. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  826. 'MemberInfo=7,0,0,0
  827. Public Property Get Style() As vbuStyle
  828. Attribute Style.VB_Description = "Gets/Sets the style of the button"
  829.     Style = m_Style
  830. End Property
  831.  
  832. Public Property Let Style(ByVal New_Style As vbuStyle)
  833.     m_Style = New_Style
  834.     PropertyChanged "Style"
  835.     DrawButton
  836. End Property
  837.  
  838. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  839. 'MemberInfo=0,0,0,False
  840. Public Property Get DropDown() As Boolean
  841. Attribute DropDown.VB_Description = "Determines whether or not to display the Drop Down Button."
  842.     DropDown = m_DropDown
  843. End Property
  844.  
  845. Public Property Let DropDown(ByVal New_DropDown As Boolean)
  846.     m_DropDown = New_DropDown
  847.     PropertyChanged "DropDown"
  848.     DrawButton
  849. End Property
  850.  
  851. 'kdq 10/19/98 added for seperator/handle
  852. Private Sub DrawVLine(ByVal x As Single, ByVal y As Single, ByVal cx As Single, ByVal cy As Single)
  853.     Line (x + 1, y)-(x + 1, y + cy), m_ButtonHighlight
  854.     Line (x, y)-(x, y + cy), m_ButtonLightShadow
  855. End Sub
  856.  
  857. 'kdq 11/03/98 added for seperator/handle
  858. Private Sub DrawHLine(ByVal x As Single, ByVal y As Single, ByVal cx As Single, ByVal cy As Single)
  859.     Line (x, y + 1)-(x + cx, y + 1), m_ButtonHighlight
  860.     Line (x, y)-(x + cx, y), m_ButtonLightShadow
  861. End Sub
  862.  
  863. 'kdq 10/19/98 added for seperator/handle
  864. Private Sub DrawRaisedVLine(ByVal x As Single, ByVal y As Single, ByVal cx As Single, ByVal cy As Single)
  865.     Line (x, y)-(x, y + cy), m_ButtonHighlight
  866.     Line (x + 1, y)-(x + 1, y + cy), m_ButtonHighlight
  867.     Line (x + 2, y)-(x + 2, y + cy), m_ButtonHighlight
  868.     Line (x, y + 1)-(x, y + cy), m_ButtonLightShadow
  869.     Line (x + 1, y + 1)-(x + 1, y + cy), m_ButtonLightShadow
  870.     Line (x + 2, y + 1)-(x + 2, y + cy), m_ButtonLightShadow
  871.     Line (x, y)-(x, y + cy - 1), m_ButtonHighlight
  872.     Line (x + 1, y + 1)-(x + 1, y + cy - 1), m_ButtonFace
  873. End Sub
  874.  
  875. 'kdq 11/03/98 added for seperator/handle
  876. Private Sub DrawRaisedHLine(ByVal x As Single, ByVal y As Single, ByVal cx As Single, ByVal cy As Single)
  877.     Line (x, y)-(x + cx, y), m_ButtonHighlight
  878.     Line (x, y + 1)-(x + cx, y + 1), m_ButtonHighlight
  879.     Line (x, y + 2)-(x + cx, y + 2), m_ButtonHighlight
  880.     Line (x + 1, y)-(x + cx, y), m_ButtonLightShadow
  881.     Line (x + 1, y + 1)-(x + cx, y + 1), m_ButtonLightShadow
  882.     Line (x + 1, y + 2)-(x + cx, y + 2), m_ButtonLightShadow
  883.     Line (x, y)-(x + cx - 1, y), m_ButtonHighlight
  884.     Line (x + 1, y + 1)-(x + cx - 1, y + 1), m_ButtonFace
  885. End Sub
  886.  
  887. 'kdq 10/19/98 added to make thinner border for CoolButton
  888. Private Sub DrawShadowBox(RectSize As RECT, ByVal Pressed As Boolean, ByVal DKShadow As Boolean)
  889.     Dim x As Integer, y As Integer, cx As Integer, cy As Integer
  890.     x = RectSize.Left
  891.     y = RectSize.Top
  892.     cx = RectSize.Right
  893.     cy = RectSize.Bottom
  894.     
  895.     If DKShadow Then
  896.         If Pressed Then
  897.             Line (x, y)-(x + cx - 1, y), m_ButtonDarkShadow
  898.             Line (x, y)-(x, y + cy - 1), m_ButtonDarkShadow
  899.             Line (x + 1, y + 1)-(x + cx - 2, y + 1), m_ButtonLightShadow
  900.             Line (x + 1, y + 1)-(x + 1, y + cy - 2), m_ButtonLightShadow
  901.             Line (x + cx - 1, y)-(x + cx - 1, y + cy), m_ButtonHighlight
  902.             Line (x, y + cy - 1)-(x + cx, y + cy - 1), m_ButtonHighlight
  903.         Else
  904.             Line (x, y)-(x + cx - 1, y), m_ButtonHighlight
  905.             Line (x, y)-(x, y + cy - 1), m_ButtonHighlight
  906.             Line (x + cx - 2, y + 1)-(x + cx - 2, y + cy - 1), m_ButtonLightShadow
  907.             Line (x + 1, y + cy - 2)-(x + cx - 1, y + cy - 2), m_ButtonLightShadow
  908.             Line (x + cx - 1, y)-(x + cx - 1, y + cy), m_ButtonDarkShadow
  909.             Line (x, y + cy - 1)-(x + cx, y + cy - 1), m_ButtonDarkShadow
  910.         End If
  911.     Else
  912.         Dim Color1 As Long
  913.         Dim Color2 As Long
  914.         If Pressed Then
  915.             Color1 = m_ButtonLightShadow
  916.             Color2 = m_ButtonHighlight
  917.         Else
  918.             Color1 = m_ButtonHighlight
  919.             Color2 = m_ButtonLightShadow
  920.         End If
  921.         Line (x, y)-(x + cx - 1, y), Color1
  922.         Line (x, y)-(x, y + cy - 1), Color1
  923.         Line (x + cx - 1, y)-(x + cx - 1, y + cy), Color2
  924.         Line (x, y + cy - 1)-(x + cx, y + cy - 1), Color2
  925.     End If
  926. End Sub
  927.  
  928. Public Property Get ColorLightShadow() As OLE_COLOR
  929. Attribute ColorLightShadow.VB_Description = "Sets/gets color of border light shadow"
  930.     ColorLightShadow = m_ButtonLightShadow
  931. End Property
  932.  
  933. Public Property Let ColorLightShadow(ByVal New_Value As OLE_COLOR)
  934.     If Not (m_ButtonLightShadow = New_Value) Then
  935.         m_ButtonLightShadow = New_Value
  936.         DrawButton
  937.     End If
  938.     PropertyChanged "ColorLightShadow"
  939. End Property
  940.  
  941. 'kdq 10/19/98
  942. Public Property Get ColorDarkShadow() As OLE_COLOR
  943. Attribute ColorDarkShadow.VB_Description = "Sets/gets color of border 3D dark shadow"
  944.     ColorDarkShadow = m_ButtonDarkShadow
  945. End Property
  946.  
  947. Public Property Let ColorDarkShadow(ByVal New_Value As OLE_COLOR)
  948.     If Not (m_ButtonDarkShadow = New_Value) Then
  949.         m_ButtonDarkShadow = New_Value
  950.         DrawButton
  951.     End If
  952.     PropertyChanged "ColorDarkShadow"
  953. End Property
  954.  
  955. 'kdq 10/19/98
  956. Public Property Get ColorHighlight() As OLE_COLOR
  957. Attribute ColorHighlight.VB_Description = "Sets/gets color of border 3D highlight"
  958.     ColorHighlight = m_ButtonHighlight
  959. End Property
  960.  
  961. Public Property Let ColorHighlight(ByVal New_Value As OLE_COLOR)
  962.     If Not (m_ButtonHighlight = New_Value) Then
  963.         m_ButtonHighlight = New_Value
  964.         DrawButton
  965.     End If
  966.     PropertyChanged "ColorHighlight"
  967. End Property
  968.  
  969. 'kdq 10/19/98
  970. Public Sub ShowAbout()
  971. Attribute ShowAbout.VB_Description = "Show about box"
  972. Attribute ShowAbout.VB_UserMemId = -552
  973.     frmAbout.Show vbModal
  974. End Sub
  975.  
  976. 'kdq 10/19/98 picture to display when mousedown on cool button
  977. Public Property Get DownPicture() As Picture
  978. Attribute DownPicture.VB_Description = "Sets/gets picture to be displayed if button is pushed"
  979.     Set DownPicture = m_DownPicture
  980. End Property
  981.  
  982. Public Property Set DownPicture(ByVal New_DownPicture As Picture)
  983.     Set m_DownPicture = New_DownPicture
  984.     PropertyChanged "DownPicture"
  985. End Property
  986.  
  987. Public Property Get DisabledPicture() As Picture
  988. Attribute DisabledPicture.VB_Description = "Sets/gets alternate picture to display if button is disabled"
  989.     Set DisabledPicture = m_DisabledPicture
  990. End Property
  991.  
  992. Public Property Set DisabledPicture(ByVal New_Picture As Picture)
  993.     Set m_DisabledPicture = New_Picture
  994.     PropertyChanged "DisabledPicture"
  995. End Property
  996.  
  997. 'kdq 10/19/98 picture to display when mouse is not over button on cool button
  998. Public Property Get FlatPicture() As Picture
  999. Attribute FlatPicture.VB_Description = "Sets/gets picture to display when mouse is not over button (Cool button only)"
  1000.     Set FlatPicture = m_FlatPicture
  1001. End Property
  1002.  
  1003. Public Property Set FlatPicture(ByVal New_FlatPicture As Picture)
  1004.     Set m_FlatPicture = New_FlatPicture
  1005.     DrawButton
  1006.     PropertyChanged "FlatPicture"
  1007. End Property
  1008.  
  1009. 'kdq 10/19/98 display picture as greyscale when mouse is not over Cool Button
  1010. Public Property Get ShowFlatGrey() As Boolean
  1011. Attribute ShowFlatGrey.VB_Description = "Sets/gets a value to determine if picture is drawn in greyscale when mouse is not over button"
  1012.     ShowFlatGrey = m_ShowFlatGrey
  1013. End Property
  1014.  
  1015. Public Property Let ShowFlatGrey(ByVal New_Value As Boolean)
  1016.     m_ShowFlatGrey = New_Value
  1017.     PropertyChanged "DropDown"
  1018.     DrawButton
  1019. End Property
  1020.  
  1021. Public Property Get ButtonGroup() As String
  1022.     ButtonGroup = m_ButtonGroup
  1023. End Property
  1024.  
  1025. Public Property Let ButtonGroup(ByVal New_ButtonGroup As String)
  1026.     If Not (m_ButtonGroup = New_ButtonGroup) Then
  1027.         m_ButtonGroup = New_ButtonGroup
  1028.         If m_Style = [Up-Down Button] Then
  1029.             CheckButtonGroup
  1030.             Cls
  1031.             UserControl_Paint
  1032.         End If
  1033.     End If
  1034.     PropertyChanged "ButtonGroup"
  1035. End Property
  1036.  
  1037. Public Property Get ButtonGroupDefault() As Boolean
  1038.     ButtonGroupDefault = m_ButtonGroupDefault
  1039. End Property
  1040.  
  1041. Public Property Let ButtonGroupDefault(ByVal New_ButtonGroupDefault As Boolean)
  1042.     'The following line of code ensures that the integer
  1043.     'value of the boolean parameter is either
  1044.     '0 or -1.  It is known that Access 97 will
  1045.     'set the boolean's value to 255 for true.
  1046.     'In this case a P-Code compiled VB5 built
  1047.     'OCX will return True for the expression
  1048.     '(Not [boolean variable that ='s 255]).  This
  1049.     'line ensures the reliability of boolean operations
  1050.     If CBool(New_ButtonGroupDefault) Then New_ButtonGroupDefault = True Else New_ButtonGroupDefault = False
  1051.     If Not (m_ButtonGroupDefault = New_ButtonGroupDefault) Then
  1052.         m_ButtonGroupDefault = New_ButtonGroupDefault
  1053.         If m_Style = [Up-Down Button] Then
  1054.             CheckButtonGroupDefault
  1055.             CheckButtonGroup
  1056.             Cls
  1057.             UserControl_Paint
  1058.         End If
  1059.     End If
  1060.     PropertyChanged "ButtonGroupDefault"
  1061. End Property
  1062.  
  1063. Private Sub CheckButtonGroupDefault()
  1064.     If (Len(m_ButtonGroup) > 0) Then
  1065.         If m_ButtonGroupDefault Then     ' make all others in group not default
  1066.             Dim ctl As Control
  1067.             Dim i As Long
  1068.             For i = 0 To UserControl.ParentControls.Count - 1
  1069.                 If TypeOf UserControl.ParentControls(i) Is Control Then
  1070.                     Set ctl = UserControl.ParentControls(i)
  1071.                     If TypeOf ctl Is axButton Then
  1072.                         If ctl.ButtonGroup = m_ButtonGroup Then
  1073.                             If Not ((ctl Is UserControl.Extender) Or (ctl Is UserControl)) Then
  1074.                                 ctl.ButtonGroupDefault = False
  1075.                             End If
  1076.                         End If
  1077.                     End If
  1078.                 End If
  1079.             Next
  1080.         End If
  1081.     End If
  1082. End Sub
  1083.  
  1084. Public Property Get ButtonGroupDefault2() As Boolean
  1085.     ButtonGroupDefault2 = m_ButtonGroupDefault2
  1086. End Property
  1087.  
  1088. Public Property Let ButtonGroupDefault2(ByVal New_ButtonGroupDefault2 As Boolean)
  1089.     'The following line of code ensures that the integer
  1090.     'value of the boolean parameter is either
  1091.     '0 or -1.  It is known that Access 97 will
  1092.     'set the boolean's value to 255 for true.
  1093.     'In this case a P-Code compiled VB5 built
  1094.     'OCX will return True for the expression
  1095.     '(Not [boolean variable that ='s 255]).  This
  1096.     'line ensures the reliability of boolean operations
  1097.     If CBool(New_ButtonGroupDefault2) Then New_ButtonGroupDefault2 = True Else New_ButtonGroupDefault2 = False
  1098.     If Not (m_ButtonGroupDefault2 = New_ButtonGroupDefault2) Then
  1099.         m_ButtonGroupDefault2 = New_ButtonGroupDefault2
  1100.         If m_Style = [Up-Down Button] Then
  1101.             CheckButtonGroupDefault2
  1102.             CheckButtonGroup
  1103.             Cls
  1104.             UserControl_Paint
  1105.         End If
  1106.     End If
  1107.     PropertyChanged "ButtonGroupDefault2"
  1108. End Property
  1109.  
  1110. Private Sub CheckButtonGroupDefault2()
  1111.     If (Len(m_ButtonGroup) > 0) Then
  1112.         If m_ButtonGroupDefault2 Then     ' make all others in group not default
  1113.             Dim ctl As Control
  1114.             Dim i As Long
  1115.             For i = 0 To UserControl.ParentControls.Count - 1
  1116.                 If TypeOf UserControl.ParentControls(i) Is Control Then
  1117.                     Set ctl = UserControl.ParentControls(i)
  1118.                     If TypeOf ctl Is axButton Then
  1119.                         If ctl.ButtonGroup = m_ButtonGroup Then
  1120.                             If Not ((ctl Is UserControl.Extender) Or (ctl Is UserControl)) Then
  1121.                                 ctl.ButtonGroupDefault2 = False
  1122.                             End If
  1123.                         End If
  1124.                     End If
  1125.                 End If
  1126.             Next
  1127.         End If
  1128.     End If
  1129. End Sub
  1130.  
  1131. Private Sub CheckButtonGroup()
  1132.     If (Len(m_ButtonGroup) > 0) Then
  1133.         Dim ctl As Control
  1134.         Dim i As Long
  1135.         If m_Value Then     ' clear all others in group
  1136.             For i = 0 To UserControl.ParentControls.Count - 1
  1137.                 If TypeOf UserControl.ParentControls(i) Is Control Then
  1138.                     Set ctl = UserControl.ParentControls(i)
  1139.                     If TypeOf ctl Is axButton Then
  1140.                         If ctl.ButtonGroup = m_ButtonGroup Then
  1141.                             If Not ((ctl Is UserControl.Extender) Or (ctl Is UserControl)) Then
  1142.                                 ctl.Value = False
  1143.                             End If
  1144.                         End If
  1145.                     End If
  1146.                 End If
  1147.             Next
  1148.         Else                 ' set group default if necessary
  1149.             Dim GroupValueSet As Boolean
  1150.             Dim ctlDefault As axButton
  1151.             Dim ctlDefault2 As axButton
  1152.             Set ctlDefault = Nothing
  1153.             Set ctlDefault2 = Nothing
  1154.             GroupValueSet = False
  1155.             For i = 0 To UserControl.ParentControls.Count - 1
  1156.                 If TypeOf UserControl.ParentControls(i) Is Control Then
  1157.                     Set ctl = UserControl.ParentControls(i)
  1158.                     If TypeOf ctl Is axButton Then
  1159.                         If ctl.ButtonGroup = m_ButtonGroup Then
  1160. '                            If Not ((ctl Is UserControl.Extender) Or (ctl Is UserControl)) Then
  1161.                                 If ctl.Value Then
  1162.                                     GroupValueSet = True
  1163.                                     Exit For
  1164.                                 ElseIf ctl.ButtonGroupDefault Then
  1165.                                     Set ctlDefault = ctl
  1166.                                 ElseIf ctl.ButtonGroupDefault2 Then
  1167.                                     Set ctlDefault2 = ctl
  1168.                                 End If
  1169. '                            End If
  1170.                         End If
  1171.                     End If
  1172.                 End If
  1173.             Next
  1174.             If Not (GroupValueSet Or (ctlDefault Is Nothing)) Then
  1175.                 If (Not m_ButtonGroupDefault) Or (ctlDefault2 Is Nothing) Then
  1176.                     ctlDefault.Value = True
  1177.                 Else
  1178.                     ctlDefault2.Value = True
  1179.                 End If
  1180.             End If
  1181.         End If
  1182.     End If
  1183. End Sub
  1184.  
  1185. Public Property Get Value() As Boolean
  1186.     Value = m_Value
  1187. End Property
  1188.  
  1189. Public Property Let Value(ByVal New_Value As Boolean)
  1190.     'The following line of code ensures that the integer
  1191.     'value of the boolean parameter is either
  1192.     '0 or -1.  It is known that Access 97 will
  1193.     'set the boolean's value to 255 for true.
  1194.     'In this case a P-Code compiled VB5 built
  1195.     'OCX will return True for the expression
  1196.     '(Not [boolean variable that ='s 255]).  This
  1197.     'line ensures the reliability of boolean operations
  1198.     If CBool(New_Value) Then New_Value = True Else New_Value = False
  1199.     If Not (m_Value = New_Value) Then
  1200.         m_Value = New_Value
  1201.         If m_Style = [Up-Down Button] Then
  1202.             CheckButtonGroup
  1203.             Cls
  1204.             UserControl_Paint
  1205.         End If
  1206.     End If
  1207.     PropertyChanged "Value"
  1208. End Property
  1209.  
  1210. Private Sub PaintUpDownDither(x As Long, y As Long, Width As Long, Height As Long)
  1211.     Dim ret As Long
  1212.     Dim MyRect As RECT
  1213.     'draw on the form with that brush
  1214.     MyRect.Left = x
  1215.     MyRect.Top = y
  1216.     MyRect.Right = x + Width
  1217.     MyRect.Bottom = y + Height
  1218.     ret = FillRect(UserControl.hDC, MyRect, hUpDownDitherBrush)
  1219. End Sub
  1220.  
  1221. Private Sub InitializeUpDownDither()
  1222.     Dim i As Long, j As Long
  1223.     
  1224.     '---one-time setup: put this in it's own routine------
  1225.     'set (invisible) picturebox properties for creating a brush
  1226. '    UserControl.ScaleMode = vbPixels
  1227. '    UserControl.AutoRedraw = True
  1228.     'draw the dither in it
  1229.     For i = 0 To UserControl.ScaleWidth - 1
  1230.         For j = 0 To UserControl.ScaleHeight - 1
  1231.             If (i + j) Mod 2 Then
  1232.                 UserControl.PSet (i, j), vb3DHighlight
  1233.             Else
  1234.                 UserControl.PSet (i, j), vbButtonFace
  1235.             End If
  1236.         Next j
  1237.     Next i
  1238.     '---end of one-time setup------
  1239.  
  1240.     'create the brush from it
  1241.     hUpDownDitherBrush = CreatePatternBrush(UserControl.Image.handle)
  1242.  
  1243. End Sub
  1244.  
  1245.