home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / Calligraph2151094302009.psc / CandyButton2.ctl < prev   
Text File  |  2008-04-25  |  70KB  |  1,253 lines
  1. VERSION 5.00
  2. Begin VB.UserControl CandyButton 
  3.    Appearance      =   0  'Flat
  4.    AutoRedraw      =   -1  'True
  5.    BackColor       =   &H00FFFFFF&
  6.    ClientHeight    =   945
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   1815
  10.    BeginProperty Font 
  11.       Name            =   "Tahoma"
  12.       Size            =   9
  13.       Charset         =   0
  14.       Weight          =   400
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    ScaleHeight     =   63
  20.    ScaleMode       =   3  'Pixel
  21.    ScaleWidth      =   121
  22. End
  23. Attribute VB_Name = "CandyButton"
  24. Attribute VB_GlobalNameSpace = False
  25. Attribute VB_Creatable = True
  26. Attribute VB_PredeclaredId = False
  27. Attribute VB_Exposed = False
  28. Option Explicit
  29.  
  30. '-Selfsub declarations----------------------------------------------------------------------------
  31. Private Enum eMsgWhen                                                       'When to callback
  32.   MSG_BEFORE = 1                                                            'Callback before the original WndProc
  33.   MSG_AFTER = 2                                                             'Callback after the original WndProc
  34.   MSG_BEFORE_AFTER = MSG_BEFORE Or MSG_AFTER                                'Callback before and after the original WndProc
  35. End Enum
  36.  
  37. Private Const ALL_MESSAGES  As Long = -1                                    'All messages callback
  38. Private Const MSG_ENTRIES   As Long = 32                                    'Number of msg table entries
  39. Private Const WNDPROC_OFF   As Long = &H38                                  'Thunk offset to the WndProc execution address
  40. Private Const GWL_WNDPROC   As Long = -4                                    'SetWindowsLong WndProc index
  41. Private Const IDX_SHUTDOWN  As Long = 1                                     'Thunk data index of the shutdown flag
  42. Private Const IDX_HWND      As Long = 2                                     'Thunk data index of the subclassed hWnd
  43. Private Const IDX_WNDPROC   As Long = 9                                     'Thunk data index of the original WndProc
  44. Private Const IDX_BTABLE    As Long = 11                                    'Thunk data index of the Before table
  45. Private Const IDX_ATABLE    As Long = 12                                    'Thunk data index of the After table
  46. Private Const IDX_PARM_USER As Long = 13                                    'Thunk data index of the User-defined callback parameter data index
  47.  
  48. Private z_ScMem             As Long                                         'Thunk base address
  49. Private z_Sc(64)            As Long                                         'Thunk machine-code initialised here
  50. Private z_Funk              As Collection                                   'hWnd/thunk-address collection
  51.  
  52. Private Declare Function CallWindowProcA Lib "user32" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  53. Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
  54. Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
  55. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  56. Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
  57. Private Declare Function IsBadCodePtr Lib "kernel32" (ByVal lpfn As Long) As Long
  58. Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
  59. Private Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  60. Private Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
  61. Private Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
  62. Private Declare Sub RtlMoveMemory Lib "kernel32" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
  63. '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  64.  
  65. Public Event Status(ByVal sStatus As String)
  66.  
  67. Private Const WM_MOUSEMOVE    As Long = &H200
  68. Private Const WM_MOUSELEAVE   As Long = &H2A3
  69. Private Const WM_MOVING       As Long = &H216
  70. Private Const WM_SIZING       As Long = &H214
  71. Private Const WM_EXITSIZEMOVE As Long = &H232
  72.  
  73. Private Enum TRACKMOUSEEVENT_FLAGS
  74.   TME_HOVER = &H1&
  75.   TME_LEAVE = &H2&
  76.   TME_QUERY = &H40000000
  77.   TME_CANCEL = &H80000000
  78. End Enum
  79.  
  80. Private Type TRACKMOUSEEVENT_STRUCT
  81.   cbSize                      As Long
  82.   dwFlags                     As TRACKMOUSEEVENT_FLAGS
  83.   hwndTrack                   As Long
  84.   dwHoverTime                 As Long
  85. End Type
  86.  
  87. Private bTrack                As Boolean
  88. Private bTrackUser32          As Boolean
  89. Private IsHover               As Boolean
  90. Private bMoving               As Boolean
  91.  
  92. Public Event Click()
  93. Attribute Click.VB_MemberFlags = "200"
  94. Public Event DblClick()
  95. Public Event MouseEnter()
  96. Public Event MouseLeave()
  97. Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  98. Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  99. Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  100.  
  101. Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
  102. Private Declare Function LoadLibraryA Lib "kernel32" (ByVal lpLibFileName As String) As Long
  103. Private Declare Function TrackMouseEvent Lib "user32" (lpEventTrack As TRACKMOUSEEVENT_STRUCT) As Long
  104. Private Declare Function TrackMouseEventComCtl Lib "Comctl32" Alias "_TrackMouseEvent" (lpEventTrack As TRACKMOUSEEVENT_STRUCT) As Long
  105.  
  106. '-Candy Button declarations----------------------------------------------------------------------------
  107. Public Enum eAlignment
  108.     PIC_TOP
  109.     PIC_BOTTOM
  110.     PIC_LEFT
  111.     PIC_RIGHT
  112. End Enum
  113.  
  114. Public Enum eStyle
  115.     XP_Button
  116.     Mac
  117. End Enum
  118.  
  119. Public Enum eColorScheme
  120.     Custom
  121.     Aqua
  122.     WMP10
  123.     DeepBlue
  124.     DeepRed
  125.     DeepGreen
  126.     DeepYellow
  127. End Enum
  128.  
  129. Public Enum eState
  130.     eNormal
  131.     ePressed
  132.     eFocus
  133.     eHover
  134.     eChecked
  135. End Enum
  136.  
  137. Private Type tCrystalParam
  138.     Ref_MixColorFrom As Long
  139.     Ref_Intensity As Long
  140.     Ref_Left As Long
  141.     Ref_Top As Long
  142.     Ref_Radius As Long
  143.     Ref_Height As Long
  144.     Ref_Width As Long
  145.     RadialGXPercent As Long
  146.     RadialGYPercent As Long
  147.     RadialGOffsetX As Long
  148.     RadialGOffsetY As Long
  149.     RadialGIntensity As Long
  150. End Type
  151.  
  152. Private Type BITMAPINFOHEADER    '40 bytes
  153.    biSize As Long
  154.    biWidth As Long
  155.    biHeight As Long
  156.    biPlanes As Integer
  157.    biBitCount As Integer
  158.    biCompression As Long
  159.    biSizeImage As Long
  160.    biXPelsPerMeter As Long
  161.    biYPelsPerMeter As Long
  162.    biClrUsed As Long
  163.    biClrImportant As Long
  164. End Type
  165.  
  166. Private Type RGBQUAD
  167.    rgbBlue As Byte
  168.    rgbGreen As Byte
  169.    rgbRed As Byte
  170.    rgbReserved As Byte
  171. End Type
  172.  
  173. Private Type BITMAP    '24 bytes
  174.   bmType As Long
  175.   bmWidth As Long
  176.   bmHeight As Long
  177.   bmWidthBytes As Long
  178.   bmPlanes As Integer
  179.   bmBitsPixel As Integer
  180.   bmBits As Long
  181. End Type
  182.  
  183. Private Type BITMAPINFO
  184.   bmiHeader As BITMAPINFOHEADER
  185.   bmiColors As RGBQUAD
  186. End Type
  187.  
  188. Private Const BI_RGB = 0&
  189. Private Const DIB_RGB_COLORS = 0&
  190.  
  191. Private m_PictureAlignment                      As eAlignment
  192. Private m_Style                                 As eStyle
  193. Private m_Checked                               As Boolean
  194. Private m_hasFocus                              As Boolean
  195. Private m_Caption                               As String
  196. Private m_StdPicture                            As StdPicture
  197. Private m_Font                                  As StdFont
  198. Private m_ColorButtonHover                      As OLE_COLOR
  199. Private m_ColorButtonUp                         As OLE_COLOR
  200. Private m_ColorButtonDown                       As OLE_COLOR
  201. Private m_ColorBright                           As OLE_COLOR
  202. Private m_ForeColor                             As OLE_COLOR
  203. Private CornerRadius                            As Long
  204. Private m_BorderBrightness                      As Long
  205. Private m_ColorScheme                           As eColorScheme
  206. Private m_bHighLited                            As Boolean
  207. Private m_bIconHighLite                         As Boolean
  208. Private m_lIconHighLiteColor                    As OLE_COLOR
  209. Private m_bCaptionHighLite                      As Boolean
  210. Private m_lCaptionHighLiteColor                 As OLE_COLOR
  211. Private m_bEnabled                              As Boolean
  212. Private m_InitCompleted                         As Boolean
  213. Private hButtonRegion                              As Long
  214.  
  215. Private Const m_def_ForeColor                   As Long = vbBlack
  216. Private Const m_def_PictureAlignment            As Byte = 0
  217. Private Const DST_TEXT                          As Long = &H1
  218. Private Const DST_PREFIXTEXT                    As Long = &H2
  219. Private Const DST_COMPLEX                       As Long = &H0
  220. Private Const DST_ICON                          As Long = &H3
  221. Private Const DST_BITMAP                        As Long = &H4
  222. Private Const DSS_NORMAL                        As Long = &H0
  223. Private Const DSS_UNION                         As Long = &H10
  224. Private Const DSS_DISABLED                      As Long = &H20
  225. Private Const DSS_MONO                          As Long = &H80
  226. Private Const DSS_RIGHT                         As Long = &H8000
  227. Private Const RGN_XOR = 3
  228. Private Const MK_LBUTTON = &H1
  229.  
  230. Private Type POINTAPI
  231.     X As Long
  232.     Y As Long
  233. End Type
  234.  
  235. Private Type RECT
  236.         Left As Long
  237.         Top As Long
  238.         Right As Long
  239.         Bottom As Long
  240. End Type
  241.  
  242. Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  243. Private Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
  244. Private Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  245. Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
  246. Private Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal X As Long, ByVal Y As Long, ByVal cX As Long, ByVal cY As Long, ByVal fuFlags As Long) As Long
  247. Private Declare Function DrawStateText Lib "user32" Alias "DrawStateA" (ByVal hdc As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As String, ByVal wParam As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long
  248. Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  249. Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal crColor As Long) As Long
  250. Private Declare Function TranslateColor Lib "olepro32.dll" Alias "OleTranslateColor" (ByVal clr As OLE_COLOR, ByVal palet As Long, Col As Long) As Long
  251. Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal X As Long, ByVal Y As Long) As Long
  252. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  253. Private Declare Function InflateRect Lib "user32" (lpRect As RECT, ByVal X As Long, ByVal Y As Long) As Long
  254. Private Declare Function Ellipse Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  255. Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  256. Private Declare Function IsRectEmpty Lib "user32" (lpRect As RECT) As Long
  257. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  258. Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  259. Private Declare Function FillRect Lib "user32" (ByVal hdc As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  260.  
  261. 'Description: Enable or disable the control
  262. Public Property Let Enabled(bEnabled As Boolean)
  263. On Error GoTo Handler
  264.     m_bEnabled = bEnabled
  265.     PropertyChanged "Enabled"
  266.     '/*** added
  267.     DrawButton (eNormal)
  268. Handler:
  269. End Property
  270.  
  271. Public Property Get Enabled() As Boolean
  272. On Error GoTo Handler
  273.     Enabled = m_bEnabled
  274.     Refresh
  275.     Exit Property
  276. Handler:
  277. End Property
  278.  
  279. Public Property Let ColorScheme(newValue As eColorScheme)
  280.     Select Case newValue
  281.         Case Aqua
  282.             ColorButtonUp = &HD06720
  283.             ColorButtonHover = &HE99950
  284.             ColorButtonDown = &HA06710
  285.             ColorBright = &HFFEDB0
  286.         Case WMP10
  287.             ColorButtonUp = &HD09060
  288.             ColorButtonHover = &HE06000
  289.             ColorButtonDown = &HA98050
  290.             ColorBright = &HFFFAFA
  291.         Case DeepBlue
  292.             ColorButtonUp = &H800000
  293.             ColorButtonHover = &HA00000
  294.             ColorButtonDown = &HF00000
  295.             ColorBright = &HFF0000
  296.         Case DeepRed
  297.             ColorButtonUp = &H80&
  298.             ColorButtonHover = &HA0&
  299.             ColorButtonDown = &HF0&
  300.             ColorBright = &HFF&
  301.         Case DeepGreen
  302.             ColorButtonUp = &H8000&
  303.             ColorButtonHover = &HA000&
  304.             ColorButtonDown = &HC000&
  305.             ColorBright = &HFF00&
  306.         Case DeepYellow
  307.             ColorButtonUp = &H8080&
  308.             ColorButtonHover = &HA0A0&
  309.             ColorButtonDown = &HC0C0&
  310.             ColorBright = &HFFFF&
  311.     End Select
  312.     m_ColorScheme = newValue
  313.     PropertyChanged "m_ColorScheme"
  314.     DrawButton (eNormal)
  315. End Property
  316.  
  317. Public Property Get ColorScheme() As eColorScheme
  318.     ColorScheme = m_ColorScheme
  319. End Property
  320.  
  321. Public Property Let BorderBrightness(newValue As Long)
  322.     m_BorderBrightness = SetBound(newValue, -100, 100)
  323.     PropertyChanged "m_BorderBrightness"
  324.     DrawButton (eNormal)
  325. End Property
  326.  
  327. Public Property Get BorderBrightness() As Long
  328.     BorderBrightness = m_BorderBrightness
  329. End Property
  330.  
  331. '/*** enable icon mouse over highliting
  332. Public Property Get IconHighLite() As Boolean
  333.     IconHighLite = m_bIconHighLite
  334. End Property
  335.  
  336. Public Property Let IconHighLite(PropVal As Boolean)
  337.     m_bIconHighLite = PropVal
  338.     PropertyChanged "IconHighLite"
  339. End Property
  340.  
  341. '/*** enable icon mouse over highliting
  342. Public Property Get IconHighLiteColor() As OLE_COLOR
  343.     IconHighLiteColor = m_lIconHighLiteColor
  344. End Property
  345.  
  346. Public Property Let IconHighLiteColor(PropVal As OLE_COLOR)
  347.     m_lIconHighLiteColor = PropVal
  348.     PropertyChanged "IconHighLiteColor"
  349. End Property
  350.  
  351. '/*** enable caption mouse over highliting
  352. Public Property Get CaptionHighLite() As Boolean
  353.     CaptionHighLite = m_bCaptionHighLite
  354. End Property
  355.  
  356. Public Property Let CaptionHighLite(PropVal As Boolean)
  357.     m_bCaptionHighLite = PropVal
  358.     PropertyChanged "CaptionHighLite"
  359. End Property
  360.  
  361. Public Property Get CaptionHighLiteColor() As OLE_COLOR
  362.     CaptionHighLiteColor = m_lCaptionHighLiteColor
  363. End Property
  364.  
  365. Public Property Let CaptionHighLiteColor(PropVal As OLE_COLOR)
  366.     m_lCaptionHighLiteColor = PropVal
  367.     PropertyChanged "CaptionHighLiteColor"
  368. End Property
  369.  
  370. Public Property Let ColorBright(newValue As OLE_COLOR)
  371.     m_ColorBright = newValue
  372.     If m_ColorScheme <> Custom Then m_ColorScheme = Custom:  PropertyChanged "m_ColorScheme"
  373.     PropertyChanged "m_ColorBright"
  374.     DrawButton (eNormal)
  375. End Property
  376.  
  377. Public Property Get ColorBright() As OLE_COLOR
  378.     ColorBright = m_ColorBright
  379. End Property
  380.  
  381. Public Property Let ColorButtonDown(newValue As OLE_COLOR)
  382.     m_ColorButtonDown = newValue
  383.     If m_ColorScheme <> Custom Then m_ColorScheme = Custom:  PropertyChanged "m_ColorScheme"
  384.     PropertyChanged "m_ColorButtonDown"
  385.     DrawButton (eNormal)
  386. End Property
  387.  
  388. Public Property Get ColorButtonDown() As OLE_COLOR
  389.     ColorButtonDown = m_ColorButtonDown
  390. End Property
  391.  
  392. Public Property Let ColorButtonUp(newValue As OLE_COLOR)
  393.     m_ColorButtonUp = newValue
  394.     If m_ColorScheme <> Custom Then m_ColorScheme = Custom:  PropertyChanged "m_ColorScheme"
  395.     PropertyChanged "m_ColorButtonUp"
  396.     DrawButton (eNormal)
  397. End Property
  398.  
  399. Public Property Get ColorButtonUp() As OLE_COLOR
  400.     ColorButtonUp = m_ColorButtonUp
  401. End Property
  402.  
  403. Public Property Let ColorButtonHover(newValue As OLE_COLOR)
  404.     m_ColorButtonHover = newValue
  405.     If m_ColorScheme <> Custom Then m_ColorScheme = Custom:  PropertyChanged "m_ColorScheme"
  406.     PropertyChanged "m_ColorButtonHover"
  407.     DrawButton (eNormal)
  408. End Property
  409.  
  410. Public Property Get ColorButtonHover() As OLE_COLOR
  411.     ColorButtonHover = m_ColorButtonHover
  412. End Property
  413.  
  414. Public Property Let ForeColor(ByVal NewForeColor As OLE_COLOR)
  415.      m_ForeColor = NewForeColor
  416.      UserControl.ForeColor = m_ForeColor
  417.      PropertyChanged "ForeColor"
  418.      DrawButton (eNormal)
  419. End Property
  420.  
  421. Public Property Get ForeColor() As OLE_COLOR
  422.      ForeColor = m_ForeColor
  423. End Property
  424.  
  425. Public Property Set Picture(Value As StdPicture)
  426.     Set m_StdPicture = Value
  427.     PropertyChanged "Picture"
  428.     DrawButton (eNormal)
  429. End Property
  430.  
  431. Public Property Get Picture() As StdPicture
  432.     Set Picture = m_StdPicture
  433. End Property
  434.  
  435. Public Property Let Checked(Value As Boolean)
  436.     m_Checked = Value
  437.     If Value Then
  438.         DrawButton (eChecked)
  439.     Else
  440.         If IsHover Then
  441.             DrawButton (eHover)
  442.         Else
  443.             DrawButton (eNormal)
  444.         End If
  445.     End If
  446.     PropertyChanged "Checked"
  447. End Property
  448.  
  449. Public Property Get Checked() As Boolean
  450.     Checked = m_Checked
  451. End Property
  452.  
  453. Public Property Let Style(eVal As eStyle)
  454.     If eVal <> m_Style Then
  455.         m_Style = eVal
  456.         PropertyChanged "Style"
  457.         Init_Style
  458.         DrawButton (eNormal)
  459.     End If
  460. End Property
  461.  
  462. Public Property Get Style() As eStyle
  463.     Style = m_Style
  464. End Property
  465.  
  466. Public Property Let PictureAlignment(eVal As eAlignment)
  467.     If eVal <> m_PictureAlignment Then
  468.         m_PictureAlignment = eVal
  469.         PropertyChanged "PictureAlignment"
  470.         DrawButton (eNormal)
  471.     End If
  472. End Property
  473.  
  474. Public Property Get PictureAlignment() As eAlignment
  475.     PictureAlignment = m_PictureAlignment
  476. End Property
  477.  
  478. Public Property Let Caption(ByVal New_Caption As String)
  479.     m_Caption = New_Caption
  480.     PropertyChanged "Caption"
  481.     DrawButton (eNormal)
  482. End Property
  483.  
  484. Public Property Get Caption() As String
  485.     Caption = m_Caption
  486. End Property
  487.  
  488. Public Property Set Font(ByVal NewFont As StdFont)
  489.      Set UserControl.Font = NewFont
  490.      PropertyChanged "Font"
  491.      DrawButton (eNormal)
  492. End Property
  493.  
  494. Public Property Get Font() As StdFont
  495.      Set Font = UserControl.Font
  496. End Property
  497.  
  498. Private Sub UserControl_Initialize()
  499.     m_Style = Style
  500. End Sub
  501.  
  502. Private Sub UserControl_InitProperties()
  503.     If Not Ambient.UserMode Then
  504.         m_bEnabled = True
  505.         m_ColorButtonHover = &HFFC090
  506.         m_ColorButtonUp = &HE99950
  507.         m_ColorBright = &HFFEDB0
  508.         m_ColorButtonDown = &HE99950
  509.         m_Caption = UserControl.Name
  510.         UserControl.Picture = LoadPicture("")
  511.     End If
  512.     m_Caption = Extender.Name
  513.     m_InitCompleted = True
  514. End Sub
  515.  
  516. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  517.     If Not m_bEnabled Then Exit Sub
  518.     If KeyCode = vbKeyReturn Then UserControl_MouseDown 1, 0, 0, 0
  519. End Sub
  520.  
  521. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  522.     If Not m_bEnabled Then Exit Sub
  523.     If KeyCode = vbKeyReturn Then UserControl_MouseUp 1, 0, 0, 0
  524. End Sub
  525.  
  526. Private Sub UserControl_Click()
  527.     If Not m_bEnabled Then Exit Sub
  528.     RaiseEvent Click
  529. End Sub
  530.  
  531. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  532.     If Not m_bEnabled Then Exit Sub
  533.     m_hasFocus = True
  534.     DrawButton (ePressed)
  535.     RaiseEvent MouseDown(Button, Shift, X, Y)
  536. End Sub
  537.  
  538. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  539.     If Not m_bEnabled Then Exit Sub
  540.     RaiseEvent MouseMove(Button, Shift, X, Y)
  541.     If Button = 1 And (X < 0 Or X > ScaleWidth Or _
  542.         Y < 0 Or Y > ScaleHeight) Then
  543.         IsHover = False
  544.         DrawButton (eNormal)
  545.     End If
  546. End Sub
  547.  
  548. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  549.     If Not m_bEnabled Then Exit Sub
  550.     If Not m_Checked Then
  551.         If IsHover Then
  552.             DrawButton (eHover)
  553.         Else
  554.             If m_hasFocus Then DrawButton (eFocus)
  555.         End If
  556.     End If
  557.     RaiseEvent MouseUp(Button, Shift, X, Y)
  558. End Sub
  559.  
  560. Private Sub UserControl_DblClick()
  561.     If Not m_bEnabled Then Exit Sub
  562.     DrawButton (ePressed)
  563.     RaiseEvent DblClick
  564. End Sub
  565.  
  566. Private Sub UserControl_EnterFocus()
  567.     m_hasFocus = True
  568.     If Not m_bEnabled Then Exit Sub
  569.     If Not m_Checked And Not IsHover Then DrawButton (eFocus)
  570. End Sub
  571.  
  572. Private Sub UserControl_ExitFocus()
  573.     m_hasFocus = False
  574.     If Not m_bEnabled Then Exit Sub
  575.     If Not m_Checked Then DrawButton (eNormal)
  576. End Sub
  577.  
  578. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  579.     With PropBag
  580.         .WriteProperty "Enabled", m_bEnabled, True
  581.         .WriteProperty "Font", UserControl.Font, Ambient.Font
  582.         .WriteProperty "Caption", m_Caption, UserControl.Name
  583.         .WriteProperty "IconHighLite", m_bIconHighLite, False
  584.         .WriteProperty "IconHighLiteColor", m_lIconHighLiteColor, &HFF00&
  585.         .WriteProperty "CaptionHighLite", m_bCaptionHighLite, False
  586.         .WriteProperty "CaptionHighLiteColor", m_lCaptionHighLiteColor, &HFF00&
  587.         .WriteProperty "ForeColor", m_ForeColor, m_def_ForeColor
  588.         .WriteProperty "Picture", m_StdPicture, Nothing
  589.         .WriteProperty "PictureAlignment", m_PictureAlignment, m_def_PictureAlignment
  590.         .WriteProperty "Style", m_Style, 0
  591.         .WriteProperty "Checked", m_Checked
  592.         .WriteProperty "ColorButtonHover", m_ColorButtonHover
  593.         .WriteProperty "ColorButtonUp", m_ColorButtonUp
  594.         .WriteProperty "ColorButtonDown", m_ColorButtonDown
  595.         .WriteProperty "BorderBrightness", m_BorderBrightness
  596.         .WriteProperty "ColorBright", m_ColorBright
  597.         .WriteProperty "ColorScheme", m_ColorScheme
  598.     End With
  599. End Sub
  600.  
  601. Private Sub UserControl_Resize()
  602.     Init_Style
  603.     DrawButton (eNormal)
  604. End Sub
  605.  
  606. Private Sub UserControl_Show()
  607.     DrawButton (eNormal)
  608. End Sub
  609.  
  610. Private Sub DrawButton(vState As eState)
  611.     If m_Checked Then vState = eChecked
  612.     If m_InitCompleted Then
  613.         Select Case m_Style
  614.             Case XP_Button
  615.                 DrawXPButton vState
  616.             Case Mac
  617.                 DrawCrystalButton vState
  618.         End Select
  619.         DrawIconWCaption vState
  620.     End If
  621. End Sub
  622.  
  623. Public Sub DrawIconWCaption(vState As eState)
  624.     Dim pW As Long, pH As Long, lW As Long, lH As Long
  625.     Dim StartX As Long, StartY As Long, lBrush As Long, lFlags As Long
  626.     Dim lTemp As Long, XCoord As Long, YCoord As Long
  627.     
  628.     If Not m_StdPicture Is Nothing Then
  629.         pW = ScaleX(m_StdPicture.Width, vbHimetric, vbPixels)
  630.         pH = ScaleY(m_StdPicture.Height, vbHimetric, vbPixels)
  631.     End If
  632.     
  633.     If LenB(m_Caption) Then
  634.         lW = TextWidth(m_Caption)
  635.         lH = TextHeight(m_Caption)
  636.     End If
  637.     
  638.     Select Case m_PictureAlignment
  639.         Case Is = PIC_TOP
  640.             StartX = ((ScaleWidth - pW) \ 2) + 1
  641.             StartY = (ScaleHeight - (pH + lH)) \ 2 + 1
  642.             XCoord = Abs(ScaleWidth \ 2 - lW \ 2)
  643.             YCoord = Abs(ScaleHeight \ 2 + pH \ 2 - lH \ 2)
  644.         Case Is = PIC_BOTTOM
  645.             StartX = (ScaleWidth - pW) \ 2
  646.             StartY = (ScaleHeight - (pH - lH)) \ 2 + 1
  647.             XCoord = Abs(ScaleWidth \ 2 - lW \ 2)
  648.             YCoord = Abs(ScaleHeight \ 2 - (pH + lH) \ 2)
  649.         Case Is = PIC_LEFT
  650.             If CornerRadius Then StartX = CornerRadius Else StartX = 8
  651.             StartY = (ScaleHeight - pH) \ 2 + 1
  652.             XCoord = Abs(ScaleWidth \ 2 - lW \ 2)
  653.             YCoord = Abs(ScaleHeight \ 2 - lH \ 2)
  654.         Case Is = PIC_RIGHT
  655.             If CornerRadius Then StartX = ScaleWidth - CornerRadius - pW Else StartX = ScaleWidth - 8 - pW
  656.             StartY = (ScaleHeight - pH) \ 2 + 1
  657.             XCoord = Abs(ScaleWidth \ 2 - lW \ 2)
  658.             YCoord = Abs(ScaleHeight \ 2 - lH \ 2)
  659.     End Select
  660.     If vState = ePressed Then
  661.         StartX = StartX + 1: XCoord = XCoord + 1
  662.         StartY = StartY + 1: YCoord = YCoord + 1
  663.     End If
  664.     If m_bEnabled Then lFlags = DST_PREFIXTEXT Or DSS_NORMAL Else lFlags = DST_PREFIXTEXT Or DSS_DISABLED
  665.     
  666.     If vState = eHover And m_bCaptionHighLite Then
  667.         lTemp = UserControl.ForeColor
  668.         UserControl.ForeColor = m_lCaptionHighLiteColor
  669.     End If
  670.     If LenB(m_Caption) Then Call DrawStateText(hdc, 0&, 0&, m_Caption, Len(m_Caption), _
  671.                XCoord, YCoord, 0&, 0&, lFlags)
  672.     'Return the old forecolor state
  673.     If vState = eHover And m_bCaptionHighLite Then UserControl.ForeColor = lTemp
  674.     
  675.     If Not m_StdPicture Is Nothing Then
  676.         If m_StdPicture.Type = vbPicTypeBitmap Then
  677.             lFlags = DST_BITMAP
  678.         ElseIf m_StdPicture.Type = vbPicTypeIcon Then
  679.             lFlags = DST_ICON
  680.         End If
  681.         If Not m_bEnabled Then
  682.             lFlags = lFlags Or DSS_DISABLED 'Draw disabled
  683.         ElseIf vState = eHover And m_bIconHighLite Then
  684.             lBrush = CreateSolidBrush(m_lIconHighLiteColor)
  685.             lFlags = lFlags Or DSS_MONO 'Draw highlighted
  686.         End If
  687.         With m_StdPicture
  688.             DrawState hdc, lBrush, 0, .Handle, 0, CLng(StartX), _
  689.                     CLng(StartY), .Width, .Height, lFlags
  690.         End With
  691.         'm_StdPicture.Render Usercontrol.hDC, CLng(StartX), CLng(StartY), CLng(pW), CLng(pH), _
  692.                     0, m_StdPicture.Height, m_StdPicture.Width, -m_StdPicture.Height, ByVal 0&
  693.         If vState = eHover And m_bIconHighLite Then DeleteObject lBrush
  694.     End If
  695.     
  696.     UserControl.Refresh
  697. End Sub
  698.  
  699. Private Function DrawXPButton(vState As eState)
  700. Dim i As Long
  701. Dim r1 As Long, g1 As Long, b1 As Long
  702. Dim r2 As Long, g2 As Long, b2 As Long
  703. Dim uH As Long, uW As Long
  704.     uH = ScaleHeight - 1
  705.     uW = ScaleWidth - 1
  706.     On Error Resume Next
  707.         Line (0, 0)-(uW, uH), Parent.BackColor, BF
  708.     On Error GoTo 0
  709.     If vState = ePressed Then
  710.         r1 = 209: g1 = 204: b1 = 193
  711.         r2 = 229: g2 = 228: b2 = 221
  712.         For i = 0 To 3
  713.             Line (0, 1 + i)-(uW, 1 + i), RGB(r2 * (i / 3) + r1 - (r1 * (i / 3)), g2 * (i / 3) + g1 - (g1 * (i / 3)), b2 * (i / 3) + b1 - (b1 * (i / 3)))
  714.         Next
  715.         r1 = 229: g1 = 228: b1 = 221
  716.         r2 = 226: g2 = 226: b2 = 218
  717.         For i = 4 To uH - 4
  718.             Line (0, i)-(uW, i), RGB(r2 * (i / (uH - 6)) + r1 - (r1 * (i / (uH - 6))), g2 * (i / (uH - 6)) + g1 - (g1 * (i / (uH - 6))), b2 * (i / (uH - 6)) + b1 - (b1 * (i / (uH - 6))))
  719.         Next
  720.         r1 = 226: g1 = 226: b1 = 218
  721.         r2 = 242: g2 = 241: b2 = 238
  722.         For i = 0 To 4
  723.             Line (0, uH - 4 + i)-(uW, uH - 4 + i), RGB(r2 * (i / 3) + r1 - (r1 * (i / 3)), g2 * (i / 3) + g1 - (g1 * (i / 3)), b2 * (i / 3) + b1 - (b1 * (i / 3)))
  724.         Next
  725.     Else
  726.         r1 = 236: g1 = 235: b1 = 230
  727.         r2 = 214: g2 = 208: b2 = 197
  728.         For i = 0 To uH - 3
  729.             Line (1, i)-(uW, i), RGB(r1 * (i / (uH - 3)) + 255 - (255 * (i / (uH - 3))), g1 * (i / (uH - 3)) + 255 - (255 * (i / (uH - 3))), b1 * (i / (uH - 3)) + 255 - (255 * (i / (uH - 3))))
  730.         Next
  731.     
  732.         For i = 0 To 3
  733.             Line (0, uH - 4 + i)-(uW, uH - 4 + i), RGB(r2 * (i / 3) + r1 - (r1 * (i / 3)), g2 * (i / 3) + g1 - (g1 * (i / 3)), b2 * (i / 3) + b1 - (b1 * (i / 3)))
  734.         Next
  735.     End If
  736.     
  737.     Select Case vState
  738.         Case Is = eFocus
  739.             Line (0, 1)-(uW, 1), RGB(206, 231, 255)
  740.             Line (0, 2)-(uW, 2), RGB(188, 212, 246)
  741.             r1 = 188: g1 = 212: b1 = 246
  742.             r2 = 137: g2 = 173: b2 = 228
  743.             For i = 3 To uH - 3
  744.                 Line (0, i)-(3, i), RGB(r2 * (i / uH) + r1 - (r1 * (i / uH)), g2 * (i / uH) + g1 - (g1 * (i / uH)), b2 * (i / uH) + b1 - (b1 * (i / uH)))
  745.                 Line (uW - 2, i)-(uW, i), RGB(r2 * (i / uH) + r1 - (r1 * (i / uH)), g2 * (i / uH) + g1 - (g1 * (i / uH)), b2 * (i / uH) + b1 - (b1 * (i / uH)))
  746.             Next
  747.             Line (0, uH - 2)-(uW, uH - 2), RGB(137, 173, 228)
  748.             Line (0, uH - 1)-(uW, uH - 1), RGB(105, 130, 238)
  749.         Case Is = eHover
  750.             Line (0, 1)-(uW, 1), RGB(255, 240, 202)
  751.             Line (0, 2)-(uW, 2), RGB(253, 216, 137)
  752.             r1 = 253: g1 = 216: b1 = 137
  753.             r2 = 248: g2 = 178: b2 = 48
  754.             For i = 3 To uH - 3
  755.                 Line (0, i)-(3, i), RGB(r2 * (i / uH) + r1 - (r1 * (i / uH)), g2 * (i / uH) + g1 - (g1 * (i / uH)), b2 * (i / uH) + b1 - (b1 * (i / uH)))
  756.                 Line (uW - 2, i)-(uW, i), RGB(r2 * (i / uH) + r1 - (r1 * (i / uH)), g2 * (i / uH) + g1 - (g1 * (i / uH)), b2 * (i / uH) + b1 - (b1 * (i / uH)))
  757.             Next
  758.             Line (0, uH - 2)-(uW, uH - 2), RGB(248, 178, 48)
  759.             Line (0, uH - 1)-(uW, uH - 1), RGB(229, 151, 0)
  760.     End Select
  761.     
  762.     PSet (0, 1), RGB(122, 149, 168): PSet (1, 0), RGB(122, 149, 168)
  763.     Line (0, 2)-(2, 0), RGB(37, 87, 131) '7617536
  764.     Line (2, 0)-(uW - 2, 0), 7617536
  765.     PSet (uW - 1, 0), RGB(122, 149, 168): PSet (uW, 1), RGB(122, 149, 168)
  766.     Line (uW - 2, 0)-(uW, 2), RGB(37, 87, 131)  '7617536
  767.     Line (uW, 2)-(uW, uH - 2), 7617536
  768.     PSet (uW, uH - 1), RGB(122, 149, 168): PSet (uW - 1, uH), RGB(122, 149, 168)
  769.     Line (uW, uH - 2)-(uW - 2, uH), RGB(37, 87, 131) ' 7617536
  770.     Line (uW - 2, uH)-(2, uH), 7617536
  771.     PSet (1, uH), RGB(122, 149, 168): PSet (0, uH - 1), RGB(122, 149, 168)
  772.     Line (2, uH)-(0, uH - 2), RGB(37, 87, 131)  '7617536
  773.     Line (0, uH - 2)-(0, 2), 7617536
  774. End Function
  775.  
  776. Private Function DrawCrystalButton(vState As eState)
  777.     Dim CrystalParam As tCrystalParam
  778.     If m_Style = Mac Then 'Mac
  779.         'CrystalParam.Ref_MixColorFrom = 0 '20
  780.         CrystalParam.Ref_Intensity = 70 '50
  781.         CrystalParam.Ref_Left = (CornerRadius \ 3)
  782.         'CrystalParam.Ref_Top = 0
  783.         CrystalParam.Ref_Height = 12 'CornerRadius - 2
  784.         CrystalParam.Ref_Width = ScaleWidth + 2 * CornerRadius
  785.         CrystalParam.Ref_Radius = 10 'CornerRadius \ 2
  786.         CrystalParam.RadialGXPercent = 200
  787.         CrystalParam.RadialGYPercent = 100 - (7 * 100 \ ScaleHeight)
  788.         If CrystalParam.RadialGYPercent > 80 Then CrystalParam.RadialGYPercent = 80
  789.         CrystalParam.RadialGOffsetX = ScaleWidth / 2
  790.         CrystalParam.RadialGOffsetY = ScaleHeight
  791.         CrystalParam.RadialGIntensity = 130
  792.     End If
  793.     Select Case vState
  794.         Case eHover
  795.             DrawCrystal ScaleWidth, ScaleHeight, m_ColorButtonHover, CrystalParam
  796.         Case ePressed, eChecked
  797.             DrawCrystal ScaleWidth, ScaleHeight, ColorButtonDown, CrystalParam
  798.         Case eNormal, eFocus
  799.             DrawCrystal ScaleWidth, ScaleHeight, m_ColorButtonUp, CrystalParam
  800.     End Select
  801. End Function
  802.  
  803. Private Sub DrawCrystal(lWidth As Long, lHeight As Long, ByVal Color As Long, CrystalParam As tCrystalParam)
  804. Dim i As Long, j As Long, ptColor As Long, ColorBright As Long
  805. Dim RGXPercent As Single, RGYPercent As Single, RadialGradient As Long
  806. Dim hHlRgn As Long, Bordercolor As Long, nBrush As Long, ClientRct As RECT
  807.     
  808.     If CornerRadius < 1 Then CornerRadius = 1
  809.     ColorBright = m_ColorBright
  810.     'In Disabled state Color = 11583680 (light gray)
  811.     'and ColorBright = vbWhite
  812.     If Not m_bEnabled Then Color = 11583680: ColorBright = vbWhite
  813.     
  814.     RGYPercent = (100 - CrystalParam.RadialGYPercent) / (lHeight * 2)
  815.     RGXPercent = (100 - CrystalParam.RadialGXPercent) / lWidth
  816.     
  817.     If m_BorderBrightness >= 0 Then
  818.         Bordercolor = BlendColors(Color, vbWhite, m_BorderBrightness)
  819.     Else
  820.         Bordercolor = BlendColors(Color, vbBlack, -m_BorderBrightness)
  821.     End If
  822.     'Create Highlite region (hHlRgn), we will use PtInRegion to
  823.     'check if we are inside the highlite Rounded rectangle
  824.     'you could simply use IsInRoundRect(i ,j ,CrystalParam.Ref_Left, CrystalParam.Ref_Top, CrystalParam.Ref_Width, CrystalParam.Ref_Height, CrystalParam.Ref_Radius * 2, CrystalParam.Ref_Radius * 2)
  825.     'instead of PtInRegion and remove these lines, but will be slower.
  826.     hHlRgn = CreateRoundRectRgn(CrystalParam.Ref_Left, CrystalParam.Ref_Top, CrystalParam.Ref_Width, CrystalParam.Ref_Height, CrystalParam.Ref_Radius * 2, CrystalParam.Ref_Radius * 2)
  827.     'Paint the Background Color
  828.     SetRect ClientRct, 0, 0, lWidth, lHeight
  829.     nBrush = CreateSolidBrush(Color)
  830.     FillRect hdc, ClientRct, nBrush
  831.     DeleteObject nBrush
  832.     'Draw a radial Gradient
  833.     DrawElipse hdc, CrystalParam, lWidth, lHeight, Color, ColorBright
  834.     For j = 0 To lHeight
  835.         For i = 0 To lWidth \ 2
  836.             If PtInRegion(hButtonRegion, i, j) Then
  837.                 'We are inside the button
  838.                 If PtInRegion(hHlRgn, i, j) Then
  839.                     ptColor = BlendColors(vbWhite, Color, CrystalParam.Ref_MixColorFrom + j * CrystalParam.Ref_Intensity \ CornerRadius)
  840.                     Line (i, j)-(lWidth - i + 1, j), ptColor
  841.                     i = 0: j = j + 1
  842.                 End If
  843.             Else
  844.                 'this draw a thin border
  845.                 SetPixelV hdc, i, j, Bordercolor
  846.                 SetPixelV hdc, lWidth - i, j, Bordercolor
  847.             End If
  848.         Next i
  849.     Next j
  850.     DeleteObject hHlRgn
  851. End Sub
  852.  
  853. Private Sub DrawElipse(lhDC As Long, CrystalParam As tCrystalParam, lWidth, lHeight, FromColor As Long, ToColor As Long)
  854. Dim oldBrush As Long, newBrush As Long, newPen As Long, oldPen As Long
  855. Dim incX As Single, incY As Single, RadX As Long, RadY As Long
  856. Dim klr As Long, rc As RECT
  857.     klr = 1
  858.     RadX = CrystalParam.RadialGXPercent * lWidth / 100
  859.     RadY = CrystalParam.RadialGYPercent * lHeight / 100
  860.     SetRect rc, CrystalParam.RadialGOffsetX - RadX, CrystalParam.RadialGOffsetY - RadY, _
  861.                 CrystalParam.RadialGOffsetX + RadX, CrystalParam.RadialGOffsetY + RadY
  862.     incX = 1: incY = 1
  863.     If RadX > RadY Then
  864.         incX = (RadX / RadY)
  865.     Else
  866.         incY = (RadY / RadX)
  867.     End If
  868.     newBrush = CreateSolidBrush(FromColor)
  869.     oldBrush = SelectObject(lhDC, newBrush)
  870.     newPen = CreatePen(5, 0, FromColor)
  871.     oldPen = SelectObject(lhDC, newPen)
  872.     Do Until Not IsRectEmpty(rc) = 0
  873.         Ellipse lhDC, rc.Left, rc.Top, rc.Right, rc.Bottom
  874.         InflateRect rc, -incX, -incY
  875.         klr = klr + 1
  876.         newBrush = CreateSolidBrush(BlendColors(FromColor, ToColor, klr * CrystalParam.RadialGIntensity / RadY))
  877.         DeleteObject SelectObject(lhDC, newBrush)
  878.     Loop
  879.     DeleteObject SelectObject(lhDC, oldBrush)
  880.     DeleteObject SelectObject(lhDC, oldPen)
  881. End Sub
  882.  
  883.  
  884. '/----------------------------------------------------------------------------------/
  885. '/                                                                                  /
  886. '/ Init_Style                                                                       /
  887. '/ -------------------                                                              /
  888. '/ Description:                                                                     /
  889. '/                                                                                  /
  890. '/ Init_Style will create the window region according to the button style           /
  891. '/ and will be responsible of storing the same region (but without the border)      /
  892. '/ in hButtonRegion. This will be used later to determine if a point                /
  893. '/ is inside the button region.                                                     /
  894. '/----------------------------------------------------------------------------------/
  895. Private Sub Init_Style()
  896. Dim lCornerRad As Long
  897.     'Remove the older Region
  898.     If hButtonRegion Then DeleteObject hButtonRegion
  899.     Select Case m_Style
  900.         Case Mac
  901.             lCornerRad = 12
  902.     End Select
  903.     If m_Style = Mac Then
  904.         hButtonRegion = CreateRoundedRegion(0, 0, ScaleWidth, ScaleHeight, lCornerRad)
  905.         'Set the Button Region
  906.         Call SetWindowRgn(hWnd, hButtonRegion, True)
  907.         DeleteObject hButtonRegion
  908.         'Store the region but exclude the border
  909.         hButtonRegion = CreateRoundedRegion(1, 1, ScaleWidth - 2, ScaleHeight - 2, lCornerRad)
  910.     Else
  911.         Call SetWindowRgn(hWnd, 0, True)
  912.     End If
  913.     UserControl.Picture = LoadPicture("")
  914. End Sub
  915.  
  916. '/----------------------------------------------------------------------------------/
  917. '/                                                                                  /
  918. '/ CreateRoundedRegion                                                              /
  919. '/ -------------------                                                              /
  920. '/ Description:                                                                     /
  921. '/                                                                                  /
  922. '/ CreateRoundedRegion returns a rounded region based on a given Width, Height      /
  923. '/ and a CornerRadius. We will use this function instead of normal CreateRoundRect  /
  924. '/ because this will give us a better rounded rectangle for our purposes.           /
  925. '/----------------------------------------------------------------------------------/
  926. Private Function CreateRoundedRegion(X As Long, Y As Long, lWidth As Long, lHeight As Long, Radius As Long) As Long
  927. Dim i As Long, j As Long, i2 As Long, j2 As Long, i3 As Long, j3 As Long
  928. Dim hRgn As Long
  929.     CornerRadius = Radius
  930.     If CornerRadius < 1 Then CornerRadius = 1
  931.     '/* Create initial region
  932.     hRgn = CreateRectRgn(0, 0, X + lWidth, Y + lHeight)
  933.     For j = 0 To Y + lHeight
  934.         For i = 0 To (X + lWidth) \ 2
  935.             If Not IsInRoundRect(i, j, X, Y, lWidth, lHeight, CornerRadius) Then
  936.                 '/* substract the pixels outside of the rounded rectangle
  937.                 '/* (it doesn't exclude the border)
  938.                 If Not j = j2 Then
  939.                     '*** If 2 * i2 <> Width Then i2 = i2 + 1
  940.                     ExcludePixelsFromRegion hRgn, X + lWidth - i2, j2, lWidth - i, j
  941.                     If Not 2 * i2 = X + lWidth Then
  942.                         i2 = i2 + 1
  943.                     End If
  944.                     ExcludePixelsFromRegion hRgn, i, j, i2, j2
  945.                 End If
  946.                 i2 = i
  947.                 j2 = j
  948.             End If
  949.         Next i
  950.     Next j
  951.     CreateRoundedRegion = hRgn
  952. End Function
  953.  
  954. Private Sub ExcludePixelsFromRegion(hRgn As Long, X1 As Long, Y1 As Long, X2 As Long, Y2 As Long)
  955.     Dim hRgnTemp As Long
  956.     hRgnTemp = CreateRectRgn(X1, Y1, X2, Y2)
  957.     CombineRgn hRgn, hRgn, hRgnTemp, RGN_XOR
  958.     DeleteObject hRgnTemp
  959. End Sub
  960.  
  961. Private Function IsInRoundRect(i As Long, j As Long, X As Long, Y As Long, lWidth As Long, lHeight As Long, Radius As Long) As Boolean
  962. Dim offX As Long, offY As Long
  963.     offX = i - X
  964.     offY = j - Y
  965.     If offY > Radius And offY + Radius < lHeight And offX > Radius And offX + Radius < lWidth Then
  966.         '/* This is to catch early most cases
  967.         IsInRoundRect = True
  968.     ElseIf offX < Radius And offY <= Radius Then
  969.         If IsInCircle(offX - Radius, offY, Radius) Then IsInRoundRect = True
  970.     ElseIf offX + Radius > lWidth And offY <= Radius Then
  971.         If IsInCircle(offX - lWidth + Radius, offY, Radius) Then IsInRoundRect = True
  972.     ElseIf offX < Radius And offY + Radius >= lHeight Then
  973.         If IsInCircle(offX - Radius, offY - lHeight + Radius * 2, Radius) Then IsInRoundRect = True
  974.     ElseIf offX + Radius > lWidth And offY + Radius >= lHeight Then
  975.         If IsInCircle(offX - lWidth + Radius, offY - lHeight + Radius * 2, Radius) Then IsInRoundRect = True
  976.     Else
  977.         If offX > 0 And offX < lWidth And offY > 0 And offY < lHeight Then IsInRoundRect = True
  978.     End If
  979. End Function
  980.  
  981. Private Function IsInCircle(ByRef X As Long, ByRef Y As Long, ByRef r As Long) As Boolean
  982. Dim lResult As Long
  983.     '/* this detect a circunference centered on y=-r and x=0
  984.     lResult = (r * r) - (X * X)
  985.     If lResult >= 0 Then
  986.         lResult = Sqr(lResult)
  987.         If Abs(Y - r) < lResult Then IsInCircle = True
  988.     End If
  989. End Function
  990.  
  991. Public Function BlendColors(ByRef Color1 As Long, ByRef Color2 As Long, ByRef Percentage As Long) As Long
  992. Dim r(2) As Long, g(2) As Long, b(2) As Long
  993.     
  994.     Percentage = SetBound(Percentage, 0, 100)
  995.     
  996.     GetRGB r(0), g(0), b(0), Color1
  997.     GetRGB r(1), g(1), b(1), Color2
  998.     
  999.     r(2) = r(0) + (r(1) - r(0)) * Percentage \ 100
  1000.     g(2) = g(0) + (g(1) - g(0)) * Percentage \ 100
  1001.     b(2) = b(0) + (b(1) - b(0)) * Percentage \ 100
  1002.     
  1003.     BlendColors = RGB(r(2), g(2), b(2))
  1004. End Function
  1005.  
  1006. Private Function SetBound(ByRef Num As Long, ByRef MinNum As Long, ByRef MaxNum As Long) As Long
  1007.     If Num < MinNum Then
  1008.         SetBound = MinNum
  1009.     ElseIf Num > MaxNum Then
  1010.         SetBound = MaxNum
  1011.     Else
  1012.         SetBound = Num
  1013.     End If
  1014. End Function
  1015.  
  1016. Public Sub GetRGB(r As Long, g As Long, b As Long, Color As Long)
  1017. Dim TempValue As Long
  1018.     TranslateColor Color, 0, TempValue
  1019.     r = TempValue And &HFF&
  1020.     g = (TempValue And &HFF00&) \ &H100&
  1021.     b = (TempValue And &HFF0000) \ &H10000
  1022. End Sub
  1023.  
  1024. Private Function HiWord(lDWord As Long) As Integer
  1025.   HiWord = (lDWord And &HFFFF0000) \ &H10000
  1026. End Function
  1027.  
  1028. Private Function LoWord(lDWord As Long) As Integer
  1029.   If lDWord And &H8000& Then
  1030.     LoWord = lDWord Or &HFFFF0000
  1031.   Else
  1032.     LoWord = lDWord And &HFFFF&
  1033.   End If
  1034. End Function
  1035. 'Read the properties from the property bag - also, a good place to start the subclassing (if we're running)
  1036. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  1037.   Dim w As Long
  1038.   Dim h As Long
  1039.   Dim s As String
  1040.   
  1041.     With PropBag
  1042.         m_bEnabled = .ReadProperty("Enabled", True)
  1043.         Set UserControl.Font = .ReadProperty("Font", Ambient.Font)
  1044.         m_Caption = .ReadProperty("Caption", UserControl.Name)
  1045.         m_bCaptionHighLite = .ReadProperty("CaptionHighLite", False)
  1046.         m_lCaptionHighLiteColor = .ReadProperty("CaptionHighLiteColor", &HFF00&)
  1047.         m_bIconHighLite = .ReadProperty("IconHighLite", False)
  1048.         m_lIconHighLiteColor = .ReadProperty("IconHighLiteColor", &HFF00&)
  1049.         m_ForeColor = .ReadProperty("ForeColor", m_def_ForeColor)
  1050.         Set m_StdPicture = .ReadProperty("Picture", Nothing)
  1051.         m_PictureAlignment = .ReadProperty("PictureAlignment", m_def_PictureAlignment)
  1052.         Style = .ReadProperty("Style", 0)
  1053.         m_Checked = .ReadProperty("Checked", m_Checked)
  1054.         m_ColorButtonHover = .ReadProperty("ColorButtonHover", &HFFC090)
  1055.         m_ColorButtonUp = .ReadProperty("ColorButtonUp", &HE99950)
  1056.         m_ColorButtonDown = .ReadProperty("ColorButtonDown", &HE99950)
  1057.         m_ColorBright = .ReadProperty("ColorBright", &HFFEDB0)
  1058.         m_BorderBrightness = .ReadProperty("BorderBrightness", 0)
  1059.         m_ColorScheme = .ReadProperty("ColorScheme", 0)
  1060.     End With
  1061.     UserControl.ForeColor = m_ForeColor
  1062.     
  1063.   If Ambient.UserMode Then                                                              'If we're not in design mode
  1064.     bTrack = True
  1065.     bTrackUser32 = IsFunctionExported("TrackMouseEvent", "User32")
  1066.   
  1067.     If Not bTrackUser32 Then
  1068.       If Not IsFunctionExported("_TrackMouseEvent", "Comctl32") Then
  1069.         bTrack = False
  1070.       End If
  1071.     End If
  1072.   
  1073.     If bTrack Then
  1074.       'OS supports mouse leave, so let's subclass for it
  1075.       With UserControl
  1076.         'Subclass the UserControl
  1077.         sc_Subclass .hWnd
  1078.         sc_AddMsg .hWnd, WM_MOUSEMOVE
  1079.         sc_AddMsg .hWnd, WM_MOUSELEAVE
  1080.       End With
  1081.     End If
  1082.   End If
  1083.   m_InitCompleted = True
  1084. End Sub
  1085.  
  1086. 'The control is terminating - a good place to stop the subclasser
  1087. Private Sub UserControl_Terminate()
  1088.   sc_Terminate                                                              'Terminate all subclassing
  1089.   If hButtonRegion Then DeleteObject hButtonRegion
  1090. End Sub
  1091.  
  1092. 'Determine if the passed function is supported
  1093. Private Function IsFunctionExported(ByVal sFunction As String, ByVal sModule As String) As Boolean
  1094.   Dim hMod        As Long
  1095.   Dim bLibLoaded  As Boolean
  1096.  
  1097.   hMod = GetModuleHandleA(sModule)
  1098.  
  1099.   If hMod = 0 Then
  1100.     hMod = LoadLibraryA(sModule)
  1101.     If hMod Then
  1102.       bLibLoaded = True
  1103.     End If
  1104.   End If
  1105.  
  1106.   If hMod Then
  1107.     If GetProcAddress(hMod, sFunction) Then
  1108.       IsFunctionExported = True
  1109.     End If
  1110.   End If
  1111.  
  1112.   If bLibLoaded Then
  1113.     FreeLibrary hMod
  1114.   End If
  1115. End Function
  1116.  
  1117. 'Track the mouse leaving the indicated window
  1118. Private Sub TrackMouseLeave(ByVal lng_hWnd As Long)
  1119.   Dim tme As TRACKMOUSEEVENT_STRUCT
  1120.   
  1121.   If bTrack Then
  1122.     With tme
  1123.       .cbSize = Len(tme)
  1124.       .dwFlags = TME_LEAVE
  1125.       .hwndTrack = lng_hWnd
  1126.     End With
  1127.  
  1128.     If bTrackUser32 Then
  1129.       TrackMouseEvent tme
  1130.     Else
  1131.       TrackMouseEventComCtl tme
  1132.     End If
  1133.   End If
  1134. End Sub
  1135.  
  1136. '-SelfSub code------------------------------------------------------------------------------------
  1137. Private Function sc_Subclass(ByVal lng_hWnd As Long, _
  1138.                     Optional ByVal lParamUser As Long = 0, _
  1139.                     Optional ByVal nOrdinal As Long = 1, _
  1140.                     Optional ByVal oCallback As Object = Nothing, _
  1141.                     Optional ByVal bIdeSafety As Boolean = True) As Boolean 'Subclass the specified window handle
  1142. '*************************************************************************************************
  1143. '* lng_hWnd   - Handle of the window to subclass
  1144. '* lParamUser - Optional, user-defined callback parameter
  1145. '* nOrdinal   - Optional, ordinal index of the callback procedure. 1 = last private method, 2 = second last private method, etc.
  1146. '* oCallback  - Optional, the object that will receive the callback. If undefined, callbacks are sent to this object's instance
  1147. '* bIdeSafety - Optional, enable/disable IDE safety measures. NB: you should really only disable IDE safety in a UserControl for design-time subclassing
  1148. '*************************************************************************************************
  1149. Const CODE_LEN      As Long = 260                                           'Thunk length in bytes
  1150. Const MEM_LEN       As Long = CODE_LEN + (8 * (MSG_ENTRIES + 1))            'Bytes to allocate per thunk, data + code + msg tables
  1151. Const PAGE_RWX      As Long = &H40&                                         'Allocate executable memory
  1152. Const MEM_COMMIT    As Long = &H1000&                                       'Commit allocated memory
  1153. Const MEM_RELEASE   As Long = &H8000&                                       'Release allocated memory flag
  1154. Const IDX_EBMODE    As Long = 3                                             'Thunk data index of the EbMode function address
  1155. Const IDX_CWP       As Long = 4                                             'Thunk data index of the CallWindowProc function address
  1156. Const IDX_SWL       As Long = 5                                             'Thunk data index of the SetWindowsLong function address
  1157. Const IDX_FREE      As Long = 6                                             'Thunk data index of the VirtualFree function address
  1158. Const IDX_BADPTR    As Long = 7                                             'Thunk data index of the IsBadCodePtr function address
  1159. Const IDX_OWNER     As Long = 8                                             'Thunk data index of the Owner object's vTable address
  1160. Const IDX_CALLBACK  As Long = 10                                            'Thunk data index of the callback method address
  1161. Const IDX_EBX       As Long = 16                                            'Thunk code patch index of the thunk data
  1162. Const SUB_NAME      As String = "sc_Subclass"                               'This routine's name
  1163.   Dim nAddr         As Long
  1164.   Dim nID           As Long
  1165.   Dim nMyID         As Long
  1166.   
  1167.   If IsWindow(lng_hWnd) = 0 Then                                            'Ensure the window handle is valid
  1168.     zError SUB_NAME, "Invalid window handle"
  1169.     Exit Function
  1170.   End If
  1171.  
  1172.   nMyID = GetCurrentProcessId                                               'Get this process's ID
  1173.   GetWindowThreadProcessId lng_hWnd, nID                                    'Get the process ID associated with the window handle
  1174.   If nID <> nMyID Then                                                      'Ensure that the window handle doesn't belong to another process
  1175.     zError SUB_NAME, "Window handle belongs to another process"
  1176.     Exit Function
  1177.   End If
  1178.   
  1179.   If oCallback Is Nothing Then                                              'If the user hasn't specified the callback owner
  1180.     Set oCallback = Me                                                      'Then it is me
  1181.   End If
  1182.   
  1183.   nAddr = zAddressOf(oCallback, nOrdinal)                                   'Get the address of the specified ordinal method
  1184.   If nAddr = 0 Then                                                         'Ensure that we've found the ordinal method
  1185.     zError SUB_NAME, "Callback method not found"
  1186.     Exit Function
  1187.   End If
  1188.     
  1189.   If z_Funk Is Nothing Then                                                 'If this is the first time through, do the one-time initialization
  1190.     Set z_Funk = New Collection                                             'Create the hWnd/thunk-address collection
  1191.     z_Sc(14) = &HD231C031: z_Sc(15) = &HBBE58960: z_Sc(17) = &H4339F631: z_Sc(18) = &H4A21750C: z_Sc(19) = &HE82C7B8B: z_Sc(20) = &H74&: z_Sc(21) = &H75147539: z_Sc(22) = &H21E80F: z_Sc(23) = &HD2310000: z_Sc(24) = &HE8307B8B: z_Sc(25) = &H60&: z_Sc(26) = &H10C261: z_Sc(27) = &H830C53FF: z_Sc(28) = &HD77401F8: z_Sc(29) = &H2874C085: z_Sc(30) = &H2E8&: z_Sc(31) = &HFFE9EB00: z_Sc(32) = &H75FF3075: z_Sc(33) = &H2875FF2C: z_Sc(34) = &HFF2475FF: z_Sc(35) = &H3FF2473: z_Sc(36) = &H891053FF: z_Sc(37) = &HBFF1C45: z_Sc(38) = &H73396775: z_Sc(39) = &H58627404
  1192.     z_Sc(40) = &H6A2473FF: z_Sc(41) = &H873FFFC: z_Sc(42) = &H891453FF: z_Sc(43) = &H7589285D: z_Sc(44) = &H3045C72C: z_Sc(45) = &H8000&: z_Sc(46) = &H8920458B: z_Sc(47) = &H4589145D: z_Sc(48) = &HC4836124: z_Sc(49) = &H1862FF04: z_Sc(50) = &H35E30F8B: z_Sc(51) = &HA78C985: z_Sc(52) = &H8B04C783: z_Sc(53) = &HAFF22845: z_Sc(54) = &H73FF2775: z_Sc(55) = &H1C53FF28: z_Sc(56) = &H438D1F75: z_Sc(57) = &H144D8D34: z_Sc(58) = &H1C458D50: z_Sc(59) = &HFF3075FF: z_Sc(60) = &H75FF2C75: z_Sc(61) = &H873FF28: z_Sc(62) = &HFF525150: z_Sc(63) = &H53FF2073: z_Sc(64) = &HC328&
  1193.  
  1194.     z_Sc(IDX_CWP) = zFnAddr("user32", "CallWindowProcA")                    'Store CallWindowProc function address in the thunk data
  1195.     z_Sc(IDX_SWL) = zFnAddr("user32", "SetWindowLongA")                     'Store the SetWindowLong function address in the thunk data
  1196.     z_Sc(IDX_FREE) = zFnAddr("kernel32", "VirtualFree")                     'Store the VirtualFree function address in the thunk data
  1197.     z_Sc(IDX_BADPTR) = zFnAddr("kernel32", "IsBadCodePtr")                  'Store the IsBadCodePtr function address in the thunk data
  1198.   End If
  1199.   
  1200.   z_ScMem = VirtualAlloc(0, MEM_LEN, MEM_COMMIT, PAGE_RWX)                  'Allocate executable memory
  1201.  
  1202.   If z_ScMem <> 0 Then                                                      'Ensure the allocation succeeded
  1203.     On Error GoTo 3NhSS920458B: z_Sc(47) = &0le920458B: z_Sc(47) = &0loTo 3NhSS920458((15) = &HBBEylsocate_BADPTR) = zFnAddr("kadiusen                             'Store the IsBadCodePtr fBSc(47) = &0le92FnAdstalParam.Ref_Top = 0
  1204.       belont   fX < lWidth AndiiFnAdd=m             al_"C****************     'Store the IsBadCodef the passnt pEB, 1,             O       pEB, 1,         s") e s")32", "IsBadCodePtr") Otr, 1,   ast private method, etc.d   b = (TempV> 0 Then     2     ak data
  1205.   Ens")32", "IsBadCodePtr"sure the allp(     2     akPAGE_RWX         'Store CallWilont   fX  pEB, 1,         s") eeded
  1206.     On Error GoTo 3NhSS, Truls"_Sc(4"do the onel1,         s")   pEB, 1,      he IIIIIIIIIIIIIIII"CallAddvS 7) = &0le92FnAdsel1,         s")   pEB, 1,      he IIIIII2= 16                              zAddr12     ak dp    R         later to determine0&       eceive the k dp  III= &0le92FnAdsel1,         s"Telong to anonThen bce the k dp  III= &0le92FnAdReadPropePtr"De92Fn:ong to anonThen bce the k dp  III= &0le92FnAdReadProphhhhhhhhhhhhhhhhhhhhhhh= &H891453FF: z_Sc(43) = &H7589285D: zAedeEB, 1,   n      ))bT")             H75iwe        2n sBs)mpP  'Allocats      m_bIcooUhen    we   in D      D50: rMsBs)mpP  'Allocats      m_bIcooUhen    we   in D   =ddddddddd z_Sc(29) StooUhS1"      CrystalParam.Radi1"  eProperty "ChP_am.Radi1"  ePropersR we   in D      &H7Objeca1ne0&2ePropersR w6ong to _Sc(47) =       'Tf1: z_Sc(15) = &HBBE58960: z_Sc(
  1207.     ri8960: z_Sc(
  1208.     ri8960 last iAP) = zFnAd8uC328&
  1209.  
  1210. 6 o  we   auFongggggE_RWX      As Long = &H40&: z_Sc(5Ait Funct.2", "VirtuStore the Se z_Sc(
  1211.     ri s")serR w6ong to _Sc(47) =       'TLh3ar s")ser = &HA78C985: z_Scddr(Lh3ar s")ser = &H hWnd/thunk-address collection9rMsBs)mB15) tion9rMsBs)985: z_Scddr(Lh3ar s")s896)mB15) CUri z_Scdd     (6ong to _Sc(47)te" anz_Scddr( &H1C53FF2mrinl_Sc(38) = &H73396775: z_Sc(39) = &H58627404
  1212.     o = &Hs(o1) = &HFFE9EBDtion9rMsBsRttion9rMsBsRttion9rMsBsRttLz_Scdd     (6ong to _Sc(47)te" anz_the k1: z_ernel32", "VirtualFree")    Dtion9rMsBsRtt6on= 16         ")    Dti2in a UserControl for desi 149, 16sRtt6oI)= 16         ")    Dti2= &H10C261: z_Sc(27) = &H830C53FF: z_So1) = &2, 149,  = &rn= &rn= &rn= &rn= &6) = &H10C2"Inva &H10tn= &H7589285D: zAedeEB, 1,   n      ))bT")             H75iwM2Aan      ))Shsatc* (MSG_ENTzI)= 16        NFnAdRead IIIIIIIIII"CallAddvSkedae3 def"&rn= &rn49, 16s._C7404
  1213.  Cs  (6ong R35) =5D: zAedc(0, MEt the processl_ToeM2Aan      ))Shsatc* (M_Sc(49) = &H18Sc(27) = FnAdd= ))Shsatc*      PAGE_RWX scessl_ToeM2Aan 2Aan 2Aan 2c(49) = &H18Sc(27)IadeEB, Oa  s")s896)s = m_Fead IIIIIIII     yion9rhe hWnd/thh theck Is NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNo")s896)s TEF)(g6124: z_Sc(49) = &H1862FF04: iH = &HD2316.: z_Sc(49 a03qr6t:iH = &h &H10C261: z_Sc(27) SWL       As L6124: z_Sc(49) = &H18'Th z_Sc(27) ) = &Bead IIIIIIII     yion9rhe_)Width The SWL   mONNNNNNNNNNNNNNocE(ion SetBound(atc*     em~SetWinam.RC> 0h AndiiFnA_ H75iodef the pHIENNNNocE(ion_Sc(49 a03qr68B: zMuTSc(49 a03 ***********uf the pHIENNNNocE(ion_Sc(49Fu>docE(ion_Sc(490h And/z_Sc(aNocE(ion_Sc(49Fu>docE(ion_M docE(8888Rgn, hRgn, hRgnTemp, RGN_XORtu        an 2Aan 2Aan 2c(49) = &H    Then bceIf vState = eHoverSah z_Sck Is NNNNN7) = &HBFF1C45:u               4 an 2Aan 2Aan 2c(49) =aTan 2Ag to _Sc(47)te" anz_tNNNNNNNNNNNNavSt45:u   NNNan 2AanH10CContr3si 14CmthRgnT'a NNNaEB, 1,   n      ))bT")   EAan 2cA  On ErrorDX_FREE) = z           Long ErrorDX_FREE) = z           Longc(IDX_So   g(2) = g(0) + (g(1) - g(ong, lWidth AX    End If
  1214.   
  1215. that  = &H7t \ 2 ve the callback. If unHHHHHHHHHHHHHHHNs89:w   siodefhe fcdeX_So   w0h Ane(27) = &H830aC( hat  = &H fcdeX_So   w0t:iH = &h &H10C261: z_Sc(2 = S, Truls"_Sc(4"ad If
  1216.   
  1217. a
  1218.   Ens")32", "IsBadCodePtr"sure the allp(     2     akPAGE_RWX         'Store CallWilont   fX  pEe   NNNan 2AanHdefhe fcdeX_So   w0h ePtr function address in the tU(      the pEe   2     aSo   w0h ePtr functior(Lh3ar s")s896)mB15) h theck Is NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNp75FF2C75: z_Sc(61) =(49) Ee diiFnA_ H75iodef the p43ar s")WU9 a03qr6tm Tem0
  1219.  B0h e<1)e pro g(0) Np75FF2C7Sc(2jte 
  1220. a   2     aSo   w0h ePtr functior(Lh3ar s")s896)mB15) h theck Is NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNp75FF2C75: z_Sc(61) =(49) Ee diiFnA_ H75iodef the p43ar s")WU9 a03qr6tm Tem0
  1221.  B0h e<1)e pro g(0) Np75FF2C7Sc(2jte 
  1222. a   2     aSo   w0h ePtr functior(Lh3ar s" &h &H10C2 S, Truls"_Sc03qr6tm Tem0
  1223. 10C2 S, Truls"_Sc03qr6tm Te.) = h theck Is Nr s")s896)mBdetheck Is Nr s")s896)mBdetheck Is Nr s")s896)mCalunction2  z_Sc(IDX_SWL) = zFnAddr("user32caf Calunction2  z_Sc(IDction2  z dp    R        28&rN5FF2C7Sc(   .'_l4NNNNNNp7M32caf Calunction2  z_S4ercolz_Sc(IDct2Is"_Scri' dCallWindong = 0, _
  1224.    FREF2C7SCalalunction2  z_ScWC7SCalalunction2        Sty"lmNNp7f Is Nr s")Lh3ar    .'_la    ro anonsCWP) = zFnAddr("user32", "CallWindowProcA")       ) H75(2, 0AX    End IfllWindol1_ScWC7SCalalunction2  eunctior(Lh3ar s")s896)mB15) h theck Is NNNNNNNNNNdEnd IfonsCWP) = zFnAddr(h3a6uncti0&) \ &HId(h3a6uncti0&)theck Is NNNNNNNNNNdEnd IfonsCWP) = zFnAddr3 = zzzzz         no<nC> 0hzz aB1H   End*m_bCaptionHightaB1H   Cc Is Nru"c Is Atlun6the allocation succeeded
  1225.     On Error GoTo 3nd*m_bCaptionHightaB1H   Cc Is Nru"c Is Atlun6the allocation succeeded
  1226.     On Error GoTo 3nd*m_bCaptionHightaB1H   Cc Is Nru"c Is Atlun6the allo A15) h theck I&2ePropersR w6ong to10C2 )taB1iIIIII   ) = &H7589285D: zAedeEB, e to e to e to e to ealunction2 o e to 15) h thecffffffldef the p43ar s")WU9 a03qr6tm Tem0
  1227.  B0h e<1)e pSc(49 a  ) = &tuncti    On ErrorgTl p43ar s")WU9 a03qr6tm Tem0
  1228.  Bffls")WU9 adSC7Sc(   .'_l4NNNNNNp7M32caf Ca3 Bffls")WU9 advsdEnd IfonsCWP) GeEB, e to e to e eCCCCCCCCCCCC
  1229.  Bffls")WU9 adSC7Sc(   .'_l4NNNNNNp7M32caf Ca3 Bffls")WU9 advsdEnd IfonsCWP) Gc(IDctiAI-_Sc(IDX_SWL) = zem0
  1230.  RjjjjjjjjjjjSe(49) = M32caf CallWindong s(ByeCCCCCCCbo e toodef the pHIENNNCapt aSEVIs Nr s")s896)mBdethecrjjjjj = M33333ACallWBM hat ropersRthe pHIENNNCapt aSEVIs pHIENh ePtrpropeCng, os s")s896)mjjjjjU9 adCalalunctSelat ropersRtho hat r aSEts aB1H   End*m_b Bffm4to NropersRtho hat r(Etho hat r(Etho hat r(Etho hRrjjjjjjSe(4HSelat ropersRtho hat r aSEts aB1Hng,wAan      ))SrpropeCng,t = &HBFF1C45: z_ onel1,       10   p=oeMallWTl p4NNNNp7M320: z_Sc(at  s-M320: z_Sc(at  s-M320: z0: z( aSNNNNNNNNNNNNNNNNNNNNNp75FF2C75: z_Sc(61) =(49) Ee d(49) E8'Th zto Nropeef CaNNNp75FeBgap75theBgGmKNNNNNNNocE(ioi  Line (uW - 2,KNNNNun6thR           r1 = 188: g1 = 5: 2s At2XFnAd0h e<re.Height, ByVal 0&
  1231.         If vState &H fcd tCarML32 Then
  1232.       TrackMd>allWindoN(Rhe pEe 7SCalalRna o 261 a033trINNp75FeBgc(IDctiNNp75FeBgap75theBgGmKNNNNNNNocE(ioi  Line (uW - 2,KNNNNun6thR    P>caSt45:u   NNNan 2AanH10")    Gothe passnt pEB passnt pEB passnt pEB passnt pEB passnt pEB passnt pEB passnt pEB passnt pEB passnt p.RC> 0h And*********uf the pHIENN3RC> 0h And**TrackMd>allWindoN3RC> 0h And**TrackMd>allWindoN3RC> 0h Andassnt pEB 5: 2s At2XFnAd0 2s At2X"B 5: 2s At2XFnAdM &H fcd tCarML32 Then
  1233.       Trace to e to e to ealuncti thB 5: 2s Aealuncti MNNNNNN175iodef the p4nd IfonsCWP) Gc(IDctiAI-_Sc(IDX_SWL) = z 5: 2s Aealuncti MNNNNNN175iode &HId(hiAI-_is At2XFCCCC fun: z_Sc(51) = &HA78C985: z_Sc(52) = &H84in a UserContro klr   p=oeMallWTl p4NNNNp7rsRtho hat r aSEts aB1H   End*m_b Bffm4to Nropf3396775: z9285D: zAedeEB, e to e to e to e to ealuncallWWWWWE, e to ei uncti thB 5: 2sre th  N>hzz aB1H  = &HA78C985:allpoV)NNNan 2AanH10CContr3si 14perty("StyNNNN175iocWWE, e toNN175iocWWEBt2XFCCCC 78C985:allpoV)NNNan 2AanH10CCo:allpoV)NNNan 2AanH10Nr s"4bTrackUs2222222222222222222222222222222222222225:acallWt pEB passnt pEB passnt pEB passnt pEB pasKns5D: zAsluncti thB'H10cti thB'H1             O3e8C9          O3e8C9    i toNNii tnounpasKns5D: zAsluncti thB'H1l        l       oOOb'H10c3) of1functior(Lh3ar s"2225:acallWt pEB passnt pEB passnt pEB passnt pEB pasKns5D: zAsluncti thB'H10tueD: zA e toNN175oNN175=ssnt pEB p) h tluncti pHIENNNCa(E22222222tlocDsluncti p0rDX_FREE)03qmgD: zAedeEB, 1,   n      ))bT")             H7   lWindong = 0, _
  1234.    <2h ePtr functionEW(lcD: zzzzzzzzzzzzzzzzzA5: z_p8wNo= z 5:1Cbmr(LB Oa  s" (8 pHIENNNCa(E2222p8 pHIldpHIENb 3qmgD: zAedYzzzzzzA5NNNNNmEB, e tCC
  1235.  Bffli pasKns5D: zAsluNNNCa(ENWtiAI-_Sc(IDX_SWee s" ns")s
  1236.       EB pAanI-_Sc(IDX_SWee sunEW(lcD: zzzzzzzzzzzzzzzzzA5: z_p8wNo=9) E8'Th zto NraB1H   End*m_b Bffm4to Nrop2 s"mRn43ar s")WU9 a03qr6tm TIENNNCa(E5: z_p8wNea03qr1*m_b BBm_b RC> 02Ed>allNii tnouon2  z_Scm TIENNNCa(E5: z_p8wNea03qr1*mpC> 0eC>  zAsluncti thB'H10tue)s1uon2  NNNp75FeBgap75theBgGmKNNNNNNNocE(ioi  Line (uW - 2,KNNNNun6thR  Tncti thB'H10tuap8wNea03qr1*mpC> 0eC>  c2Ag to1LCallp( )))))i  End*m_b Bffb)- Han-fb)- n-fb)- n-fb)- n-fb)- n-fb)- n-fb)- n-fc(38) = &H73396775: z_Scn-fb)- nH35E30F8B: AD: zzzzzzzzzzzzzzzzzA5: OGb)- n-fn: z_Sc(-fbs Nr l9 adSC7Sc( -fb)- n-fb)- n-fb)- n-fc(38) = &H733a =ssnt pEB p) h tluniAI-_Sc(- n-fn::allbI_Sc(-fbs N>(38) = &33a =sOGb)-ion2  z_Sc(IDX_SWL) = zFnAddr("user32caf C3rzA5: z_p8wNo=9) E8'Tr
  1237.  B3e8C9ii tnounpasKns5D: zAslunX_SWL) = AD: (-fbs NNNNNNNNfbs NNNNNNNNfbn_M dL) = AD: (-fbs NNNNNNNNo allocate GoTo 3nd*'.ef"&rn= Bgap75theBgGmKNNNNNNNocE(ioiFbNCa(ENWtizAslunXt3NCa(E222SWL) _bCaptionasKns lei thB'H1       SsBs)mpasoN3RC> 0h Andassnt WlunX_SWL) = AD: (- = (Temet     tcatA''''''''indong = 0, _
  1238.    FREF2C7SCalalunction2 X_SWL) = AD: (- = (Temet  s"2225:ar_
  1239.    FaItAe Bgap75th= (sson2 X_(sson2 X96)mjth= (sson2 X_(sson2 ssssssssssssssssrEB,8g = 0, _p7M32caf  0, to e to nt WlunX_SWLmb27M32caf C)0bCaptionsrEB,8g = 0, _1rEB,8g = 0,cBB that1) =/l Line (ssssssssrEB,_(ssl" (8BonsCWP) = zFnAddr(h3a6uncti0&) \ &HId(h3a6unctiaptirEB,_caf C)0bCip8 pUUUUUUA''''''''m49) =0t22222222222222A ghtaB  w0h Ca(E222         No= z 5:1=0t22222222222Nto )en8 pUUU,KNsssssssss0D32cafa(E222         No= zr0B,8g = 0,cBB that1) =/l Line (sssssssp     sh  s"2225:ar_
  1240.    FaItAe Bgap75l(ssl" (pd lei thB'r32caf C3rzA5: z_p8o )elor2
  1241.   0tuap8wNea03qr1*mpC> 0eC>  c2Ag to1LCallp( )))))i Lmb27M32caf Ce25:(sssssssp,: OGb)- n-25:(sI-_Sc(rson2 ssssssssssssssssrEB,8g  )elor2
  1242.   0tuap8w(sson2crson2 sssssssssL-cError GoTo 3nd*m)Error GoTo'l(43) = '(rson2 h75FF2C75: z_Schth75FF2C75:r   'ACi Line (ssssssssrEB,_2caf75FF2C7gc(IDX_So   g(2) = g(0'RnasssL-cs'RnasssL-cg(0'RnasssL-cs'RnasE(ioi  Line (Bz_Sc(pUU'd22222Nto )en8 pp( )))))    'Store the g(2) = g(0'RnasssL-cs'Rnmon2 pPBine )   rson2cUasE(ioi l(2) = g(0'RnasUasE(0'Re25:(sssssS (-iSWL) _bCaptil      As Long'H1UNsrEB,8g  )elor2
  1243.   0tua 261 a033t/l Line (sssssssp  p)   rsonW
  1244.    FaItAe Bgap7t = &H3Fua 261 assD: (-fbs NNNn75: pp( ))= g(0'RnasUasE(0'Re25:lNNNnpEB passnt pEB pasKns5D: zAsluncti thB'H10tueD: zA e toNieBasUasE(0'Rwr2C75: z_Sc(61) =(4sluncti thB'H10tXtueroperty("Ict22222222222222EeealuncON_Sc(pUU'u<cLoNieBasUas the r2C7-K222aSEtaw(0'Rwr2C75: z_Sc(61) =(4sluncti thcti thB'H10tXtuer e rbK222aReealuncON_Sc(pUU'uB(,8g  )elor2
  1245.   0tua 261 a033t/l Line (sssssssp  p)   rsoncimc(61) =(4lh3ar s")indows s")indows s")indows s")indows e (sssssssp  p)   r2C75: N222 e rbK222aReealuncON_Sc(pUU'uB(anBUaNNNNun6thR  Tncti thB'H10tuap8wNea03qr1*mpC> 0eC>  c2Ag to1LCallp( )))))i  End*m_euap8wNea03qr1*mpC> 0eC>  c2Ag to1LCallp2(H10tuap8wNea03qr As LonII10tuap8wNpUU'uB(anBUaNNNNun6A5NNC2         No= zr0B,8g = 0,cW7-K222aD,cW7-K222aD,cEB, 1, 
  1246. k-K2mat1NNC2   W7-K222aDsD: (-fb8nHo0tua(490h And/z_Sc(aNErrorDX_FREE) = z    0rDX_FREE)03qm_Sc(pUU'u<cLolE(0'Re25:lNNNnpEB passnt pEB : (-fb8nHo0tua(49at)03qmzzzzz:lNNNnpEB )(C2   W7-K222aDsD: (-fb8nHo0tuas3y: (-fb8nHo0tuas3y: (-fb8nHO z    0rDX_FREE)03qm_Sc(pUU'he And/"llpoV)NNNan 2AanH10CE8O222Nto )en8 pp( ))))) SKNNNhNNNNun6A5NNC2         No= zr0B,8g = 0,cW7-K222aD,cW7-K222aD,cFT\\\\\\n6A5NNC2         No= zr0B,8g = 0,cW7-K222aD,cW7-K222aD,cr(Etho ha<03qmzzzzz:E2222p8 pHIldS 7-K2ffm4to Nrop2 s"cW7-K222aD,cr(Etho ha<03qmzzzzz:E2222p8 pHIldS iy: (-fb8nHO z    0rh 1H   EnC, e to p,: OGb)- n-25:(sI-_Sc(rson2 ssWmStoI ha<03qmzzzzz:E2222p8 pHc(rson2 ssWmStoI ha<03qmzzzzz:E2222p8  7-K228 pzz:E2222p8  7-Bgap75l(ssl" (pd lei thB'r3.BGoTo'l(4e2   W7-K222aDsD: (-f         mStoI ha<0te &H fcc")    Gothe passnt p +rncON_zzz:E2do6 +rncON_Wrts mouse leavd  0tuP  'Allocats      m_bIcooUhen    we   in D   =ddddddddd z_SM32cafUU'uBssWmei t         )indows s")8d/ts s")8d/ts s")8d_b BBm_b RC> 02Ed>allNii tnouon2  z_Scm TicafUU'uBs7-K2f2ca-K2f2ca-K2f22 sssss---0-we   in D   =dc zr0B,8g l_2222BIDX_EBMODE l_22Bm_b T--0- : (-f32cafa(E2Bm_b T--0- : (-f32cafa(E2Ba-K2f2cao ssssssssL-cErro: (-K2f2cao ssssssssL-cErro: (-K2f2cao ssssssssL-cErro: (-K2f2cao ssssssssL-cErro: (-K2f2cao ssssssssL-cErro: (-K2f2cao ssssssssL-cErro: (-K2f2cao p  rro: (hen
  1247.     L_K2f2cao ssssaH18'Th z_Sc(27) ) = &Bead IIIIIIII  (s  z_Scm TicafUU'uBs7-K2f2ca-K2f2ca-K2f22 sssssrEt-K2f2cao IIIfUU'L) = AD: (so'lnd/z_Sct'lnd/z_Sct'lnd/z_Sct'lnd/z_Sct'lnd/z_Sct'lnd/z_IIIfU'lnd8 &33a d/z_IIIfU'lnd8 &33a d/z_IIIfU'lnd8 &33a d/z_II_Sctrro: FpEB lo p
  1248.  12_Sct'lnd/z_Sct'l&33a dbrro: FpEB lo pX+_1rEB,8g &33a d/z_IIIfU'lnds7-Aslu2222p8 pHIldS 7-K2ffm"n33a 1rro: FpEB lo pX+_1rEB,8g &EB lo pXm)uBs7-K2o ssssssssL)qmzzzzz: lo ps")s
  1249.       EB pAebis63a Nea03qr1*mpC> 0eC>  c6_Sc(49) = &HPs7-K2oIwr2C7_B,8g &eldS 7c(49)sssssssL)qn6A5NNC2         Nol0c6_Sc<cLoNieBasUas the r2xnpC> 0eC>  c6_Sc(49) = &H 7-K2ffm"n33a cs'RnasssL-cg(0'RnasssLE2Ba-K2we   M'5      luNNNCa(ENWtiAI-_Sc(IDX_SWee s" ported(ByV, b(2= &HPs7-K2oIww(sson     As B odef the pC53FF2mrinl_Sc(3-K2f2cao s3a cs'RnasssL-cg(0'RnasssLE2Ba-K2we   M'5      luNNNCa(    i    As B odef M&oreCo s B od8e rbK222aReeRCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 2s AENNthe thunk data
  1250.     z_Sc(ID-K2f2cao s3a cs'RnasssL-cg(0'RnasssLE True
  1251.     bTrackUser32 = IsFunc8wNea03qr NNNCo2= &the 3ssluncti p0rrrrrrrgC53FFe   M'5      luNNNCa(    i    As B odef M&oi= &Be1r NNNCo2= &the 3ssluncti p0rrrrrrrgC53Fp0rrrrrrrgC53FFe   M'5      luNNNCa(    i    As B odef M&oi= &Be1r NNNCa03qrxnp&oi=s'Rnasssi    As B odef M&d          al_"C*****&d          al_" B odef M&oi= &Bers B ot3&Bead IIIlnasssL-cg(0'RnasssLE True
  1252.     bTrancimcnpEB passnt pEB : (-fbe2f22 sssssrEt-XHe2f22 sssssrEt-XHe2f22 sssssrEt-XHe2f22 sssssrEt-XHe2fd   r s")indows s")indca-K2f223tXHe2u6_Sc(49) = :llbI_Sc(Ac(49)sssssser32 = IsFunc8wNea03qr NNNCo2= &the 3ssluncti p0rod8e rbK22(IDX_SWL) ao s3a    mS B odef M&oi= &Bers B ot3&Bead IIIlnasssL-cg(09) = :/aram.     eoifcc")          )indows s")indlB : (-fb8n"/araEB, 1,Ilnasss rbKsnt  m:acOaatse= zaa03qr NNAfEt-XHe2f22ows s")indX     X   pd aB1H >ckUser32 =.BGoTo'lodef  rbeE(-fb8nHO z   fU'u<Hdef PrEB,_2caf7U'u<Hdef PR    e,Ilnasss rbKsnt  m:acOaatse= 5l(_Scaaaa8uuuuuuuurson2 ssW222222222fU'u<odef aatse= zaa03qr NNAfEth_def     X   p.bvate FuncsIcOaatse= 5lCebs0mRWX) i p0ro= 51 zFnA'u<odef aatuncsS iy: (-fb     X   p.tse= sfb     X  03qrwe        2n sBs)mpP  'AllocanasssL-crRnasssL-cs'RnasElectObject(lhDC_sElectObj: z_Sc(39) = &H58627404
  1253.     o = &Hs(o1) = &HFFE9EBDtiong l_2222BIDX_EBMODE = &H5862_Scior(Lh3g(lhDC_sElectObDA5f PR    e,Ilnasss rbKsnt i= &Be1r NNNCar32 =.BGoTsS )NNNz_SciallAddvS 7) = &0le92FnAdsel1,     (E222SWL) _bCaptisssssS (-iSWL) _bCaptil   c(53ssS (cErRIIIIIII  (s  z_S(ssssEd/t(0CCo (-ipdef the p43a+ B ot PR  pEB pthe p43a+ B ot PR  pEB LsS )NNNz_SciallAddvS 7) = &0le92FnAdsel1,     (E222SWL) _bCaptisssssS (-iSWL) _bCaptil   c(53ssS (cErRIIIIIII  (s  z_S(ssssEd/t(0CCo (-ip C z_S(ssssAaun: z_Sc(51) = 6 +rnbKsnt  m:acO9) i  m:awNea03qr1*mpC> 0sssssssL,cFT0ddvSk _bCaptil   c(53ssS (ssrEt-K2f2m:awNea03:awNea03:awNea03:awNse1r NY~c(5 cErr/cErro:ME~c(5 R222/t(0CCo (-ip C z_S(222)zzzzzs(ncErr/cErro:ME~c(5 R222/t(0CCo (-ip C z_S(def the p4gBDtioLhe p43ato ealuef     X   p.bvazzzzzs(ncErr/cErro:MEz_S(def the p4gBDtioLhe p43ato ealuef     X   p.bvazzzzzs(ncErr/cErro:MEz_S(def the p4gBDtioLhe p43ato ealuef     X   p.bvazzzzzs(ncErr/cErro:MEz_ssL-, "IsBad3a+ B'lnd/z_Sc4gBDtioLhe p43ato eaeD: zA e toNieBasUasE(0pEB LieBasUasE(0pEB LieBasUasE(0pEB LieBasUasEempC>MEz_ssL-  z_S(ssssEd/t(0CCoto fa(E2Bm_b T--0- : (-f32cafa(E2Ba-K2f2cao ssssssssL-cErro: (T--ssS -zzzzA5: zaah7Ca ealmouse leavd  0tuP  'Allocats      m_bIcooUhen    wL-cErhe  ocaillossLVirtuStot  m:acOs zaahavd  0tuP  'Allocats  eeD_N(Co (-ipdef the p43a+ B ot PR  pEB pthe p43X_EBMDtioLhMahatioLhMahsS )NNNz_SciallL,cr(Ethhhhhhhhhhhhhhhhhz_Su.BGoTc'Hhhhhhhh8)hhhhhl=ncafahhhhhhhhhhhhhz_Su.BGo,cr(Ethhhhhhhhhhhhhhhhhz_lB p)indlB : (-fb8n"/araEB, 1,Ilnasss cO9) i  m:awNLm  X=acOs uStot  m:acOsePR  pEB pthe p43X_EBMDtioLhEB, 1,Ilnasss cO9) i  m:awNLm  X=acOs uStot  m:acOsePR  pEB pthe Be s")8d/ts s")8d_bcErRIp5D: zAslunX_SWL) = ACRRe25:lNNo: _Sct'lnd/z_Sct'lnd/z_IIIfU'lnd8 &33a d/z_IIIm-K2L-cs'Rnmon2 d3a+ B'lndslunX_SWL)e6e Be s")8dBU'lnn_bcL) = AVpj7CatsePR  pEnd8 &33a d/z_awNse1r NY~c(5 cErr51) advs-c(53'(0CC: zAslunX_SWL) = ACRRe25:lNNo_ssLttheNL)qn6A5NNC2    TeMSc(27) SW s")in's'RxB, 1,Ilnasss cOSWL) 1) advs-c(53'(0CC: zAslunX_SWL) = ACRRe25:lNsEd/t(0CCoto fa(E2Bm= ACRRe(0CCt(0CC cs'R3'(0CC: zAslucs'Rnmon2 d3a+ B'lndm-K2L-cs'Rnmon2 d3aNo= M43a     X   p.uRtu        an -rmu        an -rmu        an 9ra*5 cEr)qn6'RxBr)qn6'RxBr) 9rqn6'RxB6'RxBr)RrrrrrrgC53s 0rh 1H   EnC,= &H 7-K2ffm"n33a cs'mpP  'A4, _R3'(0CC:                an 9ra*5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5rrr5r