home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / LaVolpe_Cu2144722212009.psc / CustomButton.ctl < prev   
Text File  |  2009-02-21  |  62KB  |  1,183 lines
  1. VERSION 5.00
  2. Begin VB.UserControl CustomButton 
  3.    ClientHeight    =   915
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   1860
  7.    DefaultCancel   =   -1  'True
  8.    ScaleHeight     =   61
  9.    ScaleMode       =   3  'Pixel
  10.    ScaleWidth      =   124
  11. End
  12. Attribute VB_Name = "CustomButton"
  13. Attribute VB_GlobalNameSpace = False
  14. Attribute VB_Creatable = True
  15. Attribute VB_PredeclaredId = False
  16. Attribute VB_Exposed = False
  17. Option Explicit
  18. ' This instance of the template has drawing routines for the sample project
  19. ' The other instance in your zip file under the ResuableTemplate folder does not and is strictly a bare-bones template
  20.  
  21. ' Update History:
  22. ' 18 Feb 09:
  23. '   :: Added support for buttons that have the Default property set to True
  24. '   :: Reworked UpdateState & DrawButton routines to minimize unnecessary paints even more
  25. '   :: Added the Value property to replicate VB button's Value property
  26. '   :: Events should be triggered after drawing, not before; missed in previous updates
  27. '   :: Retweaked 1Jan09 patch: the patch did not account for preventing double clicks in the same scenario
  28. ' 1 Jan 09: Fixed anamoly that would fire click event if spacebar held down on button and mouse clicks outside of button
  29. ' 27 Sep 07: Not all events related to a click (btn down/up/click/etc) were in same order as VB's command button. Now are.
  30. ' 1 Jan 09: Bug noted by Juned Chippa. Focus button, press spacebar, click mouse elsewhere off button, release spacebar: Click event
  31. '   This is not consistent with VB's command button. UpdateState modified to look for the mouse down in this case.
  32.  
  33. '-------------------------------------------------------------------------------------------------
  34. ' Add additional declarations, types, constants & enumerations here:
  35.  
  36.  
  37. '-------------------------------------------------------------------------------------------------
  38. ' The following are existing properties on a command button. They are
  39. ' for reference only. You would need to add property code for these &
  40. ' also read/cache them in the ReadProperties & WriteProperties events.
  41. ' Those you don't need, simply delete/rem them out. Otherwise, each
  42. ' of these should map to the the same property in your UserControl
  43.  
  44. ' Tip. If adding these to your custom button, most do not need to be cached
  45. ' as separate variables if they will be applied to your usercontrol. Instead,
  46. ' set and cache the property directly to the usercontrol. For an example, see the
  47. ' coded Public Enabled Property, Usercontrol_ReadProperty & WriteProperty routines
  48.  
  49. 'Private m_Appearance As Integer   ' either 0=Flat, 1=3D
  50. 'Private m_BackColor As Long
  51. 'Private m_Font As StdFont
  52. 'Private m_Picture As StdPicture
  53. 'Private m_DisabledPicture As StdPicture
  54. 'Private m_DownPicture As StdPicture
  55. 'Private m_MouseIcon As StdPicture
  56. 'Private m_MousePointer As MousePointerConstants
  57. 'Private m_OLEdropMode As Integer ' either 0=None, 1=Manual
  58. '' The following are also command button properties but are
  59. '' properties not exposed in the IDE property page.
  60. 'Private m_FontBold As Boolean       ' m_Font.Bold
  61. 'Private m_FontIalic As Boolean      ' m_Font.Italic
  62. 'Private m_FontName As String        ' m_Font.Name
  63. 'Private m_FontSize As Single        ' m_Font.Size
  64. 'Private m_FontStrikethru As Boolean ' m_Font.Strikethrough
  65. 'Private m_FontUnderline As Boolean  ' m_Font.Underline
  66. '-------------------------------------------------------------------------------------------------
  67.  
  68.  
  69. ' BUTTON TEMPLATE CODE BETWEEN SLASHES -- DO NOT DELETE
  70. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  71. ' Note: You may not need nor want to expose every Public event to the user.
  72. ' The below events are the same ones that a VB Command Button exposes.
  73. ' Simply remove the ones you don't want & also remove any coded RaiseEvent calls to those events
  74.  
  75. Public Event MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  76. Public Event MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  77. Public Event MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  78. Public Event KeyDown(KeyCode As Integer, Shift As Integer)
  79. Public Event KeyUp(KeyCode As Integer, Shift As Integer)
  80. Public Event KeyPress(KeyAscii As Integer)
  81. Public Event OLECompleteDrag(Effect As Long)
  82. Public Event OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
  83. Public Event OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
  84. Public Event OLEGiveFeedback(Effect As Long, DefaultCursors As Boolean)
  85. Public Event OLESetData(Data As DataObject, DataFormat As Integer)
  86. Public Event OLEStartDrag(Data As DataObject, AllowedEffects As Long)
  87. Public Event Click() ' note: not fired in Usercontrol_Click event. Fired in UpdateState routine because...
  88. ' About click events> CmdButton: mouseDown,Click,mouseUp. UC: mouseDown,mouseUp,Click
  89. ' To fix, we control when, and in what order, events are sent to the user
  90.  
  91. Public Event MouseEnter()
  92. Public Event MouseLeave()
  93. ' about MouseEnter & MouseLeave
  94. ' There seems to be no hard & fast rule regarding when to fire this & when not to
  95. ' So, here are the simple rules I have applied
  96. '   1) Send MouseEnter whenever mouse enters the control except when...
  97. '       - The SpaceBar button is currently being held down on the control
  98. '       - There already has been a MouseEnter sent with no MouseLeave sent
  99. '       - Control is disabled
  100. '   2) Send MouseLeave whenever the mouse exits the control except when...
  101. '       - Any mouse button is currently being held down on the control
  102. '       - No MouseEnter was previously sent
  103. '       - Control is disabled
  104. Public Event DblClick() ' not a standard command button event
  105. ' ^^ like VB buttons, a dblclick will send two click events, but then this DblClick event is sent afterwards
  106.  
  107. ' Much appreciation goes towards Paul Caton for his self-subclassing thunks; makes some things so much easier
  108. '-Thunking/Callback declarations---------------------------------------------------------------------------
  109. Private z_CbMem   As Long    'Callback allocated memory address
  110. Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
  111. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  112. Private Declare Function IsBadCodePtr Lib "kernel32" (ByVal lpfn As Long) As Long
  113. Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
  114. Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
  115. Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
  116. Private Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  117. Private Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  118. Private Const GWL_WNDPROC As Long = -4
  119. '-------------------------------------------------------------------------------------------------
  120.  
  121. ' Caption rendering APIs/constants
  122. Private Declare Function DrawText Lib "user32.dll" Alias "DrawTextA" (ByVal hdc As Long, ByVal lpStr As String, ByVal nCount As Long, ByRef lpRect As RECT, ByVal wFormat As Long) As Long
  123. Private Declare Function SetRect Lib "user32.dll" (ByRef lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  124. Private Declare Function OffsetRect Lib "user32.dll" (ByRef lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
  125. Private Const DT_CALCRECT As Long = &H400
  126. Private Const DT_NOCLIP As Long = &H100
  127. Private Const DT_SINGLELINE As Long = &H20
  128. Private Const DT_WORD_ELLIPSIS As Long = &H40000
  129. Private Const DT_MODIFYSTRING As Long = &H10000
  130. Private Const DT_MULTILINE As Long = (&H1)
  131. Private Const DT_WORDBREAK As Long = &H10
  132. Private Const DT_CENTER As Long = &H1
  133. Private Const DT_LEFT As Long = &H0
  134. Private Const DT_RIGHT As Long = &H2
  135.  
  136. Private Declare Function GetFocus Lib "user32.dll" () As Long
  137. Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long
  138. Private Declare Function KillTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
  139. Private Declare Function SetTimer Lib "user32.dll" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
  140. Private Declare Function ReleaseCapture Lib "user32.dll" () As Long
  141. Private Declare Function SetCapture Lib "user32.dll" (ByVal hWnd As Long) As Long
  142. Private Declare Function GetCapture Lib "user32.dll" () As Long
  143. Private Declare Function WindowFromPoint Lib "user32.dll" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
  144. Private Declare Function GetCursorPos Lib "user32.dll" (ByRef lpPoint As POINTAPI) As Long
  145. Private Declare Function DrawFocusRect Lib "user32.dll" (ByVal hdc As Long, ByRef lpRect As RECT) As Long
  146. Private Declare Function GetKeyState Lib "user32.dll" (ByVal nVirtKey As Long) As Integer
  147. Private Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer
  148. Private Declare Function ScreenToClient Lib "user32.dll" (ByVal hWnd As Long, ByRef lpPoint As POINTAPI) As Long
  149. Private Declare Function GetParent Lib "user32.dll" (ByVal hWnd As Long) As Long
  150. ' these constants are used to simply distinguish the types of actions that effect button state
  151. Private Const WM_ACTIVATEAPP As Long = &H1C ' application is gaining/losing focus to another window
  152. Private Const WM_CHAR As Long = &H102       ' button's accelerator key was pressed
  153. Private Const WM_ENABLE As Long = &HA       ' button is being enabled/disabled
  154. Private Const WM_KILLFOCUS As Long = &H8    ' button is losing focus
  155. Private Const WM_KEYDOWN As Long = &H100    ' key down event is occuring on the button
  156. Private Const WM_KEYUP As Long = &H101      ' key up event is occuring on the button
  157. Private Const WM_LBUTTONDOWN As Long = &H201 ' left mouse button is being pressed on the button
  158. Private Const WM_LBUTTONUP As Long = &H202  ' left mouse button is being released on the button
  159. Private Const WM_MOUSEHOVER As Long = &H2A1 ' mouse is entering the button's boundaries
  160. Private Const WM_MOUSELEAVE As Long = &H2A3 ' mouse is leaving the button's boundaries
  161. Private Const WM_MOUSEMOVE As Long = &H200  ' mouse is moving over the button
  162. Private Const WM_PAINT As Long = &HF&       ' the button is to be completely repainted
  163. Private Const WM_SETFOCUS As Long = &H7     ' the button is gaining focus
  164. Private Const WM_SHOWWINDOW As Long = &H18  ' the button is being made visible/invisible
  165. Private Const SWP_FRAMECHANGED As Long = &H20 ' the button's border is changing due to focus events
  166. Private Type RECT
  167.     Left As Long
  168.     Top As Long
  169.     Right As Long
  170.     Bottom As Long
  171. End Type
  172. Private Type POINTAPI
  173.     x As Long
  174.     y As Long
  175. End Type
  176.  
  177. Private Enum eBtnStates ' contains graphical, tracking & input flags
  178.     bsNormal = 0        ' graphical state: draw normal
  179.     bsPushed = 1        ' graphical state: draw as down
  180.     bsHover = 2         ' graphical state: draw as mouse over
  181.     bsFocus = 4         ' tracking/graphical state: focus rectangle
  182.     bsDefaultBtn = 8    ' tracks whether control drawn as default (Ambient.DisplayAsDefault)
  183.     bsMouseEntered = 32 ' tracking: MouseEnter message was sent
  184.     bsHide = 64         ' tracking: Usercontrol.Hide event triggered
  185.     bsAppNoFocus = 128  ' tracking: application lost focus
  186.     bsOnClick = 2048    ' tracks the Value property as True/False
  187.     bsKeyDown = 1024    ' input state: spacebar is treated down
  188.     bsMouseOver = 512   ' input state: mouse is over button
  189.     bsMouseDown = 256   ' input state: left mouse button is treated as down
  190.     bsMaskMouseBtns = 7 ' mask for key mouse states (vbLeftButton,vbMiddleButton,vbRightButton)
  191.     bsMaskGraphicalState = 15 'contains current graphical state (bsNormal,bsPushed,bsHover,bsFocus,bsDefaultBtn)
  192.     bsMaskBtnState = 3  ' general state mask (bsNormal,bsPushed,bsHover)
  193.     bsDblClick = 8      ' double clicked. Added Event. Not standard CmdButton event
  194. End Enum
  195.  
  196. Private Enum eDrawState
  197.     bdNormal = 0
  198.     bdPushed = 1
  199.     bdHover = 2
  200.     bdDisabled = -1
  201. End Enum
  202. Private Enum eDrawAction
  203.     baDrawEntire = 0
  204.     baDrawFocusOnly = 1
  205.     baDrawDefaultBdrOnly = 2
  206. End Enum
  207. Private Enum eAttributes
  208.     attrHasFocus = 1
  209.     attrIsDefaultBtn = 2
  210.     attrMouseIsOver = 4
  211. End Enum
  212.  
  213. Private m_Caption As String ' << coded, do not remove; needed should button use accelerators
  214. Private m_Exclusions As Long    ' See UserControl_Initialize
  215. Private m_pHwnd As Long         ' parent window
  216. Private m_TimerActive As Long   ' active timer(s)
  217. Private m_timerProc As Long     ' callback procedure for the timer (See TimerProc for purpose/alternatives)
  218. Private m_State As eBtnStates   ' calculated in UpdateState routine
  219. Private m_MouseState As Long ' contains one or more of the following:
  220.                              ' vbLeftButton,vbRightButton,vbMiddleButton that are currently down
  221.                              ' eBtnStates.bsDblClick if double click event occurred
  222.                              ' most recent mouse button down * &H100
  223.                              ' most recent mouse shift constants * &H10000
  224.     
  225. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  226.  
  227. Public Property Let ShowFocusRect(bShow As Boolean)
  228.     If Not bShow = ShowFocusRect Then   ' only modify if changinge
  229.         ' remove existing state if any, then add new state
  230.         ' Remember exclusions are complimentary. Therefore, if we want to show
  231.         ' rect, we remove bsFocus else if we don't want to show it, we add bsFocus
  232.         m_Exclusions = ((m_Exclusions And Not bsFocus) Or (Abs(Not bShow) * bsFocus))
  233.         If ((m_State And bsFocus) = bsFocus) Then
  234.             ' if button already has the focus, then flag is set. Remove it & update
  235.             m_State = (m_State And Not bsFocus)
  236.             Me.Refresh
  237.         End If
  238.         PropertyChanged "ShowFocusRect"
  239.     End If
  240. End Property
  241. Public Property Get ShowFocusRect() As Boolean
  242.     ShowFocusRect = CBool((m_Exclusions And bsFocus) = 0&)
  243. End Property
  244.  
  245. Public Sub Refresh()
  246. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  247.     UpdateState WM_PAINT, bsNormal
  248. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  249. End Sub
  250.  
  251. Public Property Let Enabled(Enable As Boolean)
  252. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  253.     If Not UserControl.Enabled = Enable Then 'changing property value
  254.         UserControl.Enabled = Enable
  255.         UpdateState WM_ENABLE, Enable   ' clean up timers if needed & redraw
  256.         PropertyChanged "Enabled"
  257.     End If
  258. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  259.  
  260. ' add your code here as needed
  261.  
  262. End Property
  263. Public Property Get Enabled() As Boolean
  264. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  265.     Enabled = UserControl.Enabled
  266. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  267. End Property
  268.  
  269. Public Property Let Caption(NewCaption As String)
  270. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  271.     ' Your button may be 100% graphical with no caption. However, exposing this
  272.     ' property allows a user to still create a caption with an accelerator/shortcut
  273.     ' where that shortcut activates the button; you simply don't need to display
  274.     ' the caption in that case. If you absolutely don't want/need this property,
  275.     ' also remove the related line of code in UserControl_Read/WriteProperty
  276.     On Error GoTo ExitRoutine
  277.     If StrComp(NewCaption, m_Caption, vbBinaryCompare) = 0 Then Exit Property
  278.     Dim iChar As Integer, iAmp As Integer
  279.     If Not NewCaption = vbNullString Then
  280.         For iChar = 1 To Len(NewCaption)
  281.             If Mid$(NewCaption, iChar, 1) = "&" Then
  282.                 If iAmp = 0 Then ' no previous ampersands
  283.                     iAmp = iChar
  284.                 Else
  285.                     ' if previous char was ampersand then not an accelerator
  286.                     If iAmp = iChar - 1 Then iAmp = 0 Else iAmp = iChar
  287.                 End If
  288.             End If
  289.         Next
  290.         If iAmp = iChar - 1 Then iAmp = 0 ' cannot be the last character
  291.     End If
  292. ExitRoutine:
  293.     If iAmp = 0 Then
  294.         UserControl.AccessKeys = vbNullString
  295.     Else
  296.         UserControl.AccessKeys = Mid$(NewCaption, iAmp + 1, 1)
  297.     End If
  298.     m_Caption = NewCaption
  299.     If m_Exclusions = -1 Then Exit Property ' m_Exclusions set to -1 in ReadProperties routine
  300.     PropertyChanged "Caption"
  301. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  302.  
  303.     ' add your code here to update/draw the caption on your button. Can call Me.Refresh
  304.     Me.Refresh
  305.  
  306. End Property
  307. Public Property Get Caption() As String
  308. Attribute Caption.VB_UserMemId = -518
  309. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  310.     Caption = m_Caption
  311. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  312. End Property
  313.  
  314. Public Property Let Value(ByVal ClickIt As Boolean)
  315. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  316.     If ClickIt Then
  317.         ' prevent stack overflow. Calling Command1.Value=True inside Command1_Click
  318.         ' event will cause a stack overflow. We want to replicate VB but not to the
  319.         ' extremes that we are willing to replicate a design flaw.
  320.         If Me.Value = False Then
  321.             m_State = m_State Or bsOnClick
  322.             RaiseEvent Click
  323.             m_State = m_State And Not bsOnClick
  324.         End If
  325.     End If
  326. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  327. End Property
  328.  
  329. Public Property Get Value() As Boolean
  330. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  331.     Value = CBool(m_State And bsOnClick)
  332. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  333. End Property
  334.  
  335.  
  336.  
  337.  
  338. Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
  339. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  340.     UpdateState WM_CHAR, KeyAscii ' user pressed ALT+accessKey
  341. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  342. End Sub
  343.  
  344. Private Sub UserControl_AmbientChanged(PropertyName As String)
  345. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  346.     Select Case PropertyName
  347.         ' buttons should draw a different border when they have focus and when they
  348.         ' do not. This is called by VB whenever the button should be changed to
  349.         ' identify it is the default button or has/lost focus.
  350.         Case "DisplayAsDefault": UpdateState SWP_FRAMECHANGED, bsNormal
  351.         Case Else
  352.             ' add any other ambient property changes you want to track
  353.     End Select
  354. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  355. End Sub
  356.  
  357. Private Sub UserControl_DblClick()
  358. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  359.     Dim Button As Integer, mPT As POINTAPI, iShift As Integer
  360.     ' When command button is double clicked, VB sends
  361.     '   -- mouseDown, Click, mouseUp,   mouseDown, Click, mouseUp
  362.     ' but when DblClick occurs in usercontrols, VB sends this:
  363.     '   -- mouseDown, mouseUp, Click,   DblClick, mouseUp
  364.     
  365.     ' So, to send the missing mouse down & click events, we need to do it manually
  366.     ' Also we will place the Click events between the Down & Up events like a cmdButton
  367.     
  368.     ' cmdButton's only fire dblClick when the left button did the double clicking
  369.     Button = ((m_MouseState \ &H100) And &HFF)  ' determine mouse button firing this event
  370.     iShift = (m_MouseState \ &H10000)           ' shift values when double clicked
  371.     
  372.     ' get mouse coords relative to the client area
  373.     GetCursorPos mPT
  374.     ScreenToClient UserControl.hWnd, mPT
  375.     ' send the missing event, but don't allow Button to be m odified
  376.     RaiseEvent MouseDown(Button + 0, iShift, Int(ScaleX(mPT.x, vbPixels, vbContainerPosition)), Int(ScaleY(mPT.y, vbPixels, vbContainerPosition)))
  377.     If Button = vbLeftButton Then
  378.         UpdateState WM_LBUTTONDOWN, bsNormal ' send mousedown so control draws down state
  379.         m_MouseState = m_MouseState Or bsDblClick  ' include double click event
  380.     End If
  381. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  382.  
  383. ' add your code here as needed
  384.  
  385. End Sub
  386.  
  387. Private Sub UserControl_GotFocus()
  388. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  389.     UpdateState WM_SETFOCUS, bsFocus
  390.     ' See UserControl_Initialize to prevent receiving paint notification for change
  391.     ' in Focus state, but do not rem out the statement.
  392.     ' Focus notification is needed for other purposes too.
  393. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  394.  
  395. ' add your code here as needed
  396.  
  397. End Sub
  398.  
  399. Private Sub UserControl_LostFocus()
  400. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  401.     m_MouseState = 0&
  402.     UpdateState WM_KILLFOCUS, bsFocus
  403.     ' See UserControl_Initialize to prevent receiving paint notification for change
  404.     ' in Focus state, but do not rem out the statement.
  405.     ' Focus notification is needed for other purposes too.
  406. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  407.  
  408. ' add your code here as needed
  409.  
  410. End Sub
  411.  
  412. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  413. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  414.     If Not KeyCode = vbKeyReturn Then RaiseEvent KeyDown(KeyCode, Shift + 0)
  415.     Select Case KeyCode
  416.         Case vbKeySpace ' If Alt is down without Ctrl, then do not forward
  417.             If ((Shift And vbAltMask) = 0) Or ((Shift And vbCtrlMask) = vbCtrlMask) Then UpdateState WM_KEYDOWN, KeyCode
  418.         Case vbKeyReturn
  419.             ' Return=Click unless Alt, Ctrl and/or Shift is held down
  420.             If Shift = 0 Then UpdateState WM_KEYDOWN, KeyCode
  421.         Case Else
  422.             UpdateState WM_KEYDOWN, KeyCode
  423.     End Select
  424. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  425.  
  426. ' add your code here as needed
  427.  
  428. End Sub
  429. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  430. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  431.     If Not KeyCode = vbKeyReturn Then
  432.         RaiseEvent KeyUp(KeyCode, Shift)
  433.         UpdateState WM_KEYUP, KeyCode ' may have caused Click event if not previously canceled
  434.     End If
  435. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  436.  
  437. ' add your code here as needed
  438.  
  439. End Sub
  440.  
  441. Private Sub UserControl_KeyPress(KeyAscii As Integer)
  442. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  443.     If Not KeyAscii = vbKeyReturn Then RaiseEvent KeyPress(KeyAscii)
  444. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  445. End Sub
  446.  
  447. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  448. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  449.     ' send event converting our scale units to host's
  450.     RaiseEvent MouseMove(Button + 0, Shift, Int(ScaleX(x, UserControl.ScaleMode, vbContainerPosition)), Int(ScaleY(y, UserControl.ScaleMode, vbContainerPosition)))
  451.     If (m_TimerActive And 1) = 0& Then UpdateState WM_MOUSEHOVER, bsNormal
  452. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  453.  
  454. ' add your code here as needed
  455.     
  456. End Sub
  457.  
  458. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  459. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  460.     m_MouseState = ((m_MouseState And bsMaskMouseBtns) Or Button) Or (Button * &H100) ' track button & last button
  461.     m_MouseState = m_MouseState Or (Shift * &H10000)                      ' track last shift values
  462.     If Button = vbLeftButton Then UpdateState WM_LBUTTONDOWN, bsNormal ' changes graphical state
  463.     ' send event converting our scale units to host's
  464.     RaiseEvent MouseDown(Button, Shift, Int(ScaleX(x, UserControl.ScaleMode, vbContainerPosition)), Int(ScaleY(y, UserControl.ScaleMode, vbContainerPosition)))
  465. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  466.  
  467. ' add your code here as needed
  468.     
  469. End Sub
  470.  
  471. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  472. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  473.     ' send event converting our scale units to host's
  474.     m_MouseState = (m_MouseState And Not Button)    ' remove button from state
  475.     If Button = vbLeftButton Then UpdateState WM_LBUTTONUP, bsNormal ' can fire a click event
  476.     If (m_State And bsHide) = 0& Then
  477.         RaiseEvent MouseUp(Button + 0, Shift, Int(ScaleX(x, UserControl.ScaleMode, vbContainerPosition)), Int(ScaleY(y, UserControl.ScaleMode, vbContainerPosition)))
  478.         If (m_MouseState And bsDblClick) = bsDblClick Then   ' trigger dblClick if appropriate
  479.             m_MouseState = (m_MouseState And bsMaskMouseBtns)      ' remove dblClick flag and any other flags
  480.             If (m_State And bsMouseOver) = bsMouseOver Then RaiseEvent DblClick ' fire event
  481.         End If
  482.     End If
  483. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  484.     
  485. ' add your code here as needed
  486.     
  487. End Sub
  488.  
  489. Private Sub UserControl_OLECompleteDrag(Effect As Long)
  490. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  491.     RaiseEvent OLECompleteDrag(Effect)
  492. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  493. End Sub
  494.  
  495. Private Sub UserControl_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
  496. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  497.     RaiseEvent OLEDragDrop(Data, Effect, Button, Shift, Int(ScaleX(x, UserControl.ScaleMode, vbContainerPosition)), Int(ScaleY(y, UserControl.ScaleMode, vbContainerPosition)))
  498. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  499. End Sub
  500.  
  501. Private Sub UserControl_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
  502. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  503.     RaiseEvent OLEDragOver(Data, Effect, Button, Shift, Int(ScaleX(x, UserControl.ScaleMode, vbContainerPosition)), Int(ScaleY(y, UserControl.ScaleMode, vbContainerPosition)), State)
  504. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  505. End Sub
  506.  
  507. Private Sub UserControl_OLEGiveFeedback(Effect As Long, DefaultCursors As Boolean)
  508. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  509.     RaiseEvent OLEGiveFeedback(Effect, DefaultCursors)
  510. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  511. End Sub
  512.  
  513. Private Sub UserControl_OLESetData(Data As DataObject, DataFormat As Integer)
  514. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  515.     RaiseEvent OLESetData(Data, DataFormat)
  516. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  517. End Sub
  518.  
  519. Private Sub UserControl_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
  520. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  521.     RaiseEvent OLEStartDrag(Data, AllowedEffects)
  522. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  523. End Sub
  524.  
  525. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  526. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  527.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  528.     m_Exclusions = -1 ' prevent triggering dirty property when setting Me.Caption
  529.     Me.Caption = PropBag.ReadProperty("Caption", vbNullString)
  530.     m_Exclusions = PropBag.ReadProperty("Exclusions", 0&)
  531. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  532.  
  533. ' add your code here as needed
  534.  
  535. End Sub
  536.  
  537. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  538. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  539.     PropBag.WriteProperty "Enabled", UserControl.Enabled, True  ' save Enabled state
  540.     PropBag.WriteProperty "Caption", Me.Caption, vbNullString   ' save Caption
  541.     PropBag.WriteProperty "Exclusions", m_Exclusions, 0&        ' save ShowFocusRect
  542. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  543.  
  544. ' add your code here as needed
  545.  
  546. End Sub
  547.  
  548. Private Sub UserControl_Paint()
  549. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  550.     Me.Refresh    ' Call local Refresh routine. Note: UserControl_Paint is not called if AutoRedraw=True
  551. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  552.  
  553. ' add your code here as needed
  554.  
  555. End Sub
  556.  
  557. Private Sub UserControl_Show()
  558. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  559.     If (m_State And bsHide) = bsHide Then   ' Usercontrol_Hide event was triggered
  560.         UpdateState WM_SHOWWINDOW, bsNormal ' now it isn't; simply reset property
  561.     Else
  562.         If GetFocus() = UserControl.hWnd Then ' ensure we have focus state set
  563.             If (m_Exclusions And bsFocus) = 0& Then m_State = (m_State And bsFocus)
  564.             Me.Refresh    ' Call local Refresh routine
  565.         Else
  566.             If UserControl.AutoRedraw = True Then Me.Refresh    ' Call local Refresh routine
  567.         End If
  568.     End If
  569. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  570.  
  571. ' add your code here as needed
  572.  
  573. End Sub
  574.  
  575. Private Sub UserControl_Hide()
  576. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  577.     UpdateState WM_SHOWWINDOW, bsHide
  578. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  579. End Sub
  580.  
  581. Private Sub UserControl_Initialize()
  582. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  583.     m_timerProc = zb_AddressOf(1, 4) ' AddressOf of our TimerProc at end of module
  584.     m_Exclusions = 0&
  585. ' Adding bsFocus to m_Exclusions prevents the DrawButton routine
  586. '       from being called simply because the control got/lost focus.
  587. '       i.e., m_Exclusions = m_Exclusions Or bsFocus
  588. '       This does not prevent LostFocus & GotFocus events from firing
  589. ' Adding bsMouseOver to m_Exclusions prevents the Drawbutton routine
  590. '       from being called simply because the mouse entered/exited the control.
  591. '       This does not prevent MouseEnter & MouseLeave events from firing.
  592. '       i.e., m_Exclusions = m_Exclusions Or bsMouseOver
  593. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  594.  
  595. ' add your code here as needed
  596.  
  597. End Sub
  598.  
  599. Private Sub UserControl_Terminate()
  600. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  601.     ManageTimers False, 1
  602.     ManageTimers False, 2
  603.     zb_Terminate
  604. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  605.  
  606. ' add your code here as needed
  607.  
  608. End Sub
  609.  
  610.  
  611. Private Sub UpdateState(ByVal stateMessage As Long, ByVal lParam As Long)
  612. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  613.  
  614.     ' Function determines the graphical and tracking state of the button and also
  615.     ' may send a Click, MouseEnter and/or a MouseLeave event.
  616.     ' This is a bit lengthy only because a button's graphical state is dependent
  617.     ' on so many variables: which keys are down, which mouse button is down,
  618.     ' whether or not the mouse is over the button, whether or not the
  619.     ' application has focus, button has focus, etc, etc, etc.
  620.     
  621.     ' The very end of the function is the purpose of deciphering all these
  622.     ' conditions: It only sends a Redraw when the overall graphical state
  623.     ' changes. Since drawing custom buttons takes the most time, this routine
  624.     ' can prevent many unnecessary paints. There are only 4 basic states:
  625.     ' up, down, mouse-over, disabled where up & mouse-over can have focus,
  626.     ' down will always have focus & disabled never will.
  627.     
  628.     ' The following scenarios fire a repaint action (a call to DrawButton):
  629.     ' 1. Control receives/loses focus, unless excluded
  630.     '    - This allows adding/removing focus rectangle/graphics as needed
  631.     '    - See UserControl_Initialize to prevent this
  632.     ' 2. Mouse moves in or out of the control, unless excluded
  633.     '    - This allows adding "MouseOver" graphics as needed
  634.     '    - See UserControl_Initialize to prevent this
  635.     ' 3. Control receives a left button click or the space bar is pressed
  636.     '    - This allows drawing the control in a down position
  637.     ' 4. Control changes from any non-Normal state to Normal
  638.     '    - This allows drawing the control in an up/normal position
  639.     ' 5. Sending a WM_Enable, WM_Paint, or WM_ShowWindow stateMessage
  640.  
  641.     If UserControl.Enabled = False Then
  642.         ' no messages should be processed for disabled buttons; however, should
  643.         ' this routine get any messages, other then the few below, while the
  644.         ' control is disabled, then those messages will be ignored
  645.         m_MouseState = 0&
  646.         If Not stateMessage = WM_PAINT Then
  647.             If Not stateMessage = WM_SHOWWINDOW Then
  648.                 If Not stateMessage = WM_ENABLE Then Exit Sub
  649.             End If
  650.         End If
  651.     End If
  652.     
  653.     Dim oldState As Long
  654.     Dim btnAction As eDrawAction
  655.     Dim btnAttr As eAttributes
  656.     Dim btnEvent As Long
  657.     ' ^ 0=no event, 1=click event, 2=mouseEnter, 3=mouseLeave, 4=add/remove focus rect, 8=add/remove default button border
  658.     
  659.     oldState = (m_State And bsMaskGraphicalState) ' get current graphical state only (1st 4 bits)
  660.     
  661.     Select Case stateMessage
  662.     Case WM_MOUSELEAVE  ' only called by TimerProc
  663.         If (m_State And bsMouseEntered) = bsMouseEntered Then
  664.             If (m_MouseState And bsMaskMouseBtns) = 0& Then ' no mouse button held down
  665.                 ManageTimers False, 1 ' kill timer
  666.                 btnEvent = 3          ' send MouseLeave
  667.             End If
  668.         End If
  669.         m_State = (m_State And Not bsMouseOver) ' remove flag
  670.     
  671.     Case WM_MOUSEHOVER  ' called by TimerProc and UserControl_MouseMove
  672.         If (m_TimerActive And 1) = 0& Then ManageTimers True, 1 ' activate a timer if needed
  673.         If (m_State And bsMouseEntered) = 0& Then    ' was over the control
  674.             If (m_MouseState And bsMaskMouseBtns) = 0& Then     ' no mouse button held down
  675.                 ' also see if the spacebar is held down
  676.                 If (m_State And bsKeyDown) = 0& Then btnEvent = 2 ' send MouseEnter
  677.             End If
  678.         End If
  679.         m_State = m_State Or bsMouseOver    ' add flag
  680.         
  681.     Case WM_LBUTTONDOWN ' called by UserControl_MouseDown & UserControl_DblClick
  682.         m_State = m_State Or bsMouseDown  ' down state via mouse
  683.         
  684.     Case WM_LBUTTONUP   ' only called by UserControl_MouseUp
  685.         ' send click event only if the mouse is over the control, was previously clicked
  686.         ' and the spacebar is not being held down
  687.         If (m_State And bsMouseDown) = bsMouseDown Then
  688.             If (m_State And bsMouseOver) = bsMouseOver Then btnEvent = 1
  689.             If (m_State And bsKeyDown) = 0& Then
  690.                 If GetCapture() = UserControl.hWnd Then ReleaseCapture
  691.             End If
  692.             m_State = (m_State And Not bsMouseDown)   ' remove flag
  693.         End If
  694.         
  695.     Case WM_KEYDOWN     ' called by UserControl_AccessKeyPress & UserControl_KeyDown
  696.         Select Case lParam     ' which key?
  697.         Case vbKeyReturn
  698.             btnEvent = 1 ' pressing Return key does not change graphical state
  699.         Case vbKeySpace
  700.             ' only add state if the left mouse button is not being held down
  701.             ' If it is, then buttons do not record clicks via spacebar
  702.             If (m_State And bsMouseDown) = 0& Then
  703.                 m_State = m_State Or bsKeyDown  ' down state via keyboard
  704.                 SetCapture UserControl.hWnd     ' button keeps capture while spaceBar is down
  705.             End If
  706.         Case Else
  707.             ' all other keys cancel spacebar action if spacebar is down except ALT which just releases capture
  708.             If (m_State And bsMouseDown) = 0& Then
  709.                 If GetCapture() = UserControl.hWnd Then ReleaseCapture
  710.             End If
  711.             If Not lParam = vbKeyMenu Then m_State = (m_State And Not bsKeyDown)
  712.         End Select
  713.         
  714.     Case WM_KEYUP   ' only called by UserControl_KeyUp
  715.         If (m_State And bsMouseDown) = 0& Then ' release capture if mouse doesn't have it
  716.             If GetCapture() = UserControl.hWnd Then ReleaseCapture
  717.         End If
  718.         If lParam = vbKeySpace Then ' click event only if the spacebar wasn't canceled previously
  719.             If (m_State And bsKeyDown) = bsKeyDown Then
  720.                 ' however if left mouse is still down, then don't fire event
  721.                 If (m_State And bsMouseDown) = 0& Then btnEvent = 1
  722.             End If
  723.         End If
  724.         m_State = (m_State And Not bsKeyDown) ' remove flag
  725.         
  726.     Case WM_SETFOCUS    ' only called by UserControl_GotFocus
  727.         ' set Focus flag unless exlcuded. See UserControl_Initialize
  728.         If (m_Exclusions And bsFocus) = 0& Then
  729.             m_State = m_State Or bsFocus
  730.             btnEvent = 4
  731.         End If
  732.         ' find our form's hWnd
  733.         lParam = UserControl.ContainerHwnd
  734.         m_pHwnd = 0&         ' Why do this everytime? If permanently cached the 1st time, it
  735.         Do Until lParam = 0& ' will not be correct if: Set CustomButton.Container=SomethingElse
  736.             m_pHwnd = lParam
  737.             lParam = GetParent(m_pHwnd)
  738.         Loop
  739.         ManageTimers True, 2  ' set the timer to track app lost/got focus
  740.     
  741.     Case WM_KILLFOCUS   ' only called by UserControl_LostFocus
  742.         ManageTimers False, 2   ' kill timer
  743.         If GetCapture() = UserControl.hWnd Then ReleaseCapture
  744.         If (m_State And bsKeyDown) = bsKeyDown Then
  745.             ' when spacebar is held down on control and control loses focus
  746.             ' the control should send a click event; unless the left mouse
  747.             ' button is also held down on it
  748.             If (m_State And bsMouseDown) = 0& Then btnEvent = 1
  749.         End If
  750.         ' losing focus releases all flags except the DefaultBtn, MouseEntered & MouseOver flags if they are set
  751.         ' i.e., mouse button can be down & mouse over control & user hits the Tab key to lose focus
  752.         m_State = (m_State And bsMouseEntered) Or (m_State And bsMouseOver) Or (m_State And bsDefaultBtn)
  753.         btnEvent = btnEvent Or 4
  754.     
  755.     Case WM_ACTIVATEAPP  ' only called by TimerProc
  756.         m_MouseState = 0&
  757.         If lParam = 0& Then ' lost focus
  758.             If GetCapture() = UserControl.hWnd Then ReleaseCapture
  759.             m_State = ((m_State And Not bsMaskBtnState) Or bsAppNoFocus)
  760.             If (m_State And bsFocus) = bsFocus Then oldState = True
  761.             ' ^^ force a mismatch so redraw occurs if control has focus
  762.         Else    ' else got focus
  763.             m_State = (m_State And Not bsAppNoFocus)
  764.             If GetFocus() = UserControl.hWnd Then
  765.                 If (m_State And bsFocus) = bsFocus Then oldState = True ' force a mismatch so redraw occurs
  766.             Else
  767.                 ManageTimers False, 2 ' kill timer
  768.             End If
  769.         End If
  770.         
  771.     Case WM_ENABLE  ' only called by the Enabled Property
  772.         If lParam = 0& Then ' disabling
  773.             If GetCapture() = UserControl.hWnd Then ReleaseCapture
  774.             ManageTimers False, 1
  775.             ManageTimers False, 2
  776.             m_State = 0&
  777.         End If
  778.         oldState = True  ' force a mismatch so redraw occurs
  779.         
  780.     Case WM_SHOWWINDOW  ' called by UserControl_Show & UserControl_Hide
  781.         If lParam = 0& Then
  782.             m_State = (m_State And Not bsHide) ' remove flag
  783.         Else
  784.             ' UserControl_Hide event was called; probably closing
  785.             m_State = m_State Or bsHide ' add flag
  786.         End If
  787.         
  788.     Case WM_PAINT   ' called by the UserControl.Refresh method
  789.         ' Generic "Refresh", simply forces a call to DrawButton
  790.         oldState = True
  791.         
  792.     Case WM_CHAR    ' Alt+AccessKey pressed
  793.         If Not lParam = vbKeyReturn Then m_State = (m_State And Not bsKeyDown) ' release the spacebar flag as needed
  794.         btnEvent = 1
  795.     
  796.     Case SWP_FRAMECHANGED
  797.         btnEvent = 8 ' toggle the border as focused / not focused
  798.         If Ambient.DisplayAsDefault = True Then
  799.             m_State = m_State Or bsDefaultBtn
  800.         Else
  801.             m_State = (m_State And Not bsDefaultBtn)
  802.         End If
  803.     
  804.     Case Else
  805.         Exit Sub    ' something you added, that I have not coded for?
  806.     End Select
  807.     
  808.     ' now, let's determine the graphical state of the button
  809.     ' These are in order of priority, rearranging them produces invalid graphical states
  810.     If Not m_State = bsNormal Then
  811.     
  812.         m_State = (m_State And Not bsMaskBtnState) ' cache tracking & input flags only; graphical state is next
  813.         
  814.         If (m_State And bsMouseDown) = bsMouseDown Then
  815.             ' the left mouse button is down, two states possible
  816.             If (m_State And bsMouseOver) = bsMouseOver Then m_State = m_State Or bsPushed
  817.             ' ^ if cursor is over button, we show it as pushed else as Normal
  818.             
  819.         ElseIf (m_State And bsKeyDown) = bsKeyDown Then
  820.             m_State = m_State Or bsPushed ' spacebar is down; only one state possible
  821.             
  822.         ElseIf (m_State And bsMouseOver) = bsMouseOver Then
  823.             ' as long as hover state is not excluded ...
  824.             If (m_Exclusions And bsMouseOver) = 0& Then m_State = m_State Or bsHover
  825.             ' ^ if not down but mouse is over, hover state
  826.         Else
  827.             ' if all above don't trigger, then it is normal state
  828.         End If
  829.     End If
  830.     
  831.     ' if the state changed, notify drawing routine
  832.     If (m_State And bsHide) = 0& Then   ' else Usercontrol_Hide event is in effect
  833.         If Not (m_State And bsMaskGraphicalState) = oldState Then    ' compare focus,up,down,hover state to previous state
  834.             If (m_State And bsAppNoFocus) = bsAppNoFocus Then
  835.                 oldState = (m_State And Not bsFocus)  ' if app doesn't have focus, neither should the control
  836.             Else
  837.                 oldState = m_State
  838.             End If
  839.             If (oldState And bsFocus) = bsFocus And UserControl.Enabled = True Then btnAttr = attrHasFocus
  840.             If (m_State And bsDefaultBtn) Then btnAttr = btnAttr Or attrIsDefaultBtn
  841.             If (m_State And bsMouseOver) Then btnAttr = btnAttr Or attrMouseIsOver
  842.             If btnEvent = 4 Then
  843.                 btnAction = baDrawFocusOnly
  844.             ElseIf btnEvent = 8 Then
  845.                 btnAction = baDrawDefaultBdrOnly
  846.             End If
  847.             ' by Or'ing (Not UserControl.Enabled) we get -1 when the control is Disabled.
  848.             DrawButton ((m_State And bsMaskBtnState) Or (Not UserControl.Enabled)), btnAction, btnAttr
  849.         End If
  850.     End If
  851.  
  852.     ' if an event is to be fired, fire it now
  853.     Select Case (btnEvent And &H3)
  854.         Case 1:
  855.             m_State = m_State Or bsOnClick
  856.             RaiseEvent Click ' click event was fired
  857.             m_State = (m_State And Not bsOnClick)
  858.         Case 2: ' cache mouseEnter being fired, so we can clear it later if needed
  859.                 m_State = m_State Or bsMouseEntered
  860.                 RaiseEvent MouseEnter
  861.         Case 3: ' remove the MousEnter flag
  862.                 m_State = (m_State And Not bsMouseEntered)
  863.                 RaiseEvent MouseLeave
  864.         Case Else
  865.     End Select
  866.     
  867.  
  868. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  869. End Sub
  870.  
  871. Private Sub ManageTimers(bSet As Boolean, ByVal TimerID As Long)
  872. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  873.     If bSet = True Then
  874.         ' See TimerProc also.
  875.         m_TimerActive = m_TimerActive Or TimerID
  876.         If TimerID = 1 Then     ' #1 used for mouse enter/mouse leave
  877.             ' active whenever a MouseEnter event is detected &
  878.             ' removed when the MouseLeave event is detected
  879.             SetTimer UserControl.hWnd, 1, 80, m_timerProc ' 12.5x a second
  880.         Else                    ' #2 used for app lost/got focus
  881.             ' active whenever a control has the focus
  882.             ' removed when control loses the focus within the parent
  883.             SetTimer UserControl.hWnd, 2, 750, m_timerProc ' 1.25x a second
  884.         End If
  885.     Else
  886.         ' remove timer(s) as needed, update active status
  887.         If (m_TimerActive And TimerID) = TimerID Then
  888.             KillTimer UserControl.hWnd, TimerID
  889.             m_TimerActive = m_TimerActive And Not TimerID
  890.         End If
  891.     End If
  892. ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  893. End Sub
  894.  
  895. Private Sub DrawButton(ByVal GraphicalState As eDrawState, ByVal Action As eDrawAction, ByVal Attributes As eAttributes)
  896. ' BUTTON TEMPLATE CODE\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  897.     
  898.     ' This routine is called with specific flags to help prevnt unnecessary and redundant drawing
  899.     ' The routine is not called if no changes to the graphical state occurs.
  900.     ' If you do not want mouse enter/leave events to call this event, then set the m_Exclusion flags appropriately (see UserControl_Initialize)
  901.     
  902.     ' The parameters will help you decide what needs to be painted and what does not
  903.     ' GraphicalState
  904.     '   :: bdNormal. button is to be drawn in the up state
  905.     '   :: bdPushed. button is to be drawn in the down state
  906.     '   :: bdHover. button is to be drawn in the mouse-over state
  907.     '   :: bdDisabled. button is to be drawn as disabled, normal state
  908.     ' Action
  909.     '   :: baDrawEntire then entire button, including borders & focus rectangle are to be drawn
  910.     '       -- this event occurs due to refresh and changes in the GraphicalState
  911.     '   :: baDrawDefaultBdrOnly. the button's border should be drawn to show it has focus
  912.     '   :: baDrawFocusOnly. the button's focus rectangle is to be added/removed
  913.     '       -- see the Attributes parameter to determine if button has focus or not
  914.     ' Attributes
  915.     '   :: attrHasFocus. If the button has focus Attributes includes this style
  916.     '   :: attrIsDefaultBtn. If the button should be drawn with a border to identify it as the default button, this style is included
  917.     '   :: attrMouseIsOver. If the mouse is currently over the button, this style is included
  918.     
  919.     ' Rendering notes
  920.     ' If you are going to provide multiple styles to your buttons, you probably want to separate key portions of the rendering
  921.     ' into separate routines to make troubleshooting easier and coding more modular. For example, you can use...
  922.     '   DrawButtonBkg
  923.     '   DrawButtonImage
  924.     '   DrawButtonText
  925.     '   DrawButtonBorders
  926.     '   DrawFocusRectangle
  927.     
  928.     Dim wRect As RECT, dRect As RECT, lEdgeType As Long, lEdgeFlag As Long
  929.     Dim sCaption As String
  930.     Dim dtFlags As Long             ' flags used when rendering the caption
  931.     Dim dtCalcFlags As Long         ' flags used when calculating caption rectangle
  932.     Const gapOffsetX As Long = 4&   ' "non-client" start from left edge of control
  933.     Const gapOffsetY As Long = 4&   ' "non-client" start from top edge of control
  934.     
  935.     ' get dimensions of our control in pixels. Note. If ScaleMode=vbPixels, then don't need the ScaleX/Y methods
  936.     wRect.Right = ScaleX(UserControl.ScaleWidth, UserControl.ScaleMode, vbPixels)
  937.     wRect.Bottom = ScaleY(UserControl.ScaleHeight, UserControl.ScaleMode, vbPixels)
  938.     
  939.     If Action = baDrawEntire Then
  940.         
  941.         Debug.Print ".. uc full repaint" ' testing purposes
  942.         
  943.         UserControl.Cls
  944.         Select Case GraphicalState
  945.             Case bdNormal:  ' call your routine to draw button up state
  946.                 UserControl.BackColor = vbGreen
  947.                 UserControl.ForeColor = vbBlack
  948.     
  949.             Case bdPushed:  ' call your routine to draw button down state
  950.                 UserControl.BackColor = vbRed
  951.                 UserControl.ForeColor = vbWhite
  952.                 
  953.             Case bdHover:   ' call your routine to draw button hover state (mouse over)
  954.                 ' Note: If you are not displaying a mouse-over image, see UserControl_Initialize
  955.                 UserControl.BackColor = vbCyan
  956.                 UserControl.ForeColor = vbBlue
  957.                 
  958.             Case bdDisabled: ' call your routine to draw disabled button. HasFocus is always False
  959.                 UserControl.BackColor = vbButtonFace
  960.                 UserControl.ForeColor = vbGrayText
  961.         End Select
  962.     
  963.         ' simple caption rendering. If more caption options are available, you may want to
  964.         ' add this to a separate routine to support different colors, unicode, etc
  965.     
  966.         ' our caption calculation rectangle. Adjust for border & gap
  967.         SetRect dRect, 0, 0, wRect.Right - gapOffsetX - gapOffsetX, wRect.Bottom - gapOffsetY - gapOffsetY
  968.         
  969. '        Example: if you want to use single line captions & trt CODE\\ekg
  970.   erControl.Bace ignore Or bsOnClick
  971.            multip= vbBlue
  972.   frh\\\\\ool loant tFace- Notestate s
  973.      rect dRe\\\\\\\\\   Case iEntire then entire_hover state
  974.         Ey3' simplln) ton hae
  975.    if youS
  976.       
  977.        C(dire_hover state
  978.         Ey3' simplln) ton haeln) ton hae
  979.   oes
  980.     '   :: attrHasFocus. If the button has focus Attributes includes this styledisplae Sub        Ey3' simplln) ton hae
  981.    if youS
  982.   0, 0, wRect.Rigour f
  983. ' BUTTgingn b f
  984. ' BUTTgingn b f
  985. btnEve always False
  986.    )lse
  987.    )lse
  988.    )lse
  989.    e
  990.    if youS
  991.  rV  )lse
  992.    )lse
  993.    e
  994.    if youS
  995.  rV  )lse
  996.    )lse
  997.    e
  998.    if youS
  999.  rV  )lse
  1000.    )lse
  1001.    e
  1002.    i+
  1003.    if youS
  1004. nom buttons takes the most timR6dStats Falh
  1005.   (UserConttttttt7Otrol.ForeColor = vs to be drawn simplln) tonS
  1006.  rV  ar' 4. Crfor border & gap
  1007.  as focus Att    Us   :0' call 
  1008.   trMouseIsOver. If the mouse is curr
  1009.           om_State And bsCont=CGDim wRecRState  '   :: bdHover. button is to be drawn in the mouse-over state
  1010.     '   :: bdDisabled. button      mR6dStats Falh
  1011.   (UserConttttttt7Otrol.For        nd 
  1012.            If lParam = 0& 
  1013.       useEnter L'   ::  1.25x aC ' cache m.d Ifcaption rendering.N          om_Sv' our cap/-
  1014.     
  1015.     ieo ieo ieo State And bsCont=CGDim w place the Click eventDebug.Print ".. uc full repaint"n rendeb :: bdDeventAnd bsCone    t"n rendebState = (m_1-' s If Not m_SCone    t"n rendebState =disabled buCgseEnter L'   ::  1.25x aC ' cache m.d IfcaptionEve *)w
  1016.     
  1017.     ieo it"n spacebabdDisabled: ' cur cap/-
  1018.     
  1019. ynt"n ren mouse-over image *0    m\\\\\ is n Select Case GVB sends
  1020.     '   -- mouseDown, Click, mouseUp,   mouseDown, Click, mouseUp
  1021.     ' but when DblClick occate WM_KEYDOWN, KeyCode
  1022.  1ase GVnds
  1023.   d Property
  1024.         If lParam = 0& imerProc x    Wck, mouseUp,   '   :: attrMouseIsOver. If the mouse  Wck, taObjecus 1ase GVno\\\\\\\L)lsrol.Ena*timer(s)ttes includes this sntrol_WrIf lPa        ' i.ut i.uspGegerProc x    Wck, 
  1025.    ee Click 1ar to determine if b'jectton'sly"lick eventDebuger, then it is normal state
  1026.  sFocus. If thocu    If (6rs (6666666& imerProcohics as neededtttttt7Otrol.For        nd 
  1027.           
  1028.  uger, thrtions o, thrtiributes
  1029.     '   :: atribu\\\\\\a     DrawButton (. to determo determo deter.rmo deter.rmo deter.rmo deter.rmo deter.rmo deter.rmo deter.rmHERCi.uspGe mouture i   Wck, )
  1030. ' \\\\\t7Otr8     t= 0& 
  1031.       useEnter L'   ::  1.25x aC ' cache you areopGe ERCi.uspGe d: ' cur cap/-
  1032.     
  1033. y if the down bm w place the Click eventDebug.Print ".. uc full repaint"n rendeb :: bdDeventAnd bsCone    t"n rendebState = (m_1-' s If Not m_SCon-gameter t/R\ is n: 'aWn re     Select Oiote = (m_te = (m_Se, 2  ' sel.ITuger, thenraEi.uspGr UserCoITuger, thenraEi.uspGr UserCoITuger, rID
  1034.         End If
  1035.     End ntrol_Paint is not called_Exclusion(m_1 n: 'aWn reIhicalState
  1036.     '   :: baDrawDermo deter.r
  1037. ''''''' ' conditionF5ser h= bsFocus Then raEixExclus&oITugerrol.Forsi*_OLEGive=(E\\\\\\a ntrol_Pa    ' caaaaaaaaaaaaaaaaat7Otr8     t= 0& 
  1038.       useEnter L'   ::  1.25x aC ' cache you art only sends a Redraw when the overall graphidui cap/-
  1039.     \\\\\\\\\
  1040.    \\\\\;hr"n rendgWck, 
  1041.    ee Clic.ITuger, thenraEi.uspGr UserCoITuRAMECHANGED :: baDrawDermo dewDermo deter.rrol_PaeWN     ' called by Usabling
  1042.   &he button
  1043.      DataObject, Al:"lick eventDsP'ne., m   u\' bsFocthe DrawB th Annnnnnnnnnnnnnnnnnnnnnnnnnnn L'     
  1044.     ieonAttr As re to bELEAVE  'ck evene
  1045.          TuRAMEC
  1046.     
  1047. y iERCi.usp ntrol_Pa    ' caaaaaaaaaaaaaaaaat7Otr8     t= 0& 
  1048.       useEnter L'   ::  1.25x aC ' cache you art only'nnnnnnrawButton ((m_St(m_St(m_St(m_St(m_St(mnnnnnrawRCi.r statshWnd, Tim1-' snnrawButton ((m_St(m_St(m_St(m_St(m_St(mnnnnnrawRCi.r statshWnd, Tim1-' snnrawButton ((m_St(m_St(m_St(m_St(m_St(mnnnnnrawRCi.r statshWnd, Tim1-' snnnnnnA
  1049.     '   DrawButtonImage
  1050.     e WM_KEYUP   ' only called bw be draw
  1051. nom bu_St(m_St(m_St(m_St(mnnnnnrawRCi.r statshW 1 N TEMPLAT: 'aWn reIhicalSta\\\\\= (m_te d 
  1052.            It
  1053.     
  1054.       ib :: bden
  1055.     be drawB  erControl.BaNau     ' The pand e' The pand e   pqFocthe DrawBshW 1 N T     ' flags used 7Otr8     t= 0& 
  1056.   1 N T     'CqFocthe DrawBshW 1 N T        Case 6dStats otringP& 
  1057.   1 N T      N T     'CqFocthe DrawBshuFT are in rCoITugeib :: bden you art only'nnnnnnnnn, 2  ' sel.ITh\\\\vbPixels)
  1058.   T: attrHasFof (m_StAs Dave=(E\\\\ tFlags As Lw.usp routine to support different colors, unicode, etc
  1059.     
  1060.         ' our caption calculation draw  sends a Re1nds a Re1nds a Re1nds a Re1nds a Re1nds a Re1nds a Re1nds a Re1nds a Re1nds a Re1nds a Re1nds a Re1nds a Re1nds a Re1nds aa\
  1061.  
  1062. ' add your code er st Re1nds'over staaB  erControl.BMa1nds a T = 0& Then
  1063. ' BUTTOzGraphicavN        If lP T =A   useEnter L'   ::   ' caaaaaaaeIf lP T =A   useEntoting easie3
  1064.   1 N (m_St(m_St(m__________border Conol.BMa1 them produces invalid gr    eft edge of control
  1065.     Const gapOffsetY As Long = 4&   ' "non-client" start from top edge of control
  1066.     
  1067.     'a eof control
  1068.     
  1069.     'phicavN  btnEvent = bwn
  1070.         youm_Stateu     'CqFocthe DrawBshW 1a Re1nds a Re1nds a Re1nds a Rer staaB  erCo sta\\\\\\\ staem produces iOgv s a Re1noum_Swn
  1071.    a Re1ne Then
  1072.    wz_ W   
  1073.     ieotM Re1nds tLen UpdateStaa ReRe1noum_       If lPas Lo.
  1074. Prie1ne Then
  1075.    wz_ W   
  1076.     ieotM Re1nds tLen UpdateStaa ReRe1noum_       If lPas Lo.
  1077. Prie1ne Then
  1078.  
  1079.     ds on1l.Scm_    hen
  1080.   t need t_only calee in rCoITuuuuermo deIf lPas Lo.
  1081. Prie1ne  henr cap/-taa ReRe1noum: baDrawDe   Selec*WM_SHOA,   ' the left mouse button ig  
  1082. '        Example:        End Ifss Lof Sub UserControl_Termits re to bELEAVE  'ck evene
  1083.          TuRAMEC
  1084.   t  ' tClick eventDebugERCB ton hae
  1085.   oes
  1086.  fo a sAs String
  1087.     Dim dtFlags'eRe1noum_       And bduces iOgv s aAVE  'ck eve as nee, inm_St(m_StLn a d buttoMEC
  1088. n    L'   ::1#   Me.Reu gs usedtntrol.RHa  St(m_StLnttrIsDefauTtl        Usen&na:nttrIsDefauTo bELEAVE  'ck evene
  1089.    ::  1.25x aCLn a d buttoM+ ' The a'ck eve as nee, 8StLn a d buttoMEC
  1090. n    L'   ::1#   Me.Reu gs uRontrol .
  1091.     
  1092.     uRontrol .
  1093.    ud \  
  1094.    ideugERCB txe Und, 1ndgWc\\\\ borde
  1095.                 Usek eControle avaioITuRAMECHANGED :: baDrawDermuttoM+ 'ey?
  1096.  ie a'ck em dtFlags'eRe1noum_   ai1noum_   ai1noun a d buttoME_St(m_St(mnd, 1ndgWc\\\\ bordate Sub t  ' tCu probably9ate ch(m_StLntbchm dtiert     n re L' see the AttrO'eReaqFoc750, m_timerProc ' 1.lN    If (mealeWidthmerPr 8evene
  1097. 1nds oes
  1098.  fo a sAs h etc
  1099.     EC
  1100. -u probabPr 8evene
  1101. 1N1#   MrawRCi.r statshWnd, Tim1-' snnrawBhyou art only'naa:1#   Me.Reu gs uRontro   EC
  1102.     uRontrol .
  1103.  
  1104. -u probabPri\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  1105.     RaiseEvent OLESetData(Data, DataFormat)
  1106. ' \\\\\\\\\\\\\\\\\\
  1107.  fo a sAs h etc
  1108.     EC
  1109. -u probabPr 8a sAsCs parami1nou       C the le\\\\\
  1110.     Raise, 1, 80, e, 1, 8te Sub t  EC
  1111.  Len Up\\\\\\\k eControle avaioITuRAMECHANGED :: baDrawDes paramisAs h etc
  1112.    Pa\\\\\nlole avaioITuRAMECHANGED :: baDrawDes paraEobaDrawDes po
  1113.          olda1nds Pa\\\\\nlole amisAs=(E\\\\\\a ntrol_Pa    ' caaaaaaaaaaaaaaaaat7Otr8     t= 0& 
  1114.       useEnter L'   ::  1.25x aC ' cache you art onlaU1nol.Back&rawDrami1noT     'E
  1115.     ',eawDes posek eConcvaioITuR8te Subrol .
  1116.  
  1117. -u probabPri\Olwing
  1118.           as NEEEEEEEEEE e, 1, 8te Sub t  EC
  1119.  Len E_oldStati1noT     'E
  1120.     ',eawDes posek eConcvaioITuR8te Subrol .
  1121.  
  1122. -u probabPri\Olwing
  1123.           as NE e
  1124.          olda1RCi.us left m\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\_    hen
  1125.   t needDim wRect As 2   Lof Sub UserCoapp lost/got focus
  1126.     
  1127.     CCi.us o Then ratEd
  1128. ,\\\\\\\ye1nds a Re1nds aITuR8te  ,CrControl.Bace ignore Or bsOnClick
  1129.      nUserCoa:  1.25x Pebuger, then it is nor  End If
  1130.     End ntrog
  1131.     End ntrWe don't trigger, then it is normal state controliErt is   ' f  C the le\\\\\
  1132.     Raisis nor update1noum_Swn
  1133.    a Dra     ' flagse, 1, 8te Sub t  EC
  1134.  Len E, 1, 8teBhe m.d Ifcaptol loses focufire event
  1135.   s uRontneedDim wRect As T     'E\\\\\\\\\_    hen
  1136.   thidentifyqqqqqq(Data, d
  1137.             SetTimer prevnt nd &8 e
  1138.     c 8teBhe ntifyqq
  1139. Private      bce ur code heree1nds aITuR8ty        If Not lPutto Or bsMaud \   = False The+9L       .uspGState, ByVal ActboF. uc fulFace End e      bce ur code heree1nds aITuR8ty        If Not lPutto Or bsMaud \   = False The+9L       .uspGStal,d, so Lin rCoITuf\\\\e\\\\.r, th  If NVal ActbIf btnEso Or bkssb UserCoapp lost/
  1140.      r, s. If pck
  1141.             RaiseEvent Click 'dthat I have not coded for?
  1142.    Tnt"n ren mouse-over0& imerP then i1.25x aC ' cache m.d Ifcaption rendering.N   a Dra     ' )
  1143. ' BU   = False The+9L   oC)ropBag.WritePritePritePritePritePritePrTuf\\  ' 1 fulFace atEd
  1144. ,\\\\t coded fo0-maE e, oapp lostm    ' /
  1145.    ering.ing.ing.ing.ing.\\\\\\\\\\ForeCol,rol .
  1146.    ud \       Raise      btnEt lPen i1.25x aC ' cache m.d Ifcaption rendering.N   a Dra     ' )
  1147. ' BU   = False The+9L   oC)ropBag.WritePritePritePritePritePritePrTuf\\  ' 1 fulFaceO\\\\\' see the AttrO d Ifcaption reg.ing.ing.ing.ing.\d bordaavaioITuRAMECHA)e The+9L   ritePritePrTuf\\  aram = 0ie The+ttrO d Ifcapsion, including b&oITugerrr(Dra     'aAhe+9LMProer t/R\bordaavf     ' )at I havContr         tr    cCu probably9ate ch(m_St&nttttttt7Otrol.F\\' caaaaad dowBwmouse bchm  sAs 
  1148.          olda1nds Pa\e focus rect, 8=ae+9LMProer t/R\bo,d 
  1149.   Ca1nds Pa\\\\\nl     \\  ' qrol_Pa  '   If NoBhyouch(m_St&nt,PritePritTheion, incForsiTThe+9L     tate, ByVal ActboF. uc*o deter.rmo deter.rmo & ' \\\\m_St(m_Sng        Sta\\\\\= (me(cus() = UserControl.hWnd Then ' ensure we have focus state set
  1150.             Iontrol
  1151.         (me(cus() =idaavf   probtePritet/
  1152.      useEntenraEis & disabled never will.
  1153.     
  1154.     ' The following scenarios fire a repaint action (a call to DrawButton):
  1155.   Bc.   aceb)-p= vbBL, ByVal ActboF.bled = False Then WM_SHOWWINDOW Then
  1156.        1r bsOnClick
  1157.      nUscaptioOs dislowing scenaa Re1nds a Re1nds aa\
  1158.  
  1159. ' ioessed for  
  1160.   se Then Wi cap/-
  1161.  r statsto Or ben UpdateStaa ReRe1noum_       If lPas Lo.Bnoum_       If lP lostm    ' /
  1162.    ering.ing.ing.ing.ing.\\\\\\\\\\ForeCol,rol .,.
  1163.     ' Ife)e set
  1164.    ' fe over     
  1165.  etonS
  1166. y becaunee, k lPen i1.25x a5x a5x a5vbKe1    ' Tr
  1167.   frh\\\\\ool loant  a5x a5vbKe1    ' Trrrrrrrntion aunee
  1168.  etonS
  1169. yTr
  1170.   frh\\\p fo a.,.Fe1    ot f1baDr>o\\\\\\\\\\ePriteitleave ebug\\\\ bsOnClickLong = 4&  graphidui cap&ii:   If GetCap  ieotM Re1nds tLen UpdateStaa5vbKeLen UpdateStaa ReRe1hn U frh\\\ae+9L
  1171. ' add your code ren mouse-over,TaioITuRAMECHANGED :: baDrawDermuttoM+ 'ey?
  1172.  ie 'g, tate, ByVal ActboF. uc*o deter.rmo deter.rmo & ' \\\\m_St(m_S         If (m_StatOyyyyyoC)ropBag.WritePrioant  a5x a5vLtrol.Baces.Bnoum_     cus rect, 8=addse 'g, tatee DrawBss a Re1nds a Re1nds a Re1nds a Re1nds a Re1nds a Re1nds a Re1nIf (m_StatO: baAs Lw.usp routine to support   oC)ropBag.WritePrutatOyyyITuR8ty    tine to support        ate) ' graphid-
  1173.        outine
  1174.    lioant  avren mounoum_nIf (m_.Then
  1175.           nt  w left mous   nUser( IfrTaioITuR/oC.Theupport        ate) ' graphid-
  1176.        outine
  1177.    lioant  avrenntrol
  1178.         (me( r w_nIfr Uses a left mous   nUseleoum unicode, etc
  1179. upport  GED :: baDrawDermuttoMPrutatOyyyITuR8ty    tine to support        ate) ' graphid-
  1180.        outine
  1181.    lioant  a   nUsur rpp lpport  GED :: baDrawDermurrrrrracherh\\\p fo a.,  dowBw<
  1182.          to         ate) ' graphid-
  1183.        epaint"     ate) 5vbKetCap  irrrrrracherh\\e1nds a  The followings