home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / ucComboTra1945531132005.psc / ucComboTrackbar.ctl < prev   
Text File  |  2005-11-03  |  29KB  |  700 lines
  1. VERSION 5.00
  2. Begin VB.UserControl ucComboTrackbar 
  3.    AutoRedraw      =   -1  'True
  4.    ClientHeight    =   795
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   1245
  8.    FillStyle       =   0  'Solid
  9.    ScaleHeight     =   53
  10.    ScaleMode       =   3  'Pixel
  11.    ScaleWidth      =   83
  12. End
  13. Attribute VB_Name = "ucComboTrackbar"
  14. Attribute VB_GlobalNameSpace = False
  15. Attribute VB_Creatable = True
  16. Attribute VB_PredeclaredId = False
  17. Attribute VB_Exposed = False
  18. '========================================================================================
  19. ' User control:  ucComboTrackbar.ctl
  20. ' Author:        Carles P.V. - 2005 (*)
  21. ' Dependencies:  None
  22. ' Last revision: 03.11.2005
  23. ' Version:       1.2.5
  24. '----------------------------------------------------------------------------------------
  25. '
  26. ' (*) 1. Self-Subclassing UserControl template (IDE safe) by Paul Caton:
  27. '
  28. '        Self-subclassing Controls/Forms - NO dependencies
  29. '        http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=54117&lngWId=1
  30. '
  31. '     2. pvCheckEnvironment() and pvIsLuna() routines by Paul Caton
  32. '
  33. '----------------------------------------------------------------------------------------
  34. '
  35. ' History:
  36. '
  37. '   * 1.0.0: - First release.
  38. '   * 1.1.0: - Added EditDelayedUpdate and EditDelay props. (disabled by default).
  39. '            - Automatic decimal symbol conversion to match regional settings.
  40. '              (see m_oEdit_KeyPress routine)
  41. '   * 1.2.0: - Forgotten 'Value' (RO prop.) added.
  42. '              This way you always get real current value instead of Edit contents.
  43. '   * 1.2.1: - Explicitly destroying m_oEdit and m_oFont objects on _Terminate().
  44. '   * 1.2.2: - Minor fix: themed button painting (hot state not restored sometimes).
  45. '            - Fixed _Show() event. Removed Ambient.UserMode condition.
  46. '   * 1.2.3: - Style metrics are now calculated on _Resize(). Because of different
  47. '              event order (_ReadProperties() and _Resize() in design/runtime modes)
  48. '              this could cause not valid metrics for a given style.
  49. '   * 1.2.4: - No need to get channel and thumb rectangles via TBM_GETCHANNELRECT and
  50. '              TBM_GETTHUMBRECT. Custom draw structure already passes those rectangles.
  51. '   * 1.2.5: - I've not been able to find out why, but it seems that problem is fixed.
  52. '              Stopped subclassing of parent window after Trackbar window.
  53. '----------------------------------------------------------------------------------------
  54. '
  55. ' Known issues:
  56. '
  57. '   * Trackbar maximum integer-range lenght is limited to 32,768 'steps'.
  58. '     So be careful which values you set as RangeXXX ones.
  59. '     Anyway, it's supposed that trackbar is not used to deal with large ranges.
  60. '========================================================================================
  61.  
  62.  
  63.  
  64.  
  65.  
  66. Option Explicit
  67.  
  68. Private Const VERSION_INFO As String = "1.2.5"
  69.  
  70. '========================================================================================
  71. ' Subclasser declarations
  72. '========================================================================================
  73.  
  74. Private Enum eMsgWhen
  75.     [MSG_AFTER] = 1                                                                     'Message calls back after the original (previous) WndProc
  76.     [MSG_BEFORE] = 2                                                                    'Message calls back before the original (previous) WndProc
  77.     [MSG_BEFORE_AND_AFTER] = MSG_AFTER Or MSG_BEFORE                                    'Message calls back before and after the original (previous) WndProc
  78. End Enum
  79.  
  80. Private Type tSubData                                                                   'Subclass data type
  81.     hWnd                             As Long                                            'Handle of the window being subclassed
  82.     nAddrSub                         As Long                                            'The address of our new WndProc (allocated memory).
  83.     nAddrOrig                        As Long                                            'The address of the pre-existing WndProc
  84.     nMsgCntA                         As Long                                            'Msg after table entry count
  85.     nMsgCntB                         As Long                                            'Msg before table entry count
  86.     aMsgTblA()                       As Long                                            'Msg after table array
  87.     aMsgTblB()                       As Long                                            'Msg Before table array
  88. End Type
  89.  
  90. Private sc_aSubData()                As tSubData                                        'Subclass data array
  91. Private Const ALL_MESSAGES           As Long = -1                                       'All messages added or deleted
  92. Private Const GMEM_FIXED             As Long = 0                                        'Fixed memory GlobalAlloc flag
  93. Private Const GWL_WNDPROC            As Long = -4                                       'Get/SetWindow offset to the WndProc procedure address
  94. Private Const PATCH_04               As Long = 88                                       'Table B (before) address patch offset
  95. Private Const PATCH_05               As Long = 93                                       'Table B (before) entry count patch offset
  96. Private Const PATCH_08               As Long = 132                                      'Table A (after) address patch offset
  97. Private Const PATCH_09               As Long = 137                                      'Table A (after) entry count patch offset
  98.  
  99. Private Declare Sub RtlMoveMemory Lib "kernel32" (Destination As Any, Source As Any, ByVal Length As Long)
  100. Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long
  101. Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
  102. Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
  103. Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
  104. Private Declare Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
  105.  
  106.  
  107.  
  108. '========================================================================================
  109. ' UserControl API declarations
  110. '========================================================================================
  111.  
  112. Private Const SM_CXVSCROLL As Long = 2
  113.  
  114. Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
  115.  
  116. Private Type POINTAPI
  117.     x As Long
  118.     y As Long
  119. End Type
  120.  
  121. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  122. Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
  123. Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
  124.  
  125. Private Type RECT
  126.     x1 As Long
  127.     y1 As Long
  128.     x2 As Long
  129.     y2 As Long
  130. End Type
  131.  
  132. Private Declare Function CopyRect Lib "user32" (lpDestRect As RECT, lpSourceRect As RECT) As Long
  133. Private Declare Function InflateRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
  134. Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long
  135. Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
  136. Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
  137. Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
  138. Private Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, lpRect As Any, ByVal bErase As Long) As Long
  139.  
  140. Private Const BDR_SUNKENOUTER As Long = &H2
  141. Private Const BDR_RAISEDINNER As Long = &H4
  142. Private Const BDR_RAISED      As Long = &H5
  143. Private Const BDR_SUNKEN      As Long = &HA
  144. Private Const BF_RECT         As Long = &HF
  145. Private Const BF_FLAT         As Long = &H4000
  146. Private Const BF_MONO         As Long = &H8000
  147.  
  148. Private Declare Function DrawEdge Lib "user32" (ByVal hDC As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
  149.  
  150. Private Const DFC_SCROLL          As Long = 3
  151. Private Const DFCS_SCROLLCOMBOBOX As Long = &H5
  152. Private Const DFCS_INACTIVE       As Long = &H100
  153. Private Const DFCS_PUSHED         As Long = &H200
  154. Private Const DFCS_FLAT           As Long = &H4000
  155. Private Const DFCS_MONO           As Long = &H8000
  156.  
  157. Private Declare Function DrawFrameControl Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal un1 As Long, ByVal un2 As Long) As Long
  158.  
  159. Private Const HWND_TOPMOST   As Long = -1
  160. Private Const SWP_NOZORDER   As Long = &H4
  161. Private Const SWP_NOREDRAW   As Long = &H8
  162. Private Const SWP_NOACTIVATE As Long = &H10
  163. Private Const SWP_SHOWWINDOW As Long = &H40
  164.  
  165. Private Const DT_LEFT       As Long = &H0
  166. Private Const DT_SINGLELINE As Long = &H20
  167. Private Const DT_VCENTER    As Long = &H4
  168.  
  169. Private Declare Function DrawText Lib "user32" Alias "DrawTextA" (ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, lpRect As RECT, ByVal wFormat As Long) As Long
  170.  
  171. Private Declare Sub SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long)
  172.  
  173. Private Declare Function GetDesktopWindow Lib "user32" () As Long
  174. Private Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
  175. Private Declare Function SetFocus Lib "user32" (ByVal hWnd As Long) As Long
  176.  
  177. Private Const COLOR_BTNFACE As Long = 15
  178.  
  179. Private Declare Function GetSysColorBrush Lib "user32" (ByVal nIndex As Long) As Long
  180.  
  181. Private Const MOUSEEVENTF_LEFTDOWN As Long = &H2
  182.  
  183. Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
  184.  
  185. Private Const TRANSPARENT As Long = 1
  186.  
  187. Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
  188.     
  189. Private Declare Function OleTranslateColor Lib "olepro32" (ByVal OLE_COLOR As Long, ByVal hPalette As Long, ColorRef As Long) As Long
  190. Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
  191. Private Declare Function SetBrushOrgEx Lib "gdi32" (ByVal hDC As Long, ByVal nXOrg As Long, ByVal nYOrg As Long, lppt As POINTAPI) As Long
  192.  
  193. Private Const WM_TIMER As Long = &H113
  194.  
  195. Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
  196. Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long
  197.  
  198. '//
  199.  
  200. Private Type BITMAPINFOHEADER
  201.     biSize          As Long
  202.     biWidth         As Long
  203.     biHeight        As Long
  204.     biPlanes        As Integer
  205.     biBitCount      As Integer
  206.     biCompression   As Long
  207.     biSizeImage     As Long
  208.     biXPelsPerMeter As Long
  209.     biYPelsPerMeter As Long
  210.     biClrUsed       As Long
  211.     biClrImportant  As Long
  212. End Type
  213.  
  214. Private Type BITMAP
  215.     bmType       As Long
  216.     bmWidth      As Long
  217.     bmHeight     As Long
  218.     bmWidthBytes As Long
  219.     bmPlanes     As Integer
  220.     bmBitsPixel  As Integer
  221.     bmBits       As Long
  222. End Type
  223.  
  224. Private Const DIB_RGB_COLORS As Long = 0
  225. Private Const OBJ_BITMAP     As Long = 7
  226.  
  227. Private Declare Function CreateDIBPatternBrushPt Lib "gdi32" (lpPackedDIB As Any, ByVal iUsage As Long) As Long
  228. Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
  229. Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
  230.  
  231. Private Declare Function GetObjectType Lib "gdi32" (ByVal hgdiobj As Long) As Long
  232. Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  233. Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
  234. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  235. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
  236. Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Integer) As Long
  237. Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
  238. Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long) As Long
  239.  
  240. '//
  241.  
  242. Private Const WS_BORDER         As Long = &H800000
  243. Private Const WS_CLIPSIBLINGS   As Long = &H4000000
  244. Private Const WS_VISIBLE        As Long = &H10000000
  245. Private Const WS_CHILD          As Long = &H40000000
  246. Private Const WS_EX_TOOLWINDOW  As Long = &H80&
  247.  
  248. Private Const WM_SETFOCUS       As Long = &H7
  249. Private Const WM_KILLFOCUS      As Long = &H8
  250. Private Const WM_SYSCOLORCHANGE As Long = &H15
  251. Private Const WM_MOUSEACTIVATE  As Long = &H21
  252. Private Const WM_GETMINMAXINFO  As Long = &H24
  253. Private Const WM_NOTIFY         As Long = &H4E
  254. Private Const WM_SYSCOMMAND     As Long = &H112
  255. Private Const WM_HSCROLL        As Long = &H114
  256. Private Const WM_CTLCOLOREDIT   As Long = &H133
  257. Private Const WM_CTLCOLORSTATIC As Long = &H138
  258. Private Const WM_MOUSEMOVE      As Long = &H200
  259. Private Const WM_LBUTTONDOWN    As Long = &H201
  260. Private Const WM_LBUTTONUP      As Long = &H202
  261. Private Const WM_RBUTTONDOWN    As Long = &H204
  262. Private Const WM_RBUTTONUP      As Long = &H205
  263. Private Const WM_MOUSEWHEEL     As Long = &H20A
  264. Private Const WM_THEMECHANGED   As Long = &H31A
  265.  
  266. Private Const MK_LBUTTON        As Long = &H1
  267.  
  268. Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
  269. Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
  270.  
  271. Private Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  272. Private Declare Function SendMessageAny Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
  273. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDst As Any, lpSrc As Any, ByVal Length As Long)
  274.  
  275. '//
  276.  
  277. '- Trackbar class name
  278. Private Const WC_TRACKBAR32      As String = "msctls_trackbar32"
  279.  
  280. '- Trackbar styles
  281. Private Const TBS_BOTH           As Long = &H8
  282. Private Const TBS_NOTICKS        As Long = &H10
  283. Private Const TBS_FIXEDLENGTH    As Long = &H40
  284.  
  285. '- Trackbar messages
  286. Private Const WM_USER            As Long = &H400
  287. Private Const TBM_GETPOS         As Long = WM_USER
  288. Private Const TBM_SETPOS         As Long = WM_USER + 5
  289. Private Const TBM_SETRANGE       As Long = WM_USER + 6
  290. Private Const TBM_GETTHUMBRECT   As Long = WM_USER + 25
  291. Private Const TBM_SETTHUMBLENGTH As Long = WM_USER + 27
  292.  
  293. '- Trackbar notifications
  294. Private Const NM_FIRST           As Long = 0
  295. Private Const NM_CUSTOMDRAW      As Long = NM_FIRST - 12
  296.  
  297. '- Trackbar 'custom draw' specifications
  298. Private Const TBCD_TICS          As Long = &H1
  299. Private Const TBCD_THUMB         As Long = &H2
  300. Private Const TBCD_CHANNEL       As Long = &H3
  301.  
  302. ' Notification structure
  303. Private Type NMHDR
  304.     hwndFrom As Long
  305.     idfrom   As Long
  306.     code     As Long
  307. End Type
  308.  
  309. ' 'Custom draw' structure
  310. Private Type NMCUSTOMDRAW
  311.     hdr         As NMHDR
  312.     dwDrawStage As Long
  313.     hDC         As Long
  314.     rc          As RECT
  315.     dwItemSpec  As Long
  316.     uItemState  As Long
  317.     lItemlParam As Long
  318. End Type
  319.  
  320. '- Custom draw paint stages (only used ones)
  321. Private Const CDDS_PREPAINT       As Long = &H1
  322. Private Const CDDS_ITEM           As Long = &H10000
  323. Private Const CDDS_ITEMPREPAINT   As Long = CDDS_ITEM Or CDDS_PREPAINT
  324.  
  325. '- Custom draw item states (only used ones)
  326. Private Const CDIS_SELECTED       As Long = &H1
  327.  
  328. '- Custom draw return values (only used ones)
  329. Private Const CDRF_SKIPDEFAULT    As Long = &H4
  330. Private Const CDRF_NOTIFYITEMDRAW As Long = &H20
  331.  
  332. '//
  333.  
  334. '- ComboBox class string
  335. Private Const CB_THEME As String = "ComboBox"
  336.  
  337. '- ComboBox parts
  338. Private Const CP_DROPDOWNBUTTON As Long = 1
  339. Private Const CP_BORDER         As Long = 2
  340.  
  341. '- ComboBox states
  342. Private Const CBXS_NORMAL   As Long = 1
  343. Private Const CBXS_HOT      As Long = 2
  344. Private Const CBXS_PRESSED  As Long = 3
  345. Private Const CBXS_DISABLED As Long = 4
  346.  
  347. Private Type OSVERSIONINFO
  348.     dwOSVersionInfoSize As Long
  349.     dwMajorVersion      As Long
  350.     dwMinorVersion      As Long
  351.     dwBuildNumber       As Long
  352.     dwPlatformId        As Long
  353.     szCSDVersion        As String * 128
  354. End Type
  355.  
  356. Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
  357. Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
  358. Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
  359.  
  360. Private Declare Function GetCurrentThemeName Lib "uxtheme" (ByVal pszThemeFileName As Long, ByVal cchMaxNameChars As Long, ByVal pszColorBuff As Long, ByVal cchMaxColorChars As Long, ByVal pszSizeBuff As Long, ByVal cchMaxSizeChars As Long) As Long
  361. Private Declare Function GetThemeDocumentationProperty Lib "uxtheme" (ByVal pszThemeName As Long, ByVal pszPropertyName As Long, ByVal pszValueBuff As Long, ByVal cchMaxValChars As Long) As Long
  362. Private Declare Function OpenThemeData Lib "uxtheme" (ByVal hWnd As Long, ByVal pszClassList As Long) As Long
  363. Private Declare Function CloseThemeData Lib "uxtheme" (ByVal hTheme As Long) As Long
  364. Private Declare Function DrawThemeBackground Lib "uxtheme" (ByVal hTheme As Long, ByVal lHDC As Long, ByVal iPartId As Long, ByVal iStateId As Long, pRect As RECT, pClipRect As RECT) As Long
  365.  
  366.  
  367.  
  368. '========================================================================================
  369. ' UserControl enums., variables and constants
  370. '========================================================================================
  371.  
  372. '-- Public enums.:
  373.  
  374. Public Enum ctBackStyleCts
  375.     [bsSolidColor] = 0
  376.     [bsImage] = 1
  377. End Enum
  378.  
  379. Public Enum ctStyleCts
  380.     [sClassic] = 0
  381.     [sFlat] = 1
  382.     [sFlatMono] = 2
  383.     [sThemed] = 3
  384. End Enum
  385.  
  386. Public Enum ctRangePrecisionCts
  387.     [rpInteger] = 0
  388.     [rpTenth] = 1
  389.     [rpHundredth] = 2
  390.     [rpThousandth] = 3
  391. End Enum
  392.  
  393. Public Enum ctTrackbarPositionCts
  394.     [tpWide] = 0
  395.     [tpCentered] = 1
  396. End Enum
  397.  
  398. '-- Private constants:
  399.  
  400. Private Const ERR_OVERFLOW          As Long = 6
  401. Private Const INTEGER_OVERFLOW      As Long = 32768
  402. Private Const TRACKBAR_HEIGHT_MIN   As Long = 16
  403. Private Const TRACKBAR_WIDTH_MIN    As Long = 32
  404. Private Const THUMB_OFFSET          As Long = 3
  405. Private Const FONT_EXTENT           As Long = 4
  406. Private Const EDGE_THICK            As Long = 2
  407. Private Const EDGE_THIN             As Long = 1
  408. Private Const EDGE_NULL             As Long = 0
  409. Private Const TIMERID_HOT           As Long = 1
  410. Private Const TIMERDT_HOT           As Long = 25
  411. Private Const TIMERID_EDIT          As Long = 2
  412. Private Const TIMERMINDT_EDIT       As Long = 250
  413.  
  414. '-- Private variables:
  415.  
  416. Private WithEvents m_oEdit          As TextBox
  417. Attribute m_oEdit.VB_VarHelpID = -1
  418. Private WithEvents m_oFont          As StdFont
  419. Attribute m_oFont.VB_VarHelpID = -1
  420.  
  421. Private m_hWndTrackbar              As Long
  422. Private m_hWndParent                As Long
  423.  
  424. Private m_uRctControl               As RECT
  425. Private m_uRctEdit                  As RECT
  426. Private m_uRctButton                As RECT
  427. Private m_lEditEdge                 As Long
  428. Private m_lEditExtent               As Long
  429. Private m_lButtonEdge               As Long
  430. Private m_lButtonExtent             As Long
  431.  
  432. Private m_bHasFocus                 As Boolean
  433. Private m_bButtonPressed            As Boolean
  434. Private m_bButtonHot                As Boolean
  435.  
  436. Private m_hBackBrush                As Long
  437. Private m_hPatternBrush             As Long
  438.  
  439. Private m_lValue                    As Long
  440. Private m_lCancelValue              As Long
  441. Private m_lMax                      As Long
  442. Private m_lMin                      As Long
  443. Private m_lPrecisionFactor          As Long
  444. Private m_sPrecisionFormat(3)       As String
  445.  
  446. Private m_bIsXP                     As Boolean
  447. Private m_bIsLuna                   As Boolean
  448.  
  449. '-- Property variables:
  450.  
  451. Private m_oleBackColor              As OLE_COLOR
  452. Private m_oBackImage                As StdPicture
  453. Private m_eBackStyle                As ctBackStyleCts
  454. Private m_bEditDelayedUpdate        As Boolean
  455. Private m_lEditDelay                As Long
  456. Private m_snRangeMax                As Single
  457. Private m_snRangeMin                As Single
  458. Private m_eRangePrecision           As ctRangePrecisionCts
  459. Private m_eStyle                    As ctStyleCts
  460. Private m_lTrackbarHeight           As Long
  461. Private m_eTrackbarPosition         As ctTrackbarPositionCts
  462. Private m_lTrackbarWidth            As Long
  463.  
  464. '-- Default property values:
  465.  
  466. Private Const BACKCOLOR_DEF         As Long = vbWindowBackground
  467. Private Const BACKSTYLE_DEF         As Long = [bsSolidColor]
  468. Private Const EDITDELAYEDUPDATE_DEF As Boolean = False
  469. Private Const EDITDELAY_DEF         As Long = 1000
  470. Private Const ENABLED_DEF           As Boolean = True
  471. Private Const FORECOLOR_DEF         As Long = vbWindowText
  472. Private Const LOCKED_DEF            As Boolean = False
  473. Private Const RANGEMAX_DEF          As Single = 100
  474. Private Const RANGEMIN_DEF          As Single = 0
  475. Private Const RANGEPRECISION_DEF    As Long = [rpInteger]
  476. Private Const STYLE_DEF             As Long = [sClassic]
  477. Private Const TRACKBARHEIGHT_DEF    As Long = 22
  478. Private Const TRACKBARPOSITION_DEF  As Long = [tpWide]
  479. Private Const TRACKBARWIDTH_DEF     As Long = 100
  480.  
  481. '-- Events:
  482.  
  483. Public Event Change()
  484. Public Event Scroll()
  485. Public Event TrackbarShow()
  486. Public Event TrackbarHide()
  487. Public Event KeyDown(KeyCode As Integer, Shift As Integer)
  488. Public Event KeyPress(KeyAscii As Integer)
  489. Public Event KeyUp(KeyCode As Integer, Shift As Integer)
  490. Public Event ThemeChanged() ' XP only
  491.  
  492.  
  493.  
  494.  
  495. '========================================================================================
  496. ' UserControl subclass procedure
  497. '========================================================================================
  498.  
  499. Public Sub zSubclass_Proc(ByVal bBefore As Boolean, _
  500.                           ByRef bHandled As Boolean, _
  501.                           ByRef lReturn As Long, _
  502.                           ByRef lhWnd As Long, _
  503.                           ByRef uMsg As Long, _
  504.                           ByRef wParam As Long, _
  505.                           ByRef lParam As Long _
  506.                           )
  507. Attribute zSubclass_Proc.VB_MemberFlags = "40"
  508.  
  509.     Select Case lhWnd
  510.         
  511.         Case m_hWndParent
  512.             
  513.             If (m_hWndTrackbar <> 0) Then
  514.             
  515.                 Select Case uMsg
  516.                 
  517.                     Case WM_GETMINMAXINFO, WM_SYSCOMMAND, WM_RBUTTONDOWN, WM_LBUTTONDOWN
  518.                         Call pvDestroyTrackbar
  519.                         
  520.                     Case WM_MOUSEACTIVATE
  521.                         If (pvOnMouseActivate()) Then
  522.                             Call pvDestroyTrackbar
  523.                         End If
  524.                 End Select
  525.             End If
  526.             
  527.         Case m_hWndTrackbar
  528.         
  529.             Select Case uMsg
  530.                 
  531.                 Case WM_RBUTTONUP, WM_LBUTTONUP
  532.                     Call pvDestroyTrackbar
  533.             End Select
  534.         
  535.         Case UserControl.hWnd
  536.  
  537.                 Select Case uMsg
  538.     
  539.                     Case WM_NOTIFY
  540.                         Call pvOnNotify(lParam, bHandled, lReturn)
  541.                         
  542.                     Case WM_HSCROLL
  543.                         Call pvOnHScroll
  544.                         
  545.                     Case WM_MOUSEWHEEL
  546.                         Call pvOnMouseWheel(wParam)
  547.                     
  548.                     Case WM_LBUTTONDOWN
  549.                         Call pvOnMouseDown(wParam, lParam)
  550.                     
  551.                     Case WM_LBUTTONUP
  552.                         Call pvOnMouseUp
  553.                      
  554.                     Case WM_MOUSEMOVE
  555.                         Call pvOnMouseMove(wParam, lParam)
  556.                                                
  557.                     Case WM_CTLCOLOREDIT
  558.                         Call pvOnCtlColorEdit(wParam, lParam, lReturn)
  559.                     
  560.                     Case WM_CTLCOLORSTATIC
  561.                         Call pvOnCtlColorStatic(wParam, lParam, lReturn)
  562.                         
  563.                     Case WM_TIMER
  564.                         Call pvOnTimer(wParam)
  565.                     
  566.                     Case WM_THEMECHANGED
  567.                         Call pvOnThemeChanged
  568.                         
  569.                     Case WM_SYSCOLORCHANGE
  570.                         Call pvOnSysColorChange
  571.                End Select
  572.                
  573.         Case m_oEdit.hWnd
  574.  
  575.             Select Case uMsg
  576.                 
  577.                 Case WM_SETFOCUS
  578.                     Call pvOnSetFocus
  579.                     
  580.                 Case WM_KILLFOCUS
  581.                     Call pvOnKillFocus
  582.             End Select
  583.     End Select
  584. End Sub
  585.  
  586.  
  587.  
  588. '========================================================================================
  589. ' UserControl initialization/termination
  590. '========================================================================================
  591.  
  592. Private Sub UserControl_Initialize()
  593.     
  594.     '-- Precision formats
  595.     m_sPrecisionFormat([rpInteger]) = "0"
  596.     m_sPrecisionFormat([rpTenth]) = "0.0"
  597.     m_sPrecisionFormat([rpHundredth]) = "0.00"
  598.     m_sPrecisionFormat([rpThousandth]) = "0.000"
  599. End Sub
  600.  
  601. Private Sub UserControl_Terminate()
  602.     
  603.     On Error GoTo Catch
  604.     
  605.     '-- Stop subclassing
  606.     Call Subclass_StopAll
  607.     
  608. Catch:
  609.     On Error GoTo 0
  610.     
  611.     '-- Clean up
  612.     Set m_oEdit = Nothing
  613.     Set m_oFont = Nothing
  614.     Call DeleteObject(m_hBackBrush)
  615.     Call DeleteObject(m_hPatternBrush)
  616. End Sub
  617.  
  618.  
  619.  
  620. '========================================================================================
  621. ' UserControl misc.
  622. '========================================================================================
  623.  
  624. Private Sub UserControl_DblClick()
  625.     
  626.     '-- Preserve second click
  627.     Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
  628. End Sub
  629.  
  630. Private Sub UserControl_Resize()
  631.     
  632.     '-- Resize (combo)
  633.     Call pvResizeControl
  634. End Sub
  635.  
  636. Private Sub UserControl_Show()
  637.  
  638.     '-- Resize (combo)
  639.     Call pvResizeControl
  640. End Sub
  641.  
  642.  
  643.  
  644. '========================================================================================
  645. ' Inherent Edit control
  646. '========================================================================================
  647.  
  648. Private Sub m_oEdit_Change()
  649.   
  650.   Dim lPrevValue As Long
  651.       
  652.     lPrevValue = m_lValue
  653.     
  654.     On Error Resume Next
  655.     
  656.     m_lValue = m_oEdit.Text lue = m_oEdit.Text lue = m_oEdit.Text lue = m_oEdit.Text lue = m lue = m_o0ush         <be m_oEdit.hWnd
  657.  
  658.   rivate Sub UserControB sh         <be m_oEdit.hWnd
  659.  
  660. ====it_Change(6nd
  661. d Sub
  662.  
  663.  
  664.  
  665. '===F)Edit.Text lue = m_oEdit.Tlean
  666. ange(6nd
  667. d Sub
  668.  
  669.  
  670.  
  671. '===F)Edit.Text lue = m_oEdi    
  672. lt_Chanit.Text luclassing
  673.     Call ==========s
  674. Private m_bEditDeCase WM_SYSCDbclassing
  675.     Call SubText lue .Tlean
  676. ange(6nd
  677. d Sub======lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long) As Long
  678.  
  679. '//
  680.  
  681. Private Const WS_BORDERf Set m_oFoionInfoSiryee Lontate Const W=====0    
  682. Y
  683.     ============ean
  684. (======s
  685. Private m_bEditDeUsage AsCD
  686.  (============
  687.     m_sPParent  APINFOHEADER, ByVal w          a'      As Long      UC==
  688.  
  689. Privf======== UC==sage As   Call DeleteObjectteObject   Ca=====    S a'      As Long      UC==
  690.  
  691. Privf======== UC==sP    ====s
  692. P
  693.  
  694. Prrrrrriu
  695. d Sub
  696. teData yAs Long, lpBits As Integer) As LonM_NOTIFY\====== UC==sage As   Ca As Long      UC==
  697.  
  698. PrX5aO=ata yAs Long======i BI As BITMAPINFOHED===========
  699. ' UserControMAPINFOHED9= UC=Ae3WSnts
  700. 'TF_= UC=Ae3WSn