home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / axdata / axbutton.ctl < prev    next >
Encoding:
Visual Basic user-defined control file  |  1999-02-07  |  47.7 KB  |  1,225 lines

  1. VERSION 5.00
  2. Begin VB.UserControl axDataButton 
  3.    AutoRedraw      =   -1  'True
  4.    CanGetFocus     =   0   'False
  5.    ClientHeight    =   615
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   2115
  9.    DefaultCancel   =   -1  'True
  10.    ScaleHeight     =   41
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   141
  13. End
  14. Attribute VB_Name = "axDataButton"
  15. Attribute VB_GlobalNameSpace = False
  16. Attribute VB_Creatable = True
  17. Attribute VB_PredeclaredId = False
  18. Attribute VB_Exposed = False
  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
  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.     Else
  322.       Set picButton = m_Picture
  323.     End If
  324.     
  325.     If Not picButton Is Nothing And m_Caption > "" Then
  326.         'Get the Pictures Width and Height
  327.         iPicWidth = ScaleX(picButton.Width, vbHimetric, vbPixels)
  328.         iPicHeight = ScaleY(picButton.Height, vbHimetric, vbPixels)
  329.  
  330.         'Set locations for the Picture and the Caption
  331.         Select Case m_PictureAlign
  332.         Case vbPicLeft
  333.             iPicLeft = miClientLeft
  334.             iPicTop = miClientTop + (miClientHeight / 2) - (iPicHeight / 2) + 1
  335.             udtTextRect.Top = miClientTop
  336.             udtTextRect.Bottom = miClientTop + miClientHeight
  337.             udtTextRect.Left = miClientLeft + iPicWidth
  338.             udtTextRect.Right = miClientLeft + miClientWidth
  339.         Case vbPicRight
  340.             iPicLeft = miClientLeft + miClientWidth - iPicWidth
  341.             iPicTop = miClientTop + (miClientHeight / 2) - (iPicHeight / 2) + 1
  342.             udtTextRect.Top = miClientTop
  343.             udtTextRect.Bottom = miClientTop + miClientHeight
  344.             udtTextRect.Left = miClientLeft ' + iPicWidth
  345.             udtTextRect.Right = miClientLeft + miClientWidth - iPicWidth
  346.         Case vbPicTop
  347.             iPicLeft = miClientLeft + (miClientWidth / 2) - (iPicWidth / 2) + 1
  348.             iPicTop = miClientTop
  349.             udtTextRect.Top = miClientTop + iPicHeight + iPicTop
  350.             udtTextRect.Bottom = miClientTop + miClientHeight
  351.             udtTextRect.Left = miClientLeft
  352.             udtTextRect.Right = miClientLeft + miClientWidth
  353.         Case vbPicBottom
  354.             iPicLeft = miClientLeft + (miClientWidth / 2) - (iPicWidth / 2) + 1
  355.             iPicTop = miClientTop + miClientHeight - iPicHeight
  356.             udtTextRect.Top = miClientTop
  357.             udtTextRect.Bottom = miClientTop + miClientHeight - iPicHeight
  358.             udtTextRect.Left = miClientLeft
  359.             udtTextRect.Right = miClientLeft + miClientWidth
  360.         End Select
  361.     'kdq 10/19/98 center picture if no caption
  362.     ElseIf Not picButton Is Nothing And m_Caption = "" Then
  363.             'Get the Pictures Width and Height
  364.             iPicWidth = ScaleX(picButton.Width, vbHimetric, vbPixels)
  365.             iPicHeight = ScaleY(picButton.Height, vbHimetric, vbPixels)
  366.             iPicLeft = miClientLeft + (miClientWidth / 2) - (iPicWidth / 2)
  367.             iPicTop = miClientTop + (miClientHeight / 2) - (iPicHeight / 2) + 1
  368.             udtTextRect.Top = miClientTop
  369.             udtTextRect.Bottom = miClientTop + miClientHeight
  370.             udtTextRect.Left = miClientLeft
  371.             udtTextRect.Right = miClientLeft + miClientWidth
  372.     'kdq 10/19/98 center caption if not picture
  373.     ElseIf picButton Is Nothing And m_Caption > "" Then
  374.             udtTextRect.Top = miClientTop
  375.             udtTextRect.Bottom = miClientTop + miClientHeight
  376.             udtTextRect.Left = miClientLeft
  377.             udtTextRect.Right = miClientLeft + miClientWidth
  378.     End If
  379.  
  380.     '10/19/98 kdq the rect values were changed so Standard buttom displays correctly when it has focus
  381.     'Draw The Dotted Focus lines, but not for the soft button
  382.     If m_Style = [Standard Button] Then
  383.         If mbHasFocus Then
  384.             udtRect.Top = udtTextRect.Top    'iTextTop - 1
  385.             udtRect.Left = udtTextRect.Left + 1 'iTextLeft - 1
  386.             udtRect.Right = udtTextRect.Right - 1 'iTextLeft + iTextWidth + 1
  387.             udtRect.Bottom = udtTextRect.Bottom + 1 'iTextTop + iTextHeight + 1
  388.             lReturn = DrawFocusRect(UserControl.hDC, udtRect)
  389.         Else
  390.             UserControl.DrawWidth = 2
  391.             UserControl.Line (miClientLeft - 1, miClientTop - 1)-(miClientLeft + miClientWidth, miClientTop + miClientHeight), vb3DFace, B
  392.             UserControl.DrawWidth = 1
  393.         End If
  394.     End If
  395.  
  396.     'Draw the Picture
  397.     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
  398.         If UserControl.Enabled Then
  399.             'kdq 10/19/98 added GreyScaling for Coolbutton when mouse is not over it (user defined)
  400.             If m_Style = [Cool Button] And Not mbMouseOver And m_ShowFlatGrey Then
  401.                clsPaint.PaintGreyScaleCornerStdPic UserControl.hDC, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0
  402.             Else
  403.                'clsPaint.PaintTransCornerStdPic UserControl.hDC, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0
  404.                clsPaint.PaintTransparentStdPic UserControl.hDC, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0, m_MaskColor
  405.             End If
  406.         Else
  407.             'clsPaint.PaintDisabledCornerStdPic UserControl.hDC, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0
  408.             clsPaint.PaintDisabledStdPic UserControl.hDC, iPicLeft + iDownOffset, iPicTop + iDownOffset, iPicWidth, iPicHeight, picButton, 0, 0, m_MaskColor
  409.         End If
  410.     End If
  411.  
  412.     'Print the caption on the button
  413.     If m_Style = [Cool Button] Or m_Style = [Toolbar Button] Or m_Style = [Standard Button] Or m_Style = [Up-Down Button] Then
  414.         udtTextRect.Top = udtTextRect.Top + iDownOffset ' + (udtTextRect.Top Mod 2)
  415.         udtTextRect.Left = udtTextRect.Left + iDownOffset ' + (udtTextRect.Left Mod 2)
  416.         udtTextRect.Bottom = udtTextRect.Bottom + iDownOffset
  417.         udtTextRect.Right = udtTextRect.Right + iDownOffset
  418.         If UserControl.Enabled Then
  419.             lReturn = DrawText(UserControl.hDC, m_Caption, Len(m_Caption), udtTextRect, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER)
  420.         Else
  421.             UserControl.ForeColor = vbGrayText
  422.             lReturn = DrawText(UserControl.hDC, m_Caption, Len(m_Caption), udtTextRect, DT_CENTER Or DT_SINGLELINE Or DT_VCENTER)
  423.             UserControl.ForeColor = vbButtonText
  424.         End If
  425.     End If
  426.     
  427.     Refresh
  428.     Set clsPaint = Nothing
  429.     Set picButton = Nothing
  430. End Sub
  431.  
  432. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  433. 'MappingInfo=UserControl,UserControl,-1,BackColor
  434. Public Property Get BackColor() As OLE_COLOR
  435. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
  436. Attribute BackColor.VB_UserMemId = -501
  437.     BackColor = UserControl.BackColor
  438. End Property
  439.  
  440. Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  441.     UserControl.BackColor() = New_BackColor
  442.     PropertyChanged "BackColor"
  443.     DrawButton
  444. End Property
  445.  
  446. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  447. 'MappingInfo=UserControl,UserControl,-1,ForeColor
  448. Public Property Get ForeColor() As OLE_COLOR
  449. Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
  450.     ForeColor = UserControl.ForeColor
  451. End Property
  452.  
  453. Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  454.     UserControl.ForeColor() = New_ForeColor
  455.     PropertyChanged "ForeColor"
  456.     DrawButton
  457. End Property
  458.  
  459. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  460. 'MappingInfo=UserControl,UserControl,-1,Enabled
  461. Public Property Get Enabled() As Boolean
  462. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  463.     Enabled = UserControl.Enabled
  464. End Property
  465.  
  466. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  467.     UserControl.Enabled() = New_Enabled
  468.     PropertyChanged "Enabled"
  469.     DrawButton
  470. End Property
  471.  
  472. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  473. 'MappingInfo=UserControl,UserControl,-1,Font
  474. Public Property Get Font() As Font
  475. Attribute Font.VB_Description = "Returns a Font object."
  476. Attribute Font.VB_UserMemId = -512
  477.     Set Font = UserControl.Font
  478. End Property
  479.  
  480. Public Property Set Font(ByVal New_Font As Font)
  481.     Set UserControl.Font = New_Font
  482.     PropertyChanged "Font"
  483.     DrawButton
  484. End Property
  485.  
  486.  
  487. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  488. 'MappingInfo=UserControl,UserControl,-1,Refresh
  489. Public Sub Refresh()
  490. Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
  491.     UserControl.Refresh
  492. End Sub
  493.  
  494. Private Sub ExitTimer_Timer()
  495.     If Not UnderMouse Then Leave
  496. End Sub
  497.  
  498. Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
  499.     'kdq 10/19/98 only Click when control is a button
  500.     If m_Style <> [Seperator] And m_Style <> SeperatorH And m_Style <> [Toolbar Handle] And m_Style <> [Toolbar HandleH] Then RaiseEvent Click
  501. End Sub
  502.  
  503. Private Sub UserControl_AmbientChanged(PropertyName As String)
  504.     If PropertyName = "DisplayAsDefault" Then
  505.         DrawButton
  506.     End If
  507.     
  508. End Sub
  509.  
  510. Private Sub UserControl_DblClick()
  511.     RaiseEvent DblClick
  512. End Sub
  513.  
  514. Private Sub UserControl_EnterFocus()
  515.     mbHasFocus = True
  516.     DrawButton
  517. End Sub
  518.  
  519. Private Sub UserControl_ExitFocus()
  520.     mbHasFocus = False
  521.     DrawButton
  522.     Refresh
  523. End Sub
  524.  
  525. Private Sub UserControl_Initialize()
  526. InitializeUpDownDither
  527. End Sub
  528.  
  529. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  530.     If KeyCode = 32 Then
  531.       miCurrentButtonPressed = 0
  532.       mbButtonDown = True
  533.       DrawButton
  534.     End If
  535.     RaiseEvent KeyDown(KeyCode, Shift)
  536. End Sub
  537.  
  538. Private Sub UserControl_KeyPress(KeyAscii As Integer)
  539.     RaiseEvent KeyPress(KeyAscii)
  540. End Sub
  541.  
  542. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  543.     If KeyCode = 32 Then
  544.       miCurrentButtonPressed = -1
  545.       mbButtonDown = False
  546.       DrawButton
  547.       'kdq 10/19/98 only Click when control is a button
  548.        If m_Style <> [Seperator] And m_Style <> SeperatorH And m_Style <> [Toolbar Handle] And m_Style <> [Toolbar HandleH] Then RaiseEvent Click
  549.     End If
  550.     RaiseEvent KeyUp(KeyCode, Shift)
  551. End Sub
  552.  
  553. Private Sub UserControl_LostFocus()
  554.     mbHasFocus = False
  555.     DrawButton
  556. End Sub
  557.  
  558. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  559.     If m_DropDown Then
  560.         If x > (UserControl.ScaleWidth - 11) Then
  561.             mbDropDownPressed = True
  562.             miCurrentButtonPressed = 1
  563.         Else
  564.             mbButtonDown = True
  565.             miCurrentButtonPressed = 0
  566.         End If
  567.     Else
  568.         mbButtonDown = True
  569.         miCurrentButtonPressed = 0
  570.     End If
  571.     mbMouseDown = True
  572.     DrawButton
  573.     RaiseEvent MouseDown(Button, Shift, x, y)
  574. End Sub
  575.  
  576. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  577.     If Button = 1 Then
  578.         If (x < 0 Or y < 0 Or x >= UserControl.ScaleWidth Or y >= UserControl.ScaleHeight) Then
  579.             If miCurrentButtonPressed = 0 Then
  580.                 mbButtonDown = False
  581.             Else
  582.                 mbDropDownPressed = False
  583.             End If
  584.             DrawButton
  585.         Else
  586.             If miCurrentButtonPressed = 0 Then
  587.                 mbButtonDown = True
  588.             Else
  589.                 mbDropDownPressed = True
  590.             End If
  591.             DrawButton
  592.         End If
  593.     End If
  594.     
  595.     If mbMouseOver Then
  596.         If Not UnderMouse Then
  597.             Leave
  598.         End If
  599.     Else
  600.         If UnderMouse Then
  601.             mbMouseOver = True
  602.             RaiseEvent MouseEnter
  603.             DrawButton
  604.             
  605.             'Set up the ExitTimer
  606.             Set ExitTimer = New objTimer
  607.             ExitTimer.Interval = 50
  608.             ExitTimer.Enabled = True
  609.         End If
  610.     End If
  611.     RaiseEvent MouseMove(Button, Shift, x, y)
  612. End Sub
  613.  
  614. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  615.     Dim bOverButton As Boolean
  616.     
  617.     RaiseEvent MouseUp(Button, Shift, x, y)
  618.     
  619.     'Check the position of the mouse when in was released.
  620.     'We only want to call the click events when the
  621.     'mouse was released over the button.
  622.     If (x < 0 Or y < 0 Or x >= UserControl.ScaleWidth Or y >= UserControl.ScaleHeight) Then
  623.         bOverButton = False
  624.     Else
  625.         bOverButton = True
  626.     End If
  627.     
  628.     If miCurrentButtonPressed = 1 Then
  629.         If bOverButton And x > (UserControl.ScaleWidth - 10) Then RaiseEvent DropDownClick
  630.     End If
  631.     mbButtonDown = False
  632.     mbDropDownPressed = False
  633.     mbMouseDown = False
  634.     
  635.     If m_Style = [Up-Down Button] Then
  636.         m_Value = Not m_Value
  637.         CheckButtonGroup
  638.     End If
  639.     
  640.     DrawButton
  641.     If miCurrentButtonPressed = 0 Then
  642.         If bOverButton And x < (UserControl.ScaleWidth - 10) And m_DropDown Then
  643.                 'kdq 10/19/98 only Click when control is a button
  644.                 If m_Style <> [Seperator] And m_Style <> SeperatorH And m_Style <> [Toolbar Handle] And m_Style <> [Toolbar HandleH] Then RaiseEvent Click
  645.         'kdq 10/19/98 added this because click event wasnt firing for nondropdown buttons all the time
  646.         ElseIf bOverButton And Not m_DropDown Then
  647.                 'kdq 10/19/98 only Click when control is a button
  648.                 If m_Style <> [Seperator] And m_Style <> SeperatorH And m_Style <> [Toolbar Handle] And m_Style <> [Toolbar HandleH] Then RaiseEvent Click
  649.         End If
  650.     End If
  651.     miCurrentButtonPressed = -1
  652.     DrawButton          ' added so flatbutton gets redrawn
  653. End Sub
  654.  
  655. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  656. 'MemberInfo=11,0,0,0
  657. Public Property Get Picture() As Picture
  658. Attribute Picture.VB_Description = "Image to be displayed on the button."
  659.     Set Picture = m_Picture
  660. End Property
  661.  
  662. Public Property Set Picture(ByVal New_Picture As Picture)
  663.     Set m_Picture = New_Picture
  664.     PropertyChanged "Picture"
  665.     DrawButton
  666. End Property
  667.  
  668. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  669. 'MemberInfo=7,0,0,0
  670. Public Property Get PictureAlign() As envbuPictureAlign
  671. Attribute PictureAlign.VB_Description = "Specifies alignment of the picture property."
  672.     PictureAlign = m_PictureAlign
  673. End Property
  674.  
  675. Public Property Let PictureAlign(ByVal New_PictureAlign As envbuPictureAlign)
  676.     m_PictureAlign = New_PictureAlign
  677.     PropertyChanged "PictureAlign"
  678.     DrawButton
  679. End Property
  680.  
  681. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  682. 'MemberInfo=13,0,0,
  683. Public Property Get Caption() As String
  684. Attribute Caption.VB_Description = "Text displayed on the face of the button."
  685. Attribute Caption.VB_UserMemId = -518
  686.     Caption = m_Caption
  687. End Property
  688.  
  689. Public Property Let Caption(ByVal New_Caption As String)
  690.     m_Caption = New_Caption
  691.     PropertyChanged "Caption"
  692.     SetAccessKey
  693.     DrawButton
  694. End Property
  695. Private Sub SetAccessKey()
  696.     Dim iPos As Integer
  697.     Dim sChar As String
  698.     
  699.     iPos = InStr(1, m_Caption, "&")
  700.     If iPos > 0 Then
  701.         sChar = Mid$(m_Caption, iPos + 1, 1)
  702.         If sChar <> "&" Then
  703.             UserControl.AccessKeys = LCase(sChar)
  704.         End If
  705.     End If
  706. End Sub
  707. 'Initialize Properties for User Control
  708. Private Sub UserControl_InitProperties()
  709.     Set UserControl.Font = Ambient.Font
  710.     Set m_Picture = Nothing
  711.     Set m_FlatPicture = Nothing
  712.     Set m_DownPicture = Nothing
  713.     m_PictureAlign = m_def_PictureAlign
  714.     m_Caption = m_def_Caption
  715.     m_MaskColor = m_def_MaskColor
  716.     m_Style = m_def_Style
  717.     m_Value = False
  718.     m_DropDown = m_def_DropDown
  719.     m_ButtonFace = vbButtonFace
  720.     m_ButtonLightShadow = vbButtonShadow
  721.     m_ButtonDarkShadow = vb3DDKShadow
  722.     m_ButtonHighlight = vb3DHighlight
  723.     m_ShowFlatGrey = False
  724.     m_ButtonGroup = m_def_ButtonGroup
  725.     m_ButtonGroupDefault = m_def_ButtonGroupDefault
  726.     m_ButtonGroupDefault2 = m_def_ButtonGroupDefault2
  727.     
  728.     miCurrentButtonPressed = -1
  729.     mbMouseOver = False
  730.     mbButtonDown = False
  731.     mbMouseDown = False
  732.     mbHasFocus = False
  733.     mbDropDownPressed = False
  734.     End Sub
  735.  
  736. Private Sub UserControl_Paint()
  737.     DrawButton
  738. End Sub
  739.  
  740. 'Load property values from storage
  741. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  742.  
  743.     UserControl.BackColor = PropBag.ReadProperty("BackColor", &H8000000F)
  744.     UserControl.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
  745.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  746.     Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
  747. '    UserControl.BackStyle = PropBag.ReadProperty("BackStyle", 1)
  748. '    UserControl.BorderStyle = PropBag.ReadProperty("BorderStyle", 0)
  749.     Set m_Picture = PropBag.ReadProperty("Picture", Nothing)
  750.     Set m_DownPicture = PropBag.ReadProperty("DownPicture", Nothing)
  751.     Set m_FlatPicture = PropBag.ReadProperty("FlatPicture", Nothing)
  752.     m_PictureAlign = PropBag.ReadProperty("PictureAlign", m_def_PictureAlign)
  753.     m_Caption = PropBag.ReadProperty("Caption", m_def_Caption)
  754.     m_MaskColor = PropBag.ReadProperty("MaskColor", &HC0C0C0)
  755.     m_Style = PropBag.ReadProperty("Style", m_def_Style)
  756.     m_DropDown = PropBag.ReadProperty("DropDown", m_def_DropDown)
  757.     m_ButtonDarkShadow = PropBag.ReadProperty("ColorDarkShadow", vb3DDKShadow)
  758.     m_ButtonLightShadow = PropBag.ReadProperty("ColorLightShadow", vbButtonShadow)
  759.     m_ButtonHighlight = PropBag.ReadProperty("ColorHighlight", vb3DHighlight)
  760.     m_ShowFlatGrey = PropBag.ReadProperty("ShowFlatGrey", False)
  761.     m_ButtonGroup = PropBag.ReadProperty("ButtonGroup", m_def_ButtonGroup)
  762.     m_ButtonGroupDefault = PropBag.ReadProperty("ButtonGroupDefault", m_def_ButtonGroupDefault)
  763.     m_ButtonGroupDefault2 = PropBag.ReadProperty("ButtonGroupDefault2", m_def_ButtonGroupDefault2)
  764.     m_Value = PropBag.ReadProperty("Value", False)
  765.  
  766.     SetAccessKey
  767.     miCurrentButtonPressed = -1
  768.     DrawButton
  769. End Sub
  770.  
  771. Private Sub UserControl_Resize()
  772.     DrawButton
  773. End Sub
  774.  
  775. 'Write property values to storage
  776. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  777.  
  778.     Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H8000000F)
  779.     Call PropBag.WriteProperty("ForeColor", UserControl.ForeColor, &H80000012)
  780.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  781.     Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
  782. '    Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 1)
  783. '    Call PropBag.WriteProperty("BorderStyle", UserControl.BorderStyle, 0)
  784.     Call PropBag.WriteProperty("Picture", m_Picture, Nothing)
  785.     Call PropBag.WriteProperty("DownPicture", m_DownPicture, Nothing)
  786.     Call PropBag.WriteProperty("FlatPicture", m_FlatPicture, Nothing)
  787.     Call PropBag.WriteProperty("PictureAlign", m_PictureAlign, m_def_PictureAlign)
  788.     Call PropBag.WriteProperty("Caption", m_Caption, m_def_Caption)
  789.     Call PropBag.WriteProperty("MaskColor", m_MaskColor, &HC0C0C0)
  790.     Call PropBag.WriteProperty("Style", m_Style, m_def_Style)
  791.     Call PropBag.WriteProperty("DropDown", m_DropDown, m_def_DropDown)
  792.     Call PropBag.WriteProperty("ColorDarkShadow", m_ButtonDarkShadow, vb3DDKShadow)
  793.     Call PropBag.WriteProperty("ColorLightShadow", m_ButtonLightShadow, vbButtonShadow)
  794.     Call PropBag.WriteProperty("ColorHighlight", m_ButtonHighlight, vb3DHighlight)
  795.     Call PropBag.WriteProperty("ShowFlatGrey", m_ShowFlatGrey, False)
  796.     Call PropBag.WriteProperty("ButtonGroup", m_ButtonGroup, m_def_ButtonGroup)
  797.     Call PropBag.WriteProperty("ButtonGroupDefault", m_ButtonGroupDefault, m_def_ButtonGroupDefault)
  798.     Call PropBag.WriteProperty("ButtonGroupDefault2", m_ButtonGroupDefault2, m_def_ButtonGroupDefault2)
  799.     Call PropBag.WriteProperty("Value", m_Value, False)
  800. End Sub
  801.  
  802. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  803. 'MemberInfo=10,0,0,0
  804. Public Property Get MaskColor() As OLE_COLOR
  805. Attribute MaskColor.VB_Description = "Sets/gets mask color to use when drawing picture"
  806.     MaskColor = m_MaskColor
  807. End Property
  808.  
  809. Public Property Let MaskColor(ByVal New_MaskColor As OLE_COLOR)
  810.     m_MaskColor = New_MaskColor
  811.     PropertyChanged "MaskColor"
  812.     DrawButton
  813. End Property
  814.  
  815. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  816. 'MemberInfo=7,0,0,0
  817. Public Property Get Style() As vbuStyle
  818. Attribute Style.VB_Description = "Gets/Sets the style of the button"
  819.     Style = m_Style
  820. End Property
  821.  
  822. Public Property Let Style(ByVal New_Style As vbuStyle)
  823.     m_Style = New_Style
  824.     PropertyChanged "Style"
  825.     DrawButton
  826. End Property
  827.  
  828. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  829. 'MemberInfo=0,0,0,False
  830. Public Property Get DropDown() As Boolean
  831. Attribute DropDown.VB_Description = "Determines whether or not to display the Drop Down Button."
  832.     DropDown = m_DropDown
  833. End Property
  834.  
  835. Public Property Let DropDown(ByVal New_DropDown As Boolean)
  836.     m_DropDown = New_DropDown
  837.     PropertyChanged "DropDown"
  838.     DrawButton
  839. End Property
  840.  
  841. 'kdq 10/19/98 added for seperator/handle
  842. Private Sub DrawVLine(ByVal x As Single, ByVal y As Single, ByVal cx As Single, ByVal cy As Single)
  843.     Line (x + 1, y)-(x + 1, y + cy), m_ButtonHighlight
  844.     Line (x, y)-(x, y + cy), m_ButtonLightShadow
  845. End Sub
  846.  
  847. 'kdq 11/03/98 added for seperator/handle
  848. Private Sub DrawHLine(ByVal x As Single, ByVal y As Single, ByVal cx As Single, ByVal cy As Single)
  849.     Line (x, y + 1)-(x + cx, y + 1), m_ButtonHighlight
  850.     Line (x, y)-(x + cx, y), m_ButtonLightShadow
  851. End Sub
  852.  
  853. 'kdq 10/19/98 added for seperator/handle
  854. Private Sub DrawRaisedVLine(ByVal x As Single, ByVal y As Single, ByVal cx As Single, ByVal cy As Single)
  855.     Line (x, y)-(x, y + cy), m_ButtonHighlight
  856.     Line (x + 1, y)-(x + 1, y + cy), m_ButtonHighlight
  857.     Line (x + 2, y)-(x + 2, y + cy), m_ButtonHighlight
  858.     Line (x, y + 1)-(x, y + cy), m_ButtonLightShadow
  859.     Line (x + 1, y + 1)-(x + 1, y + cy), m_ButtonLightShadow
  860.     Line (x + 2, y + 1)-(x + 2, y + cy), m_ButtonLightShadow
  861.     Line (x, y)-(x, y + cy - 1), m_ButtonHighlight
  862.     Line (x + 1, y + 1)-(x + 1, y + cy - 1), m_ButtonFace
  863. End Sub
  864.  
  865. 'kdq 11/03/98 added for seperator/handle
  866. Private Sub DrawRaisedHLine(ByVal x As Single, ByVal y As Single, ByVal cx As Single, ByVal cy As Single)
  867.     Line (x, y)-(x + cx, y), m_ButtonHighlight
  868.     Line (x, y + 1)-(x + cx, y + 1), m_ButtonHighlight
  869.     Line (x, y + 2)-(x + cx, y + 2), m_ButtonHighlight
  870.     Line (x + 1, y)-(x + cx, y), m_ButtonLightShadow
  871.     Line (x + 1, y + 1)-(x + cx, y + 1), m_ButtonLightShadow
  872.     Line (x + 1, y + 2)-(x + cx, y + 2), m_ButtonLightShadow
  873.     Line (x, y)-(x + cx - 1, y), m_ButtonHighlight
  874.     Line (x + 1, y + 1)-(x + cx - 1, y + 1), m_ButtonFace
  875. End Sub
  876.  
  877. 'kdq 10/19/98 added to make thinner border for CoolButton
  878. Private Sub DrawShadowBox(RectSize As RECT, ByVal Pressed As Boolean, ByVal DKShadow As Boolean)
  879.     Dim x As Integer, y As Integer, cx As Integer, cy As Integer
  880.     x = RectSize.Left
  881.     y = RectSize.Top
  882.     cx = RectSize.Right
  883.     cy = RectSize.Bottom
  884.     
  885.     If DKShadow Then
  886.         If Pressed Then
  887.             Line (x, y)-(x + cx - 1, y), m_ButtonDarkShadow
  888.             Line (x, y)-(x, y + cy - 1), m_ButtonDarkShadow
  889.             Line (x + 1, y + 1)-(x + cx - 2, y + 1), m_ButtonLightShadow
  890.             Line (x + 1, y + 1)-(x + 1, y + cy - 2), m_ButtonLightShadow
  891.             Line (x + cx - 1, y)-(x + cx - 1, y + cy), m_ButtonHighlight
  892.             Line (x, y + cy - 1)-(x + cx, y + cy - 1), m_ButtonHighlight
  893.         Else
  894.             Line (x, y)-(x + cx - 1, y), m_ButtonHighlight
  895.             Line (x, y)-(x, y + cy - 1), m_ButtonHighlight
  896.             Line (x + cx - 2, y + 1)-(x + cx - 2, y + cy - 1), m_ButtonLightShadow
  897.             Line (x + 1, y + cy - 2)-(x + cx - 1, y + cy - 2), m_ButtonLightShadow
  898.             Line (x + cx - 1, y)-(x + cx - 1, y + cy), m_ButtonDarkShadow
  899.             Line (x, y + cy - 1)-(x + cx, y + cy - 1), m_ButtonDarkShadow
  900.         End If
  901.     Else
  902.         Dim Color1 As Long
  903.         Dim Color2 As Long
  904.         If Pressed Then
  905.             Color1 = m_ButtonLightShadow
  906.             Color2 = m_ButtonHighlight
  907.         Else
  908.             Color1 = m_ButtonHighlight
  909.             Color2 = m_ButtonLightShadow
  910.         End If
  911.         Line (x, y)-(x + cx - 1, y), Color1
  912.         Line (x, y)-(x, y + cy - 1), Color1
  913.         Line (x + cx - 1, y)-(x + cx - 1, y + cy), Color2
  914.         Line (x, y + cy - 1)-(x + cx, y + cy - 1), Color2
  915.     End If
  916. End Sub
  917.  
  918. Public Property Get ColorLightShadow() As OLE_COLOR
  919. Attribute ColorLightShadow.VB_Description = "Sets/gets color of border light shadow"
  920.     ColorLightShadow = m_ButtonLightShadow
  921. End Property
  922.  
  923. Public Property Let ColorLightShadow(ByVal New_Value As OLE_COLOR)
  924.     If Not (m_ButtonLightShadow = New_Value) Then
  925.         m_ButtonLightShadow = New_Value
  926.         DrawButton
  927.     End If
  928.     PropertyChanged "ColorLightShadow"
  929. End Property
  930.  
  931. 'kdq 10/19/98
  932. Public Property Get ColorDarkShadow() As OLE_COLOR
  933. Attribute ColorDarkShadow.VB_Description = "Sets/gets color of border 3D dark shadow"
  934.     ColorDarkShadow = m_ButtonDarkShadow
  935. End Property
  936.  
  937. Public Property Let ColorDarkShadow(ByVal New_Value As OLE_COLOR)
  938.     If Not (m_ButtonDarkShadow = New_Value) Then
  939.         m_ButtonDarkShadow = New_Value
  940.         DrawButton
  941.     End If
  942.     PropertyChanged "ColorDarkShadow"
  943. End Property
  944.  
  945. 'kdq 10/19/98
  946. Public Property Get ColorHighlight() As OLE_COLOR
  947. Attribute ColorHighlight.VB_Description = "Sets/gets color of border 3D highlight"
  948.     ColorHighlight = m_ButtonHighlight
  949. End Property
  950.  
  951. Public Property Let ColorHighlight(ByVal New_Value As OLE_COLOR)
  952.     If Not (m_ButtonHighlight = New_Value) Then
  953.         m_ButtonHighlight = New_Value
  954.         DrawButton
  955.     End If
  956.     PropertyChanged "ColorHighlight"
  957. End Property
  958.  
  959. 'kdq 10/19/98
  960. Public Sub ShowAbout()
  961. Attribute ShowAbout.VB_Description = "Show about box"
  962. Attribute ShowAbout.VB_UserMemId = -552
  963.     frmAbout.Show vbModal
  964. End Sub
  965.  
  966. 'kdq 10/19/98 picture to display when mousedown on cool button
  967. Public Property Get DownPicture() As Picture
  968. Attribute DownPicture.VB_Description = "Sets/gets picture to be displayed if button is pushed"
  969.     Set DownPicture = m_DownPicture
  970. End Property
  971.  
  972. Public Property Set DownPicture(ByVal New_DownPicture As Picture)
  973.     Set m_DownPicture = New_DownPicture
  974.     PropertyChanged "DownPicture"
  975. End Property
  976.  
  977. 'kdq 10/19/98 picture to display when mouse is not over button on cool button
  978. Public Property Get FlatPicture() As Picture
  979. Attribute FlatPicture.VB_Description = "Sets/gets picture to display when mouse is not over button (Cool button only)"
  980.     Set FlatPicture = m_FlatPicture
  981. End Property
  982.  
  983. Public Property Set FlatPicture(ByVal New_FlatPicture As Picture)
  984.     Set m_FlatPicture = New_FlatPicture
  985.     DrawButton
  986.     PropertyChanged "FlatPicture"
  987. End Property
  988.  
  989. 'kdq 10/19/98 display picture as greyscale when mouse is not over Cool Button
  990. Public Property Get ShowFlatGrey() As Boolean
  991. Attribute ShowFlatGrey.VB_Description = "Sets/gets a value to determine if picture is drawn in greyscale when mouse is not over button"
  992.     ShowFlatGrey = m_ShowFlatGrey
  993. End Property
  994.  
  995. Public Property Let ShowFlatGrey(ByVal New_Value As Boolean)
  996.     m_ShowFlatGrey = New_Value
  997.     PropertyChanged "DropDown"
  998.     DrawButton
  999. End Property
  1000.  
  1001. Public Property Get ButtonGroup() As String
  1002.     ButtonGroup = m_ButtonGroup
  1003. End Property
  1004.  
  1005. Public Property Let ButtonGroup(ByVal New_ButtonGroup As String)
  1006.     If Not (m_ButtonGroup = New_ButtonGroup) Then
  1007.         m_ButtonGroup = New_ButtonGroup
  1008.         If m_Style = [Up-Down Button] Then
  1009.             CheckButtonGroup
  1010.             Cls
  1011.             UserControl_Paint
  1012.         End If
  1013.     End If
  1014.     PropertyChanged "ButtonGroup"
  1015. End Property
  1016.  
  1017. Public Property Get ButtonGroupDefault() As Boolean
  1018.     ButtonGroupDefault = m_ButtonGroupDefault
  1019. End Property
  1020.  
  1021. Public Property Let ButtonGroupDefault(ByVal New_ButtonGroupDefault As Boolean)
  1022.     'The following line of code ensures that the integer
  1023.     'value of the boolean parameter is either
  1024.     '0 or -1.  It is known that Access 97 will
  1025.     'set the boolean's value to 255 for true.
  1026.     'In this case a P-Code compiled VB5 built
  1027.     'OCX will return True for the expression
  1028.     '(Not [boolean variable that ='s 255]).  This
  1029.     'line ensures the reliability of boolean operations
  1030.     If CBool(New_ButtonGroupDefault) Then New_ButtonGroupDefault = True Else New_ButtonGroupDefault = False
  1031.     If Not (m_ButtonGroupDefault = New_ButtonGroupDefault) Then
  1032.         m_ButtonGroupDefault = New_ButtonGroupDefault
  1033.         If m_Style = [Up-Down Button] Then
  1034.             CheckButtonGroupDefault
  1035.             CheckButtonGroup
  1036.             Cls
  1037.             UserControl_Paint
  1038.         End If
  1039.     End If
  1040.     PropertyChanged "ButtonGroupDefault"
  1041. End Property
  1042.  
  1043. Private Sub CheckButtonGroupDefault()
  1044.     If (Len(m_ButtonGroup) > 0) Then
  1045.         If m_ButtonGroupDefault Then     ' make all others in group not default
  1046.             Dim ctl As Control
  1047.             Dim i As Long
  1048.             For i = 0 To UserControl.ParentControls.Count - 1
  1049.                 If TypeOf UserControl.ParentControls(i) Is Control Then
  1050.                     Set ctl = UserControl.ParentControls(i)
  1051.                     If TypeOf ctl Is axDataButton Then
  1052.                         If ctl.ButtonGroup = m_ButtonGroup Then
  1053.                             If Not ((ctl Is UserControl.Extender) Or (ctl Is UserControl)) Then
  1054.                                 ctl.ButtonGroupDefault = False
  1055.                             End If
  1056.                         End If
  1057.                     End If
  1058.                 End If
  1059.             Next
  1060.         End If
  1061.     End If
  1062. End Sub
  1063.  
  1064. Public Property Get ButtonGroupDefault2() As Boolean
  1065.     ButtonGroupDefault2 = m_ButtonGroupDefault2
  1066. End Property
  1067.  
  1068. Public Property Let ButtonGroupDefault2(ByVal New_ButtonGroupDefault2 As Boolean)
  1069.     'The following line of code ensures that the integer
  1070.     'value of the boolean parameter is either
  1071.     '0 or -1.  It is known that Access 97 will
  1072.     'set the boolean's value to 255 for true.
  1073.     'In this case a P-Code compiled VB5 built
  1074.     'OCX will return True for the expression
  1075.     '(Not [boolean variable that ='s 255]).  This
  1076.     'line ensures the reliability of boolean operations
  1077.     If CBool(New_ButtonGroupDefault2) Then New_ButtonGroupDefault2 = True Else New_ButtonGroupDefault2 = False
  1078.     If Not (m_ButtonGroupDefault2 = New_ButtonGroupDefault2) Then
  1079.         m_ButtonGroupDefault2 = New_ButtonGroupDefault2
  1080.         If m_Style = [Up-Down Button] Then
  1081.             CheckButtonGroupDefault2
  1082.             CheckButtonGroup
  1083.             Cls
  1084.             UserControl_Paint
  1085.         End If
  1086.     End If
  1087.     PropertyChanged "ButtonGroupDefault2"
  1088. End Property
  1089.  
  1090. Private Sub CheckButtonGroupDefault2()
  1091.     If (Len(m_ButtonGroup) > 0) Then
  1092.         If m_ButtonGroupDefault2 Then     ' make all others in group not default
  1093.             Dim ctl As Control
  1094.             Dim i As Long
  1095.             For i = 0 To UserControl.ParentControls.Count - 1
  1096.                 If TypeOf UserControl.ParentControls(i) Is Control Then
  1097.                     Set ctl = UserControl.ParentControls(i)
  1098.                     If TypeOf ctl Is axDataButton Then
  1099.                         If ctl.ButtonGroup = m_ButtonGroup Then
  1100.                             If Not ((ctl Is UserControl.Extender) Or (ctl Is UserControl)) Then
  1101.                                 ctl.ButtonGroupDefault2 = False
  1102.                             End If
  1103.                         End If
  1104.                     End If
  1105.                 End If
  1106.             Next
  1107.         End If
  1108.     End If
  1109. End Sub
  1110.  
  1111. Private Sub CheckButtonGroup()
  1112.     If (Len(m_ButtonGroup) > 0) Then
  1113.         Dim ctl As Control
  1114.         Dim i As Long
  1115.         If m_Value Then     ' clear all others in group
  1116.             For i = 0 To UserControl.ParentControls.Count - 1
  1117.                 If TypeOf UserControl.ParentControls(i) Is Control Then
  1118.                     Set ctl = UserControl.ParentControls(i)
  1119.                     If TypeOf ctl Is axDataButton Then
  1120.                         If ctl.ButtonGroup = m_ButtonGroup Then
  1121.                             If Not ((ctl Is UserControl.Extender) Or (ctl Is UserControl)) Then
  1122.                                 ctl.Value = False
  1123.                             End If
  1124.                         End If
  1125.                     End If
  1126.                 End If
  1127.             Next
  1128.         Else                 ' set group default if necessary
  1129.             Dim GroupValueSet As Boolean
  1130.             Dim ctlDefault As axDataButton
  1131.             Dim ctlDefault2 As axDataButton
  1132.             Set ctlDefault = Nothing
  1133.             Set ctlDefault2 = Nothing
  1134.             GroupValueSet = False
  1135.             For i = 0 To UserControl.ParentControls.Count - 1
  1136.                 If TypeOf UserControl.ParentControls(i) Is Control Then
  1137.                     Set ctl = UserControl.ParentControls(i)
  1138.                     If TypeOf ctl Is axDataButton Then
  1139.                         If ctl.ButtonGroup = m_ButtonGroup Then
  1140. '                            If Not ((ctl Is UserControl.Extender) Or (ctl Is UserControl)) Then
  1141.                                 If ctl.Value Then
  1142.                                     GroupValueSet = True
  1143.                                     Exit For
  1144.                                 ElseIf ctl.ButtonGroupDefault Then
  1145.                                     Set ctlDefault = ctl
  1146.                                 ElseIf ctl.ButtonGroupDefault2 Then
  1147.                                     Set ctlDefault2 = ctl
  1148.                                 End If
  1149. '                            End If
  1150.                         End If
  1151.                     End If
  1152.                 End If
  1153.             Next
  1154.             If Not (GroupValueSet Or (ctlDefault Is Nothing)) Then
  1155.                 If (Not m_ButtonGroupDefault) Or (ctlDefault2 Is Nothing) Then
  1156.                     ctlDefault.Value = True
  1157.                 Else
  1158.                     ctlDefault2.Value = True
  1159.                 End If
  1160.             End If
  1161.         End If
  1162.     End If
  1163. End Sub
  1164.  
  1165. Public Property Get Value() As Boolean
  1166.     Value = m_Value
  1167. End Property
  1168.  
  1169. Public Property Let Value(ByVal New_Value As Boolean)
  1170.     'The following line of code ensures that the integer
  1171.     'value of the boolean parameter is either
  1172.     '0 or -1.  It is known that Access 97 will
  1173.     'set the boolean's value to 255 for true.
  1174.     'In this case a P-Code compiled VB5 built
  1175.     'OCX will return True for the expression
  1176.     '(Not [boolean variable that ='s 255]).  This
  1177.     'line ensures the reliability of boolean operations
  1178.     If CBool(New_Value) Then New_Value = True Else New_Value = False
  1179.     If Not (m_Value = New_Value) Then
  1180.         m_Value = New_Value
  1181.         If m_Style = [Up-Down Button] Then
  1182.             CheckButtonGroup
  1183.             Cls
  1184.             UserControl_Paint
  1185.         End If
  1186.     End If
  1187.     PropertyChanged "Value"
  1188. End Property
  1189.  
  1190. Private Sub PaintUpDownDither(x As Long, y As Long, Width As Long, Height As Long)
  1191.     Dim ret As Long
  1192.     Dim MyRect As RECT
  1193.     'draw on the form with that brush
  1194.     MyRect.Left = x
  1195.     MyRect.Top = y
  1196.     MyRect.Right = x + Width
  1197.     MyRect.Bottom = y + Height
  1198.     ret = FillRect(UserControl.hDC, MyRect, hUpDownDitherBrush)
  1199. End Sub
  1200.  
  1201. Private Sub InitializeUpDownDither()
  1202.     Dim i As Long, j As Long
  1203.     
  1204.     '---one-time setup: put this in it's own routine------
  1205.     'set (invisible) picturebox properties for creating a brush
  1206. '    UserControl.ScaleMode = vbPixels
  1207. '    UserControl.AutoRedraw = True
  1208.     'draw the dither in it
  1209.     For i = 0 To UserControl.ScaleWidth - 1
  1210.         For j = 0 To UserControl.ScaleHeight - 1
  1211.             If (i + j) Mod 2 Then
  1212.                 UserControl.PSet (i, j), vb3DHighlight
  1213.             Else
  1214.                 UserControl.PSet (i, j), vbButtonFace
  1215.             End If
  1216.         Next j
  1217.     Next i
  1218.     '---end of one-time setup------
  1219.  
  1220.     'create the brush from it
  1221.     hUpDownDitherBrush = CreatePatternBrush(UserControl.Image.handle)
  1222.  
  1223. End Sub
  1224.  
  1225.