home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1999 April / CD_Shareware_Magazine_31.iso / Free / Prg / axpicker.exe / Projects / axPicker / axButton.ctl < prev    next >
Encoding:
Visual Basic user-defined control file  |  1999-02-08  |  47.5 KB  |  1,221 lines

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