home *** CD-ROM | disk | FTP | other *** search
/ io Programmo 27 / IOPROG_27.ISO / SOFT / DATABASE.ZIP / AxButtonCombo / axButton.ctl < prev    next >
Encoding:
Visual Basic user-defined control file  |  1999-05-14  |  47.5 KB  |  1,222 lines

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