home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD9506912000.psc / ButtonEx.ctl next >
Encoding:
Visual Basic user-defined control file  |  2000-09-01  |  59.6 KB  |  1,654 lines
  1. VERSION 5.00
  2. Begin VB.UserControl ButtonEx 
  3.    AutoRedraw      =   -1  'True
  4.    BackStyle       =   0  'Transparent
  5.    ClientHeight    =   1815
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   3345
  9.    DefaultCancel   =   -1  'True
  10.    ScaleHeight     =   121
  11.    ScaleMode       =   3  'Pixel
  12.    ScaleWidth      =   223
  13.    ToolboxBitmap   =   "ButtonEx.ctx":0000
  14.    Begin VB.PictureBox pictTempHighlight 
  15.       AutoRedraw      =   -1  'True
  16.       AutoSize        =   -1  'True
  17.       BorderStyle     =   0  'None
  18.       Height          =   495
  19.       Left            =   1800
  20.       ScaleHeight     =   495
  21.       ScaleWidth      =   1215
  22.       TabIndex        =   2
  23.       Top             =   240
  24.       Visible         =   0   'False
  25.       Width           =   1215
  26.    End
  27.    Begin VB.PictureBox pictTempDestination 
  28.       AutoRedraw      =   -1  'True
  29.       AutoSize        =   -1  'True
  30.       BorderStyle     =   0  'None
  31.       Height          =   495
  32.       Left            =   1800
  33.       ScaleHeight     =   495
  34.       ScaleWidth      =   1215
  35.       TabIndex        =   1
  36.       Top             =   960
  37.       Visible         =   0   'False
  38.       Width           =   1215
  39.    End
  40.    Begin VB.PictureBox imgPicture 
  41.       AutoRedraw      =   -1  'True
  42.       AutoSize        =   -1  'True
  43.       BorderStyle     =   0  'None
  44.       Height          =   495
  45.       Left            =   240
  46.       ScaleHeight     =   495
  47.       ScaleWidth      =   1215
  48.       TabIndex        =   0
  49.       Top             =   720
  50.       Visible         =   0   'False
  51.       Width           =   1215
  52.    End
  53.    Begin VB.Timer Timer1 
  54.       Enabled         =   0   'False
  55.       Interval        =   1
  56.       Left            =   720
  57.       Top             =   120
  58.    End
  59. End
  60. Attribute VB_Name = "ButtonEx"
  61. Attribute VB_GlobalNameSpace = False
  62. Attribute VB_Creatable = True
  63. Attribute VB_PredeclaredId = False
  64. Attribute VB_Exposed = False
  65. Option Explicit
  66. '**************************************************************
  67. '*  Copyright (C) TREEV Inc. 2000 - All Rights Reserved       *
  68. '*                                                            *
  69. '*  FILE:  ButtonEx.ctl                                       *
  70. '*                                                            *
  71. '*  DESCRIPTION:                                              *
  72. '*      Provides a enhanced CommandButton control, including  *
  73. '*      custom graphics as well MouseOver event, etc.         *
  74. '*                                                            *
  75. '*  CHANGE HISTORY:                                           *
  76. '*      Aug 2000    J. Pearson      Initial code              *
  77. '**************************************************************
  78.  
  79. '//---------------------------------------------------------------------------------------
  80. '// Windows API constants
  81. '//---------------------------------------------------------------------------------------
  82. Private Const BLACKNESS = &H42              '(DWORD) dest = BLACK
  83. Private Const NOTSRCCOPY = &H330008         '(DWORD) dest = (NOT source)
  84. Private Const NOTSRCERASE = &H1100A6        '(DWORD) dest = (NOT src) AND (NOT dest)
  85. Private Const SRCAND = &H8800C6             '(DWORD) dest = source AND dest
  86. Private Const SRCCOPY = &HCC0020            '(DWORD) dest = source
  87. Private Const SRCERASE = &H440328           '(DWORD) dest = source AND (NOT dest )
  88. Private Const SRCINVERT = &H660046          '(DWORD) dest = source XOR dest
  89. Private Const SRCPAINT = &HEE0086           '(DWORD) dest = source OR dest
  90. Private Const WHITENESS = &HFF0062          '(DWORD) dest = WHITE
  91.  
  92. Private Const BDR_RAISEDINNER = &H4
  93. Private Const BDR_RAISEDOUTER = &H1
  94. Private Const BDR_SUNKENINNER = &H8
  95. Private Const BDR_SUNKENOUTER = &H2
  96.  
  97. Private Const BDR_RAISED = &H5
  98. Private Const BDR_OUTER = &H3
  99. Private Const BDR_INNER = &HC
  100.  
  101. Private Const BF_ADJUST = &H2000        'Calculate the space left over.
  102. Private Const BF_FLAT = &H4000          'For flat rather than 3-D borders.
  103. Private Const BF_MONO = &H8000          'For monochrome borders.
  104. Private Const BF_SOFT = &H1000          'Use for softer buttons.
  105. Private Const BF_BOTTOM = &H8
  106. Private Const BF_LEFT = &H1
  107. Private Const BF_RIGHT = &H4
  108. Private Const BF_TOP = &H2
  109. Private Const BF_RECT = (BF_LEFT Or BF_TOP Or BF_RIGHT Or BF_BOTTOM)
  110.  
  111. Private Const EDGE_RAISED = (BDR_RAISEDOUTER Or BDR_RAISEDINNER)
  112. Private Const EDGE_SUNKEN = (BDR_SUNKENOUTER Or BDR_SUNKENINNER)
  113. Private Const EDGE_BUMP = (BDR_RAISEDOUTER Or BDR_SUNKENINNER)
  114. Private Const EDGE_ETCHED = (BDR_SUNKENOUTER Or BDR_RAISEDINNER)
  115.  
  116. Private Const DT_CENTER = &H1
  117. Private Const DT_RTLREADING = &H20000
  118. Private Const DT_SINGLELINE = &H20
  119. Private Const DT_VCENTER = &H4
  120.  
  121. Private Const DST_COMPLEX = &H0
  122. Private Const DST_TEXT = &H1
  123. Private Const DST_PREFIXTEXT = &H2
  124. Private Const DST_ICON = &H3
  125. Private Const DST_BITMAP = &H4
  126.  
  127. Private Const DSS_NORMAL = &H0
  128. Private Const DSS_UNION = &H10                   '/* Gray string appearance */
  129. Private Const DSS_DISABLED = &H20
  130. Private Const DSS_RIGHT = &H8000
  131.  
  132. '//---------------------------------------------------------------------------------------
  133. '// Windows API types
  134. '//---------------------------------------------------------------------------------------
  135. Private Type POINTAPI
  136.     X As Long
  137.     Y As Long
  138. End Type
  139.  
  140. Private Type RECT
  141.     Left As Long
  142.     Top As Long
  143.     Right As Long
  144.     Bottom As Long
  145. End Type
  146.  
  147. '//---------------------------------------------------------------------------------------
  148. '// Windows API declarations
  149. '//---------------------------------------------------------------------------------------
  150. Private Declare Function BitBlt Lib "gdi32" (ByVal hdcDest As Long, ByVal xDest As Long, ByVal yDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hdcSrc As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  151. Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
  152. Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
  153. Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
  154. Private Declare Function DrawEdge Lib "user32" (ByVal hdc As Long, qrc As RECT, ByVal edge As Long, ByVal grfFlags As Long) As Long
  155. Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
  156. 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 n1 As Long, ByVal n2 As Long, ByVal n3 As Long, ByVal n4 As Long, ByVal un As Long) As Long
  157. 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
  158. 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
  159. Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
  160. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  161. Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
  162. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  163. Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
  164. Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long
  165. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  166. Private Declare Function SetBkColor Lib "gdi32" (ByVal hdc As Long, ByVal crColor As Long) As Long
  167.  
  168. '//---------------------------------------------------------------------------------------
  169. '// Private enumerations
  170. '//---------------------------------------------------------------------------------------
  171. Private Enum StateConstants
  172.     btDown = 0
  173.     btUp = 1
  174.     btOver = 2
  175.     btDisabled = 3
  176.     btFocus = 4
  177. End Enum
  178.  
  179. Private Enum RasterOperationConstants
  180.     roNotSrcCopy = NOTSRCCOPY
  181.     roNotSrcErase = NOTSRCERASE
  182.     roSrcAnd = SRCAND
  183.     roSrcCopy = SRCCOPY
  184.     roSrcErase = SRCERASE
  185.     roSrcInvert = SRCINVERT
  186.     roSrcPaint = SRCPAINT
  187. End Enum
  188.  
  189. '//---------------------------------------------------------------------------------------
  190. '// Private constants
  191. '//---------------------------------------------------------------------------------------
  192. Private Const clTop As Long = 6
  193. Private Const clLeft As Long = 6
  194. Private Const clFocusOffset As Long = 4
  195. Private Const clDownOffset As Long = 1
  196.  
  197. '//---------------------------------------------------------------------------------------
  198. '// Private variables
  199. '//---------------------------------------------------------------------------------------
  200. Private tPrevEvent As String
  201. Private lState As StateConstants
  202. Private bLeftFocus As Boolean
  203. Private bHasFocus As Boolean
  204.  
  205. '//---------------------------------------------------------------------------------------
  206. '// Public constants
  207. '//---------------------------------------------------------------------------------------
  208. Public Enum AppearanceConstants
  209.     Flat = 0
  210.     [3D] = 1
  211.     Skin = 2
  212. End Enum
  213.  
  214. Public Enum StyleConstants
  215.     Default = 0
  216.     ButtonGroup = 1
  217. End Enum
  218.  
  219. Public Enum ValueConstants
  220.     Down = 0
  221.     Up = 1
  222. End Enum
  223.  
  224. '//---------------------------------------------------------------------------------------
  225. '// Control property constants
  226. '//---------------------------------------------------------------------------------------
  227. Private Const m_def_Appearance = [3D]
  228. Private Const m_def_BackColor = vbButtonFace
  229. Private Const m_def_Caption = "ButtonEx1"
  230. Private Const m_def_CaptionOffsetX = 0
  231. Private Const m_def_CaptionOffsetY = 0
  232. Private Const m_def_Enabled = True
  233. Private Const m_def_ForeColor = vbButtonText
  234. Private Const m_def_HighlightColor = vbButtonText
  235. Private Const m_def_HighlightPicture = False
  236. Private Const m_def_MousePointer = vbDefault
  237. Private Const m_def_PictureOffsetX = 0
  238. Private Const m_def_PictureOffsetY = 0
  239. Private Const m_def_RightToLeft = False
  240. Private Const m_def_Style = 0
  241. Private Const m_def_ToolTipText = ""
  242. Private Const m_def_TransparentColor = vbBlue
  243. Private Const m_def_Value = Up
  244. Private Const m_def_WhatsThisHelpID = 0
  245.  
  246. '//---------------------------------------------------------------------------------------
  247. '// Control property variables
  248. '//---------------------------------------------------------------------------------------
  249. Private m_Appearance As AppearanceConstants
  250. Private m_BackColor As OLE_COLOR
  251. Private m_Caption As String
  252. Private m_CaptionOffsetX As Long
  253. Private m_CaptionOffsetY As Long
  254. Private m_Enabled As Boolean
  255. Private m_ForeColor As OLE_COLOR
  256. Private m_Font As Font
  257. Private m_HighlightColor As OLE_COLOR
  258. Private m_HighlightPicture As Boolean
  259. Private m_MouseIcon As Picture
  260. Private m_MousePointer As MousePointerConstants
  261. Private m_Picture As Picture
  262. Private m_PictureDisabled As Picture
  263. Private m_PictureDown As Picture
  264. Private m_PictureFocus As Picture
  265. Private m_PictureOffsetX As Long
  266. Private m_PictureOffsetY As Long
  267. Private m_PictureOver As Picture
  268. Private m_RightToLeft As Boolean
  269. Private m_SkinDisabled As Picture
  270. Private m_SkinDown As Picture
  271. Private m_SkinFocus As Picture
  272. Private m_SkinOver As Picture
  273. Private m_SkinUp As Picture
  274. Private m_Style As StyleConstants
  275. Private m_ToolTipText As String
  276. Private m_TransparentColor As OLE_COLOR
  277. Private m_Value As ValueConstants
  278. Private m_WhatsThisHelpID As Long
  279.  
  280. '//---------------------------------------------------------------------------------------
  281. '// Control property events
  282. '//---------------------------------------------------------------------------------------
  283. Public Event Click()
  284. Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over the control."
  285. Public Event KeyDown(KeyCode As Integer, Shift As Integer)
  286. Attribute KeyDown.VB_Description = "Occurs when the user presses a key while the control has the focus."
  287. Public Event KeyPress(KeyAscii As Integer)
  288. Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
  289. Public Event KeyUp(KeyCode As Integer, Shift As Integer)
  290. Attribute KeyUp.VB_Description = "Occurs when the user releases a key while the control has the focus."
  291. Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  292. Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while the control has the focus."
  293. Public Event MouseEnter()
  294. Attribute MouseEnter.VB_Description = "Occurs when the user moves the mouse over the control after MouseExit event."
  295. Public Event MouseExit()
  296. Attribute MouseExit.VB_Description = "Occurs when the user moves the mouse out of the control after MouseEnter event."
  297. Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  298. Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
  299. Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  300. Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while the control has the focus."
  301. Public Event Resize()
  302. Attribute Resize.VB_Description = "Occurs when a form is first displayed or the size of the control changes."
  303.  
  304. '//---------------------------------------------------------------------------------------
  305. '// Control properties
  306. '//---------------------------------------------------------------------------------------
  307.  
  308. Public Property Get Appearance() As AppearanceConstants
  309. Attribute Appearance.VB_Description = "Returns/sets whether or not the control is painted with 3-D effects."
  310.     Appearance = m_Appearance
  311. End Property
  312.  
  313. Public Property Let Appearance(ByVal NewValue As AppearanceConstants)
  314.     m_Appearance = NewValue
  315.         
  316.     Call DrawButton(lState)
  317.     
  318.     PropertyChanged "Appearance"
  319. End Property
  320.  
  321. Public Property Get BackColor() As OLE_COLOR
  322. Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in the control."
  323.     BackColor = m_BackColor
  324. End Property
  325.  
  326. Public Property Let BackColor(ByVal NewValue As OLE_COLOR)
  327.     m_BackColor = NewValue
  328.     UserControl.BackColor = NewValue
  329.     imgPicture.BackColor = NewValue
  330.     
  331.     Call DrawButton(lState)
  332.     
  333.     PropertyChanged "BackColor"
  334. End Property
  335.  
  336. Public Property Get Caption() As String
  337. Attribute Caption.VB_Description = "Returns/sets the text displayed in the control."
  338.     Caption = m_Caption
  339. End Property
  340.  
  341. Public Property Let Caption(ByVal NewValue As String)
  342.     Dim lPlace As Long
  343.     
  344.     m_Caption = NewValue
  345.     
  346.     'set access key
  347.     lPlace = 0
  348.     lPlace = InStr(lPlace + 1, NewValue, "&", vbTextCompare)
  349.     Do While lPlace <> 0
  350.         If Mid$(NewValue, lPlace + 1, 1) <> "&" Then
  351.             UserControl.AccessKeys = Mid$(NewValue, lPlace + 1, 1)
  352.             Exit Do
  353.         Else
  354.             lPlace = lPlace + 1
  355.         End If
  356.     
  357.         lPlace = InStr(lPlace + 1, NewValue, "&", vbTextCompare)
  358.     Loop
  359.     
  360.     Call DrawButton(lState)
  361.     
  362.     PropertyChanged "Caption"
  363. End Property
  364.  
  365. Public Property Get CaptionOffsetX() As Long
  366. Attribute CaptionOffsetX.VB_Description = "Returns/sets the horizontal offset for displaying the caption."
  367.     CaptionOffsetX = m_CaptionOffsetX
  368. End Property
  369.  
  370. Public Property Let CaptionOffsetX(ByVal NewValue As Long)
  371.     m_CaptionOffsetX = NewValue
  372.     
  373.     Call DrawButton(lState)
  374.     
  375.     PropertyChanged "CaptionOffsetX"
  376. End Property
  377.  
  378. Public Property Get CaptionOffsetY() As Long
  379. Attribute CaptionOffsetY.VB_Description = "Returns/sets the vertical offset for displaying the caption."
  380.     CaptionOffsetY = m_CaptionOffsetY
  381. End Property
  382.  
  383. Public Property Let CaptionOffsetY(ByVal NewValue As Long)
  384.     m_CaptionOffsetY = NewValue
  385.     
  386.     Call DrawButton(lState)
  387.     
  388.     PropertyChanged "CaptionOffsetY"
  389. End Property
  390.  
  391. Public Property Get Enabled() As Boolean
  392. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  393.     Enabled = m_Enabled
  394. End Property
  395.  
  396. Public Property Let Enabled(ByVal NewValue As Boolean)
  397.     m_Enabled = NewValue
  398.     UserControl.Enabled = NewValue
  399.     imgPicture.Enabled = NewValue
  400.     
  401.     If m_Enabled Then
  402.         lState = btUp
  403.     End If
  404.     Call DrawButton(lState)
  405.     
  406.     PropertyChanged "Enabled"
  407. End Property
  408.  
  409. Public Property Get ForeColor() As OLE_COLOR
  410. Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in the control."
  411.     ForeColor = m_ForeColor
  412. End Property
  413.  
  414. Public Property Let ForeColor(ByVal NewValue As OLE_COLOR)
  415.     m_ForeColor = NewValue
  416.     UserControl.ForeColor = NewValue
  417.     imgPicture.ForeColor = NewValue
  418.     
  419.     Call DrawButton(lState)
  420.     
  421.     PropertyChanged "ForeColor"
  422. End Property
  423.  
  424. Public Property Get Font() As Font
  425. Attribute Font.VB_Description = "Returns/sets a Font object used to display text in the control."
  426.     Set Font = m_Font
  427. End Property
  428.  
  429. Public Property Set Font(ByVal NewValue As Font)
  430.     Set m_Font = NewValue
  431.     Set UserControl.Font = NewValue
  432.     Set imgPicture.Font = NewValue
  433.     
  434.     Call DrawButton(lState)
  435.     
  436.     PropertyChanged "Font"
  437. End Property
  438.  
  439. Public Property Get HighlightColor() As OLE_COLOR
  440. Attribute HighlightColor.VB_Description = "Returns/sets the highlight color used to display text and graphics when the mouse is over the control."
  441.     HighlightColor = m_HighlightColor
  442. End Property
  443.  
  444. Public Property Let HighlightColor(ByVal NewValue As OLE_COLOR)
  445.     m_HighlightColor = NewValue
  446.     
  447.     Call DrawButton(lState)
  448.     
  449.     PropertyChanged "HighlightColor"
  450. End Property
  451.  
  452. Public Property Get HighlightPicture() As Boolean
  453. Attribute HighlightPicture.VB_Description = "Returns/sets whether or not to highlight the object's picture with the HighlightColor."
  454.     HighlightPicture = m_HighlightPicture
  455. End Property
  456.  
  457. Public Property Let HighlightPicture(ByVal NewValue As Boolean)
  458.     m_HighlightPicture = NewValue
  459.     
  460.     Call DrawButton(btDisabled)
  461.     
  462.     PropertyChanged "HighlightPicture"
  463. End Property
  464.  
  465. Public Property Get MouseIcon() As Picture
  466. Attribute MouseIcon.VB_Description = "Returns/sets a custom mouse icon."
  467.     Set MouseIcon = m_MouseIcon
  468. End Property
  469.  
  470. Public Property Set MouseIcon(ByVal NewValue As Picture)
  471.     Set m_MouseIcon = NewValue
  472.     Set UserControl.MouseIcon = NewValue
  473.     Set imgPicture.MouseIcon = NewValue
  474.     
  475.     PropertyChanged "MouseIcon"
  476. End Property
  477.  
  478. Public Property Get MousePointer() As MousePointerConstants
  479. Attribute MousePointer.VB_Description = "Returns/sets the type of mouse pointer displayed when over part of the control."
  480.     MousePointer = m_MousePointer
  481. End Property
  482.  
  483. Public Property Let MousePointer(ByVal NewValue As MousePointerConstants)
  484.     m_MousePointer = NewValue
  485.     UserControl.MousePointer = NewValue
  486.     imgPicture.MousePointer = NewValue
  487.     
  488.     PropertyChanged "MousePointer"
  489. End Property
  490.  
  491. Public Property Get Picture() As Picture
  492. Attribute Picture.VB_Description = "Returns/sets a graphic to be displayed in the control."
  493.     Set Picture = m_Picture
  494. End Property
  495.  
  496. Public Property Set Picture(ByVal NewValue As Picture)
  497.     Set m_Picture = NewValue
  498.     Set imgPicture.Picture = NewValue
  499.     
  500.     Call DrawButton(lState)
  501.     
  502.     PropertyChanged "Picture"
  503. End Property
  504.  
  505. Public Property Get PictureDisabled() As Picture
  506. Attribute PictureDisabled.VB_Description = "Returns/sets a graphic to be displayed in the control for the disabled state."
  507.     Set PictureDisabled = m_PictureDisabled
  508. End Property
  509.  
  510. Public Property Set PictureDisabled(ByVal NewValue As Picture)
  511.     Set m_PictureDisabled = NewValue
  512.     PropertyChanged "PictureDisabled"
  513. End Property
  514.  
  515. Public Property Get PictureDown() As Picture
  516.     Set PictureDown = m_PictureDown
  517. End Property
  518.  
  519. Public Property Set PictureDown(ByVal NewValue As Picture)
  520.     Set m_PictureDown = NewValue
  521.     PropertyChanged "PictureDown"
  522. End Property
  523.  
  524. Public Property Get PictureFocus() As Picture
  525.     Set PictureFocus = m_PictureFocus
  526. End Property
  527.  
  528. Public Property Set PictureFocus(ByVal New_PictureFocus As Picture)
  529.     Set m_PictureFocus = New_PictureFocus
  530.     PropertyChanged "PictureFocus"
  531. End Property
  532.  
  533. Public Property Get PictureOffsetX() As Long
  534. Attribute PictureOffsetX.VB_Description = "Returns/sets the horizontal offset for displaying the picture."
  535.     PictureOffsetX = m_PictureOffsetX
  536. End Property
  537.  
  538. Public Property Let PictureOffsetX(ByVal NewValue As Long)
  539.     m_PictureOffsetX = NewValue
  540.     
  541.     Call DrawButton(lState)
  542.     
  543.     PropertyChanged "PictureOffsetX"
  544. End Property
  545.  
  546. Public Property Get PictureOffsetY() As Long
  547. Attribute PictureOffsetY.VB_Description = "Returns/sets the vertical offset for displaying the picture."
  548.     PictureOffsetY = m_PictureOffsetY
  549. End Property
  550.  
  551. Public Property Let PictureOffsetY(ByVal NewValue As Long)
  552.     m_PictureOffsetY = NewValue
  553.     
  554.     Call DrawButton(lState)
  555.     
  556.     PropertyChanged "PictureOffsetY"
  557. End Property
  558.  
  559. Public Property Get PictureOver() As Picture
  560.     Set PictureOver = m_PictureOver
  561. End Property
  562.  
  563. Public Property Set PictureOver(ByVal New_PictureOver As Picture)
  564.     Set m_PictureOver = New_PictureOver
  565.     PropertyChanged "PictureOver"
  566. End Property
  567.  
  568. Public Property Get RightToLeft() As Boolean
  569. Attribute RightToLeft.VB_Description = "Determines text display direction and control visual appearance on a bidirectional system."
  570.     RightToLeft = m_RightToLeft
  571. End Property
  572.  
  573. Public Property Let RightToLeft(ByVal NewValue As Boolean)
  574.     m_RightToLeft = NewValue
  575.     UserControl.RightToLeft = NewValue
  576.     imgPicture.RightToLeft = NewValue
  577.     
  578.     Call DrawButton(lState)
  579.     
  580.     PropertyChanged "RightToLeft"
  581. End Property
  582.  
  583. Public Property Get SkinDisabled() As Picture
  584. Attribute SkinDisabled.VB_Description = "Returns/sets a graphic to be displayed for the control when it is disabled."
  585.     Set SkinDisabled = m_SkinDisabled
  586. End Property
  587.  
  588. Public Property Set SkinDisabled(ByVal NewValue As Picture)
  589.     Set m_SkinDisabled = NewValue
  590.     
  591.     Call DrawButton(lState)
  592.     
  593.     PropertyChanged "SkinDisabled"
  594. End Property
  595.  
  596. Public Property Get SkinDown() As Picture
  597. Attribute SkinDown.VB_Description = "Returns/sets a graphic to be displayed for the control the mouse has been pressed over it."
  598.     Set SkinDown = m_SkinDown
  599. End Property
  600.  
  601. Public Property Set SkinDown(ByVal NewValue As Picture)
  602.     Set m_SkinDown = NewValue
  603.     
  604.     Call DrawButton(lState)
  605.     
  606.     PropertyChanged "SkinDown"
  607. End Property
  608.  
  609. Public Property Get SkinFocus() As Picture
  610. Attribute SkinFocus.VB_Description = "Returns/sets a graphic to be displayed for the control when it default."
  611.     Set SkinFocus = m_SkinFocus
  612. End Property
  613.  
  614. Public Property Set SkinFocus(ByVal NewValue As Picture)
  615.     Set m_SkinFocus = NewValue
  616.     
  617.     Call DrawButton(lState)
  618.     
  619.     PropertyChanged "SkinFocus"
  620. End Property
  621.  
  622. Public Property Get SkinOver() As Picture
  623. Attribute SkinOver.VB_Description = "Returns/sets a graphic to be displayed for the control when the mouse is over it."
  624.     Set SkinOver = m_SkinOver
  625. End Property
  626.  
  627. Public Property Set SkinOver(ByVal NewValue As Picture)
  628.     Set m_SkinOver = NewValue
  629.     
  630.     Call DrawButton(lState)
  631.     
  632.     PropertyChanged "SkinOver"
  633. End Property
  634.  
  635. Public Property Get SkinUp() As Picture
  636. Attribute SkinUp.VB_Description = "Returns/sets a graphic to be displayed for the control."
  637.     Set SkinUp = m_SkinUp
  638. End Property
  639.  
  640. Public Property Set SkinUp(ByVal NewValue As Picture)
  641.     Set m_SkinUp = NewValue
  642.     
  643.     Call DrawButton(lState)
  644.     
  645.     PropertyChanged "SkinUp"
  646. End Property
  647.  
  648. Public Property Get Style() As StyleConstants
  649. Attribute Style.VB_Description = "Returns/sets the style for the control."
  650.     Style = m_Style
  651. End Property
  652.  
  653. Public Property Let Style(ByVal NewValue As StyleConstants)
  654.     m_Style = NewValue
  655.     
  656.     Call DrawButton(lState)
  657.     
  658.     PropertyChanged "Style"
  659. End Property
  660.  
  661. Public Property Get ToolTipText() As String
  662. Attribute ToolTipText.VB_Description = "Returns/sets the text displayed when the mouse cursor is over the control."
  663.     ToolTipText = m_ToolTipText
  664. End Property
  665.  
  666. Public Property Let ToolTipText(ByVal NewValue As String)
  667.     m_ToolTipText = NewValue
  668.     imgPicture.ToolTipText = NewValue
  669.     
  670.     PropertyChanged "ToolTipText"
  671. End Property
  672.  
  673. Public Property Get TransparentColor() As OLE_COLOR
  674. Attribute TransparentColor.VB_Description = "Returns/sets the color of the Picture property to make transparent."
  675.     TransparentColor = m_TransparentColor
  676. End Property
  677.  
  678. Public Property Let TransparentColor(ByVal NewValue As OLE_COLOR)
  679.     m_TransparentColor = NewValue
  680.     UserControl.MaskColor = NewValue
  681.     
  682.     Call DrawButton(lState)
  683.     
  684.     PropertyChanged "TransparentColor"
  685. End Property
  686.  
  687. Public Property Get Value() As ValueConstants
  688. Attribute Value.VB_Description = "Returns/sets a default state for the control."
  689.     Value = m_Value
  690. End Property
  691.  
  692. Public Property Let Value(ByVal NewValue As ValueConstants)
  693.     m_Value = NewValue
  694.     
  695.     Call DrawButton(m_Value)
  696.     
  697.     PropertyChanged "Value"
  698. End Property
  699.  
  700. Public Property Get WhatsThisHelpID() As Long
  701. Attribute WhatsThisHelpID.VB_Description = "Returns/sets an associated help context ID for the control."
  702.     WhatsThisHelpID = m_WhatsThisHelpID
  703. End Property
  704.  
  705. Public Property Let WhatsThisHelpID(ByVal NewValue As Long)
  706.     m_WhatsThisHelpID = NewValue
  707.     imgPicture.WhatsThisHelpID = NewValue
  708.     
  709.     PropertyChanged "WhatsThisHelpID"
  710. End Property
  711.  
  712. '//---------------------------------------------------------------------------------------
  713. '// Image functions
  714. '//---------------------------------------------------------------------------------------
  715.  
  716. Private Sub imgPicture_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  717.     Call UserControl_MouseDown(Button, Shift, imgPicture.Left + (X \ Screen.TwipsPerPixelX), imgPicture.Top + (Y \ Screen.TwipsPerPixelY))
  718. End Sub
  719.  
  720. Private Sub imgPicture_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  721.     Call UserControl_MouseMove(Button, Shift, imgPicture.Left + (X \ Screen.TwipsPerPixelX), imgPicture.Top + (Y \ Screen.TwipsPerPixelY))
  722. End Sub
  723.  
  724. Private Sub imgPicture_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  725.     Call UserControl_MouseUp(Button, Shift, imgPicture.Left + (X \ Screen.TwipsPerPixelX), imgPicture.Top + (Y \ Screen.TwipsPerPixelY))
  726. End Sub
  727.  
  728. '//---------------------------------------------------------------------------------------
  729. '// Timer functions
  730. '//---------------------------------------------------------------------------------------
  731.  
  732. Private Sub Timer1_Timer()
  733.     'check for mouse leaving control
  734.     Dim pnt As POINTAPI
  735.     
  736.     GetCursorPos pnt
  737.     ScreenToClient UserControl.hWnd, pnt
  738.     
  739.     If pnt.X < UserControl.ScaleLeft Or _
  740.             pnt.Y < UserControl.ScaleTop Or _
  741.             pnt.X > (UserControl.ScaleLeft + UserControl.ScaleWidth) Or _
  742.             pnt.Y > (UserControl.ScaleTop + UserControl.ScaleHeight) Then
  743.         Timer1.Enabled = False
  744.     
  745.         Call RaiseEventEx("MouseExit")
  746.         
  747.         'left focus
  748.         If lState <> btUp Then
  749.             Call DrawButton(btUp)
  750.         End If
  751.         bLeftFocus = True
  752.     Else
  753.         'gained focus
  754.         If bLeftFocus Then
  755.             Call DrawButton(btDown)
  756.         End If
  757.     End If
  758. End Sub
  759.  
  760. '//---------------------------------------------------------------------------------------
  761. '// UserControl functions
  762. '//---------------------------------------------------------------------------------------
  763.  
  764. Private Sub UserControl_InitProperties()
  765.     'Initialize Properties for User Control
  766.     Appearance = m_def_Appearance
  767.     BackColor = m_def_BackColor
  768.     Caption = m_def_Caption
  769.     CaptionOffsetX = m_def_CaptionOffsetX
  770.     CaptionOffsetY = m_def_CaptionOffsetY
  771.     Enabled = m_def_Enabled
  772.     ForeColor = m_def_ForeColor
  773.     Set Font = Ambient.Font
  774.     HighlightColor = m_def_HighlightColor
  775.     HighlightPicture = m_def_HighlightPicture
  776.     Set MouseIcon = LoadPicture("")
  777.     MousePointer = m_def_MousePointer
  778.     Set Picture = LoadPicture("")
  779.     Set PictureDisabled = LoadPicture("")
  780.     Set PictureDown = LoadPicture("")
  781.     Set PictureFocus = LoadPicture("")
  782.     PictureOffsetX = m_def_PictureOffsetX
  783.     PictureOffsetY = m_def_PictureOffsetY
  784.     Set PictureOver = LoadPicture("")
  785.     RightToLeft = m_def_RightToLeft
  786.     Set SkinDisabled = LoadPicture("")
  787.     Set SkinDown = LoadPicture("")
  788.     Set SkinFocus = LoadPicture("")
  789.     Set SkinOver = LoadPicture("")
  790.     Set SkinUp = LoadPicture("")
  791.     Style = m_def_Style
  792.     ToolTipText = m_def_ToolTipText
  793.     TransparentColor = m_def_TransparentColor
  794.     Value = m_def_Value
  795.     WhatsThisHelpID = m_def_WhatsThisHelpID
  796. End Sub
  797.  
  798. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  799.     'Load property values from storage
  800.     Appearance = PropBag.ReadProperty("Appearance", m_def_Appearance)
  801.     BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
  802.     Caption = PropBag.ReadProperty("Caption", m_def_Caption)
  803.     CaptionOffsetX = PropBag.ReadProperty("CaptionOffsetX", m_def_CaptionOffsetX)
  804.     CaptionOffsetY = PropBag.ReadProperty("CaptionOffsetY", m_def_CaptionOffsetY)
  805.     Enabled = PropBag.ReadProperty("Enabled", m_def_Enabled)
  806.     ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
  807.     Set Font = PropBag.ReadProperty("Font", Ambient.Font)
  808.     HighlightColor = PropBag.ReadProperty("HighlightColor", m_def_HighlightColor)
  809.     HighlightPicture = PropBag.ReadProperty("HighlightPicture", m_def_HighlightPicture)
  810.     Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
  811.     MousePointer = PropBag.ReadProperty("MousePointer", m_def_MousePointer)
  812.     Set Picture = PropBag.ReadProperty("Picture", Nothing)
  813.     Set PictureDisabled = PropBag.ReadProperty("PictureDisabled", Nothing)
  814.     Set PictureDown = PropBag.ReadProperty("PictureDown", Nothing)
  815.     Set PictureFocus = PropBag.ReadProperty("PictureFocus", Nothing)
  816.     PictureOffsetX = PropBag.ReadProperty("PictureOffsetX", m_def_PictureOffsetX)
  817.     PictureOffsetY = PropBag.ReadProperty("PictureOffsetY", m_def_PictureOffsetY)
  818.     Set PictureOver = PropBag.ReadProperty("PictureOver", Nothing)
  819.     RightToLeft = PropBag.ReadProperty("RightToLeft", m_def_RightToLeft)
  820.     Set SkinDisabled = PropBag.ReadProperty("SkinDisabled", Nothing)
  821.     Set SkinDown = PropBag.ReadProperty("SkinDown", Nothing)
  822.     Set SkinFocus = PropBag.ReadProperty("SkinFocus", Nothing)
  823.     Set SkinOver = PropBag.ReadProperty("SkinOver", Nothing)
  824.     Set SkinUp = PropBag.ReadProperty("SkinUp", Nothing)
  825.     Style = PropBag.ReadProperty("Style", m_def_Style)
  826.     ToolTipText = PropBag.ReadProperty("ToolTipText", m_def_ToolTipText)
  827.     TransparentColor = PropBag.ReadProperty("TransparentColor", m_def_TransparentColor)
  828.     Value = PropBag.ReadProperty("Value", m_def_Value)
  829.     WhatsThisHelpID = PropBag.ReadProperty("WhatsThisHelpID", m_def_WhatsThisHelpID)
  830. End Sub
  831.  
  832. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  833.     'Write property values to storage
  834.     Call PropBag.WriteProperty("Appearance", m_Appearance, m_def_Appearance)
  835.     Call PropBag.WriteProperty("Enabled", m_Enabled, m_def_Enabled)
  836.     Call PropBag.WriteProperty("BackColor", m_BackColor, m_def_BackColor)
  837.     Call PropBag.WriteProperty("Caption", m_Caption, m_def_Caption)
  838.     Call PropBag.WriteProperty("CaptionOffsetX", m_CaptionOffsetX, m_def_CaptionOffsetX)
  839.     Call PropBag.WriteProperty("CaptionOffsetY", m_CaptionOffsetY, m_def_CaptionOffsetY)
  840.     Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
  841.     Call PropBag.WriteProperty("Font", m_Font, Ambient.Font)
  842.     Call PropBag.WriteProperty("HighlightColor", m_HighlightColor, m_def_HighlightColor)
  843.     Call PropBag.WriteProperty("HighlightPicture", m_HighlightPicture, m_def_HighlightPicture)
  844.     Call PropBag.WriteProperty("Picture", m_Picture, Nothing)
  845.     Call PropBag.WriteProperty("PictureDisabled", m_PictureDisabled, Nothing)
  846.     Call PropBag.WriteProperty("PictureDown", m_PictureDown, Nothing)
  847.     Call PropBag.WriteProperty("PictureFocus", m_PictureFocus, Nothing)
  848.     Call PropBag.WriteProperty("PictureOffsetX", m_PictureOffsetX, m_def_PictureOffsetX)
  849.     Call PropBag.WriteProperty("PictureOffsetY", m_PictureOffsetY, m_def_PictureOffsetY)
  850.     Call PropBag.WriteProperty("PictureOver", m_PictureOver, Nothing)
  851.     Call PropBag.WriteProperty("RightToLeft", m_RightToLeft, m_def_RightToLeft)
  852.     Call PropBag.WriteProperty("TransparentColor", m_TransparentColor, m_def_TransparentColor)
  853.     Call PropBag.WriteProperty("MouseIcon", m_MouseIcon, Nothing)
  854.     Call PropBag.WriteProperty("MousePointer", m_MousePointer, m_def_MousePointer)
  855.     Call PropBag.WriteProperty("SkinDisabled", m_SkinDisabled, Nothing)
  856.     Call PropBag.WriteProperty("SkinDown", m_SkinDown, Nothing)
  857.     Call PropBag.WriteProperty("SkinFocus", m_SkinFocus, Nothing)
  858.     Call PropBag.WriteProperty("SkinOver", m_SkinOver, Nothing)
  859.     Call PropBag.WriteProperty("SkinUp", m_SkinUp, Nothing)
  860.     Call PropBag.WriteProperty("Style", m_Style, m_def_Style)
  861.     Call PropBag.WriteProperty("ToolTipText", m_ToolTipText, m_def_ToolTipText)
  862.     Call PropBag.WriteProperty("TransparentColor", m_TransparentColor, m_def_TransparentColor)
  863.     Call PropBag.WriteProperty("Value", m_Value, m_def_Value)
  864.     Call PropBag.WriteProperty("WhatsThisHelpID", m_WhatsThisHelpID, m_def_WhatsThisHelpID)
  865. End Sub
  866.  
  867. Private Sub UserControl_Click()
  868.     Call RaiseEventEx("Click")
  869. End Sub
  870.  
  871. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  872.     Call RaiseEventEx("KeyDown", KeyCode, Shift)
  873. End Sub
  874.  
  875. Private Sub UserControl_KeyPress(KeyAscii As Integer)
  876.     Call RaiseEventEx("KeyPress", KeyAscii)
  877. End Sub
  878.  
  879. Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  880.     Call RaiseEventEx("KeyUp", KeyCode, Shift)
  881. End Sub
  882.  
  883. Private Sub UserControl_AccessKeyPress(KeyAscii As Integer)
  884.     Call RaiseEventEx("Click")
  885. End Sub
  886.  
  887. Private Sub UserControl_AmbientChanged(PropertyName As String)
  888.     If PropertyName = "DisplayAsDefault" Then
  889.         If UserControl.Ambient.DisplayAsDefault Then
  890.             bHasFocus = True
  891.         Else
  892.             bHasFocus = False
  893.         End If
  894.         Call DrawButton(lState)
  895.     End If
  896. End Sub
  897.  
  898. Private Sub UserControl_Initialize()
  899.     'note: this really sets to 1215x375
  900.     UserControl.Width = 1200
  901.     UserControl.Height = 360
  902. End Sub
  903.  
  904. Private Sub UserControl_GotFocus()
  905.     bHasFocus = True
  906.     Call DrawButton(lState)
  907. End Sub
  908.  
  909. Private Sub UserControl_LostFocus()
  910.     bHasFocus = False
  911.     Call DrawButton(lState)
  912. End Sub
  913.  
  914. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  915.     bLeftFocus = False
  916.     
  917.     If Button = vbLeftButton Then
  918.         If lState = btDown Then
  919.             m_Value = Up
  920.         Else
  921.             m_Value = Down
  922.         End If
  923.         
  924.         Call DrawButton(btDown)
  925.     End If
  926.     
  927.     Call RaiseEventEx("MouseDown", Button, Shift, X * Screen.TwipsPerPixelX, Y * Screen.TwipsPerPixelY)
  928. End Sub
  929.  
  930. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  931.     bLeftFocus = False
  932.     
  933.     If UserControl.Ambient.UserMode = True And Not Timer1.Enabled Then
  934.         'start tracking
  935.         Timer1.Enabled = True
  936.     
  937.     ElseIf Button = 0 Then
  938.         'mouse over (for flat button)
  939.         If lState <> btOver Then
  940.             Call DrawButton(btOver)
  941.         End If
  942.  
  943.     ElseIf Button = vbLeftButton Then
  944.         If lState <> btDown Then
  945.             Call DrawButton(btDown)
  946.         End If
  947.     End If
  948.  
  949.     If X >= 0 And Y >= 0 And _
  950.                 X <= UserControl.ScaleWidth And Y <= UserControl.ScaleHeight Then
  951.         Call RaiseEventEx("MouseEnter")
  952.         Call RaiseEventEx("MouseMove", Button, Shift, X * Screen.TwipsPerPixelX, Y * Screen.TwipsPerPixelY)
  953.     End If
  954. End Sub
  955.  
  956. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  957.     bLeftFocus = False
  958.     
  959.     If Button = vbLeftButton Then
  960.         Call DrawButton(btUp)
  961.     End If
  962.  
  963.     Call RaiseEventEx("MouseUp", Button, Shift, X * Screen.TwipsPerPixelX, Y * Screen.TwipsPerPixelY)
  964. End Sub
  965.  
  966. Private Sub UserControl_Resize()
  967.     Call DrawButton(btUp)
  968.     Call RaiseEventEx("Resize")
  969. End Sub
  970.  
  971. '//---------------------------------------------------------------------------------------
  972. '// Private functions
  973. '//---------------------------------------------------------------------------------------
  974.  
  975. Private Sub TransparentBlt_New2(ByVal hdc As Long, ByVal Source As PictureBox, ByRef DestPoint As POINTAPI, ByRef SrcPoint As POINTAPI, ByVal Width As Long, ByVal Height As Long, Optional ByVal TransparentColor As OLE_COLOR = -1, Optional ByVal Clear As Boolean = False, Optional ByVal Resize As Boolean = False, Optional ByVal Refresh As Boolean = False)
  976.     Dim MonoMaskDC As Long
  977.     Dim hMonoMask As Long
  978.     Dim MonoInvDC As Long
  979.     Dim hMonoInv As Long
  980.     Dim ResultDstDC As Long
  981.     Dim hResultDst As Long
  982.     Dim ResultSrcDC As Long
  983.     Dim hResultSrc As Long
  984.     Dim hPrevMask As Long
  985.     Dim hPrevInv As Long
  986.     Dim hPrevSrc As Long
  987.     Dim hPrevDst As Long
  988.     Dim OldBC As Long
  989.     
  990.     If TransparentColor = -1 Then
  991.         TransparentColor = GetPixel(Source.hdc, 1, 1)
  992.     End If
  993.     
  994.     'create monochrome mask and inverse masks
  995.     MonoMaskDC = CreateCompatibleDC(hdc)
  996.     MonoInvDC = CreateCompatibleDC(hdc)
  997.     hMonoMask = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
  998.     hMonoInv = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
  999.     hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
  1000.     hPrevInv = SelectObject(MonoInvDC, hMonoInv)
  1001.     
  1002.     'create keeper DCs and bitmaps
  1003.     ResultDstDC = CreateCompatibleDC(hdc)
  1004.     ResultSrcDC = CreateCompatibleDC(hdc)
  1005.     hResultDst = CreateCompatibleBitmap(hdc, Width, Height)
  1006.     hResultSrc = CreateCompatibleBitmap(hdc, Width, Height)
  1007.     hPrevDst = SelectObject(ResultDstDC, hResultDst)
  1008.     hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
  1009.     
  1010.     'copy src to monochrome mask
  1011.     OldBC = SetBkColor(Source.hdc, TransparentColor)
  1012.     Call BitBlt(MonoMaskDC, 0, 0, Width, Height, Source.hdc, SrcPoint.X, SrcPoint.Y, SRCCOPY)
  1013.     TransparentColor = SetBkColor(Source.hdc, OldBC)
  1014.     
  1015.     'create inverse of mask
  1016.     Call BitBlt(MonoInvDC, 0, 0, Width, Height, MonoMaskDC, 0, 0, NOTSRCCOPY)
  1017.     
  1018.     'get background
  1019.     Call BitBlt(ResultDstDC, 0, 0, Width, Height, hdc, DestPoint.X, DestPoint.Y, SRCCOPY)
  1020.     
  1021.     'AND with Monochrome mask
  1022.     Call BitBlt(ResultDstDC, 0, 0, Width, Height, MonoMaskDC, 0, 0, SRCAND)
  1023.     
  1024.     'get overlapper
  1025.     Call BitBlt(ResultSrcDC, 0, 0, Width, Height, Source.hdc, SrcPoint.X, SrcPoint.Y, SRCCOPY)
  1026.     
  1027.     'AND with inverse monochrome mask
  1028.     Call BitBlt(ResultSrcDC, 0, 0, Width, Height, MonoInvDC, 0, 0, SRCAND)
  1029.     
  1030.     'XOR these two
  1031.     Call BitBlt(ResultDstDC, 0, 0, Width, Height, ResultSrcDC, 0, 0, SRCINVERT)
  1032.     
  1033.     'output results
  1034.     Call BitBlt(hdc, DestPoint.X, DestPoint.Y, Width, Height, ResultDstDC, 0, 0, SRCCOPY)
  1035.     
  1036.     'clean up
  1037.     hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
  1038.     DeleteObject hMonoMask
  1039.     
  1040.     hMonoInv = SelectObject(MonoInvDC, hPrevInv)
  1041.     DeleteObject hMonoInv
  1042.     
  1043.     hResultDst = SelectObject(ResultDstDC, hPrevDst)
  1044.     DeleteObject hResultDst
  1045.     
  1046.     hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
  1047.     DeleteObject hResultSrc
  1048.     
  1049.     DeleteDC MonoMaskDC
  1050.     DeleteDC MonoInvDC
  1051.     DeleteDC ResultDstDC
  1052.     DeleteDC ResultSrcDC
  1053. End Sub
  1054.  
  1055. Private Function BitBltEx(ByVal Source As Object, ByVal Destination As Object, ByVal Operation As RasterOperationConstants, Optional ByVal xDest As Long = 0, Optional ByVal yDest As Long = 0, Optional ByVal xSrc As Long = 0, Optional ByVal ySrc As Long = 0, Optional ByVal Width As Long = -1, Optional ByVal Height As Long = -1, Optional ByVal Refresh As Boolean = False) As Boolean
  1056.     Dim lReturn As Long
  1057.     
  1058.     If Width = -1 Then
  1059.         Width = Source.Width \ Screen.TwipsPerPixelX
  1060.     End If
  1061.     If Height = -1 Then
  1062.         Height = Source.Height \ Screen.TwipsPerPixelX
  1063.     End If
  1064.     
  1065.     'BitBlt
  1066.     lReturn = BitBlt(Destination.hdc, xDest, yDest, Width, Height, Source.hdc, xSrc, ySrc, Operation)
  1067.     
  1068.     If Refresh Then
  1069.         'refresh destination
  1070.         Destination.Refresh
  1071.     End If
  1072.     
  1073.     'return result
  1074.     If lReturn = 0 Then
  1075.         BitBltEx = False
  1076.     Else
  1077.         BitBltEx = True
  1078.     End If
  1079. End Function
  1080.  
  1081. Private Function MaskBltEx(ByVal Source As Object, ByVal Destination As Object, Optional ByVal MaskColor As OLE_COLOR = -1, Optional ByVal xDest As Long = 0, Optional ByVal yDest As Long = 0, Optional ByVal xSrc As Long = 0, Optional ByVal ySrc As Long = 0, Optional ByVal Width As Long = -1, Optional ByVal Height As Long = -1, Optional ByVal Refresh As Boolean = False) As Boolean
  1082.     Dim MonoMaskDC As Long
  1083.     Dim hMonoMask As Long
  1084.     Dim MonoInvDC As Long
  1085.     Dim hMonoInv As Long
  1086.     Dim ResultDstDC As Long
  1087.     Dim hResultDst As Long
  1088.     Dim ResultSrcDC As Long
  1089.     Dim hResultSrc As Long
  1090.     Dim hPrevMask As Long
  1091.     Dim hPrevInv As Long
  1092.     Dim hPrevSrc As Long
  1093.     Dim hPrevDst As Long
  1094.     Dim OldBC As Long
  1095.     Dim lReturn As Long
  1096.     
  1097.     If Width = -1 Then
  1098.         Width = Source.Width \ Screen.TwipsPerPixelX
  1099.     End If
  1100.     If Height = -1 Then
  1101.         Height = Source.Height \ Screen.TwipsPerPixelX
  1102.     End If
  1103.     
  1104.     If MaskColor = -1 Then
  1105.         MaskColor = GetPixel(Source.hdc, 0, 0)
  1106.     End If
  1107.     
  1108.     'create monochrome mask and inverse masks
  1109.     MonoMaskDC = CreateCompatibleDC(Destination.hdc)
  1110.     hMonoMask = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
  1111.     hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
  1112.     
  1113.     'copy src to monochrome mask
  1114.     OldBC = SetBkColor(Source.hdc, MaskColor)
  1115.     lReturn = BitBlt(MonoMaskDC, 0, 0, Width, Height, Source.hdc, xSrc, ySrc, SRCCOPY)
  1116.     If lReturn <> 0 Then
  1117.         MaskColor = SetBkColor(Source.hdc, OldBC)
  1118.         
  1119.         'output results
  1120.         lReturn = BitBlt(Destination.hdc, xDest, yDest, Width, Height, MonoMaskDC, 0, 0, SRCCOPY)
  1121.     End If
  1122.     
  1123.     'clean up
  1124.     hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
  1125.     DeleteObject hMonoMask
  1126.     DeleteDC MonoMaskDC
  1127.  
  1128.     If Refresh Then
  1129.         'refresh destination
  1130.         Destination.Refresh
  1131.     End If
  1132.     
  1133.     'return result
  1134.     If lReturn = 0 Then
  1135.         MaskBltEx = False
  1136.     Else
  1137.         MaskBltEx = True
  1138.     End If
  1139. End Function
  1140.  
  1141. Private Function TransparentBltEx(ByVal Source As Object, ByVal Destination, Optional ByVal TransparentColor As OLE_COLOR = -1, Optional ByVal xDest As Long = 0, Optional ByVal yDest As Long = 0, Optional ByVal xSrc As Long = 0, Optional ByVal ySrc As Long = 0, Optional ByVal Width As Long = -1, Optional ByVal Height As Long = -1, Optional ByVal Refresh As Boolean = False) As Boolean
  1142.     Dim MonoMaskDC As Long
  1143.     Dim hMonoMask As Long
  1144.     Dim MonoInvDC As Long
  1145.     Dim hMonoInv As Long
  1146.     Dim ResultDstDC As Long
  1147.     Dim hResultDst As Long
  1148.     Dim ResultSrcDC As Long
  1149.     Dim hResultSrc As Long
  1150.     Dim hPrevMask As Long
  1151.     Dim hPrevInv As Long
  1152.     Dim hPrevSrc As Long
  1153.     Dim hPrevDst As Long
  1154.     Dim OldBC As Long
  1155.     Dim lReturn As Long
  1156.     
  1157.     If Width = -1 Then
  1158.         Width = Source.Width \ Screen.TwipsPerPixelX
  1159.     End If
  1160.     If Height = -1 Then
  1161.         Height = Source.Height \ Screen.TwipsPerPixelX
  1162.     End If
  1163.     
  1164.     If TransparentColor = -1 Then
  1165.         TransparentColor = GetPixel(Source.hdc, 0, 0)
  1166.     End If
  1167.     
  1168.     'create monochrome mask and inverse masks
  1169.     MonoMaskDC = CreateCompatibleDC(Destination.hdc)
  1170.     MonoInvDC = CreateCompatibleDC(Destination.hdc)
  1171.     hMonoMask = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
  1172.     hMonoInv = CreateBitmap(Width, Height, 1, 1, ByVal 0&)
  1173.     hPrevMask = SelectObject(MonoMaskDC, hMonoMask)
  1174.     hPrevInv = SelectObject(MonoInvDC, hMonoInv)
  1175.     
  1176.     'create keeper DCs and bitmaps
  1177.     ResultDstDC = CreateCompatibleDC(Destination.hdc)
  1178.     ResultSrcDC = CreateCompatibleDC(Destination.hdc)
  1179.     hResultDst = CreateCompatibleBitmap(Destination.hdc, Width, Height)
  1180.     hResultSrc = CreateCompatibleBitmap(Destination.hdc, Width, Height)
  1181.     hPrevDst = SelectObject(ResultDstDC, hResultDst)
  1182.     hPrevSrc = SelectObject(ResultSrcDC, hResultSrc)
  1183.     
  1184.     'copy src to monochrome mask
  1185.     OldBC = SetBkColor(Source.hdc, TransparentColor)
  1186.     lReturn = BitBlt(MonoMaskDC, 0, 0, Width, Height, Source.hdc, xSrc, ySrc, SRCCOPY)
  1187.     If lReturn <> 0 Then
  1188.         TransparentColor = SetBkColor(Source.hdc, OldBC)
  1189.         
  1190.         'create inverse of mask
  1191.         lReturn = BitBlt(MonoInvDC, 0, 0, Width, Height, MonoMaskDC, 0, 0, NOTSRCCOPY)
  1192.         If lReturn <> 0 Then
  1193.             'get background
  1194.             lReturn = BitBlt(ResultDstDC, 0, 0, Width, Height, Destination.hdc, xDest, yDest, SRCCOPY)
  1195.             If lReturn <> 0 Then
  1196.                 'AND with Monochrome mask
  1197.                 lReturn = BitBlt(ResultDstDC, 0, 0, Width, Height, MonoMaskDC, 0, 0, SRCAND)
  1198.                 If lReturn <> 0 Then
  1199.                     'get overlapper
  1200.                     lReturn = BitBlt(ResultSrcDC, 0, 0, Width, Height, Source.hdc, xSrc, ySrc, SRCCOPY)
  1201.                     If lReturn <> 0 Then
  1202.                         'AND with inverse monochrome mask
  1203.                         lReturn = BitBlt(ResultSrcDC, 0, 0, Width, Height, MonoInvDC, 0, 0, SRCAND)
  1204.                         If lReturn <> 0 Then
  1205.                             'XOR these two
  1206.                             lReturn = BitBlt(ResultDstDC, 0, 0, Width, Height, ResultSrcDC, 0, 0, SRCINVERT)
  1207.                             If lReturn <> 0 Then
  1208.                                 'output results
  1209.                                 lReturn = BitBlt(Destination.hdc, xDest, yDest, Width, Height, ResultDstDC, 0, 0, SRCCOPY)
  1210.                             End If
  1211.                         End If
  1212.                     End If
  1213.                 End If
  1214.             End If
  1215.         End If
  1216.     End If
  1217.     
  1218.     'clean up
  1219.     hMonoMask = SelectObject(MonoMaskDC, hPrevMask)
  1220.     DeleteObject hMonoMask
  1221.     
  1222.     hMonoInv = SelectObject(MonoInvDC, hPrevInv)
  1223.     DeleteObject hMonoInv
  1224.     
  1225.     hResultDst = SelectObject(ResultDstDC, hPrevDst)
  1226.     DeleteObject hResultDst
  1227.     
  1228.     hResultSrc = SelectObject(ResultSrcDC, hPrevSrc)
  1229.     DeleteObject hResultSrc
  1230.     
  1231.     DeleteDC MonoMaskDC
  1232.     DeleteDC MonoInvDC
  1233.     DeleteDC ResultDstDC
  1234.     DeleteDC ResultSrcDC
  1235.  
  1236.     If Refresh Then
  1237.         'refresh destination
  1238.         Destination.Refresh
  1239.     End If
  1240.     
  1241.     'return result
  1242.     If lReturn = 0 Then
  1243.         TransparentBltEx = False
  1244.     Else
  1245.         TransparentBltEx = True
  1246.     End If
  1247. End Function
  1248.  
  1249. Private Function HighlightBltEx(ByVal Source As Object, ByVal Destination, ByVal TempDestination As Object, ByVal Highlight As Object, ByVal HighlightColor As OLE_COLOR, Optional ByVal xDest As Long = 0, Optional ByVal yDest As Long = 0, Optional ByVal xSrc As Long = 0, Optional ByVal ySrc As Long = 0, Optional ByVal Width As Long = -1, Optional ByVal Height As Long = -1, Optional ByVal Refresh As Boolean = False) As Boolean
  1250.     'highlight entire graphic with HighlightColor
  1251.     Highlight.BackColor = HighlightColor
  1252.     
  1253.     Call MaskBltEx(Source, TempDestination, -1, 0, 0, xSrc, ySrc, Width, Height)
  1254.     Call BitBltEx(TempDestination, Highlight, roSrcInvert, 0, 0, 0, 0, Width, Height)
  1255.     Call TransparentBltEx(Highlight, Destination, -1, xDest, yDest, 0, 0, Width, Height, Refresh)
  1256. End Function
  1257.  
  1258. Private Function RaiseEventEx(ByVal Name As String, ParamArray Params() As Variant)
  1259.     'raise event with specified parameters
  1260.     'don't allow duplicate MouseEnter and MouseExit events
  1261.         
  1262.     Select Case Name
  1263.         Case "Click"
  1264.             'click event occurred
  1265.             RaiseEvent Click
  1266.         
  1267.         Case "KeyDown"
  1268.             'key down event occurred
  1269.             RaiseEvent KeyDown(CInt(Params(0)), CInt(Params(1)))
  1270.         
  1271.         Case "KeyPress"
  1272.             'key press event occurred
  1273.             RaiseEvent KeyPress(CInt(Params(0)))
  1274.         
  1275.         Case "KeyUp"
  1276.             'key up event occurred
  1277.             RaiseEvent KeyUp(CInt(Params(0)), CInt(Params(1)))
  1278.         
  1279.         Case "MouseDown"
  1280.             'mouse down event occurred
  1281.             RaiseEvent MouseDown(CInt(Params(0)), CInt(Params(1)), CSng(Params(2)), CSng(Params(3)))
  1282.         
  1283.         Case "MouseMove"
  1284.             'mouse move event occurred
  1285.             RaiseEvent MouseMove(CInt(Params(0)), CInt(Params(1)), CSng(Params(2)), CSng(Params(3)))
  1286.         
  1287.         Case "MouseUp"
  1288.             'mouse up event occurred
  1289.             RaiseEvent MouseUp(CInt(Params(0)), CInt(Params(1)), CSng(Params(2)), CSng(Params(3)))
  1290.         
  1291.         Case "MouseExit"
  1292.             'mouse exit event occurred
  1293.             If tPrevEvent <> "MouseExit" Then
  1294.                 RaiseEvent MouseExit
  1295.             End If
  1296.     
  1297.             'save previous event (for MouseEnter and MouseExit events)
  1298.             tPrevEvent = Name
  1299.         
  1300.         Case "MouseEnter"
  1301.             'mouse enter event occurred
  1302.             If tPrevEvent <> "MouseEnter" Then
  1303.                 RaiseEvent MouseEnter
  1304.             End If
  1305.     
  1306.             'save previous event (for MouseEnter and MouseExit events)
  1307.             tPrevEvent = Name
  1308.         
  1309.         Case "Resize"
  1310.             'resize event occurred
  1311.             RaiseEvent Resize
  1312.     End Select
  1313. End Function
  1314.  
  1315. Private Sub DrawButton(ByVal State As StateConstants)
  1316.     'draw button around control
  1317.     Dim bFocus As Boolean
  1318.     Dim bUserMode As Boolean
  1319.     
  1320.     'initialize variables
  1321.     bFocus = bHasFocus
  1322.     bUserMode = False
  1323.     Set UserControl.Picture = Nothing
  1324.     Set UserControl.MaskPicture = Nothing
  1325.     
  1326.     'clear control
  1327.     UserControl.Cls
  1328.     
  1329.     'get user mode
  1330.     On Local Error Resume Next
  1331.     bUserMode = UserControl.Ambient.UserMode
  1332.     On Local Error GoTo 0
  1333.     
  1334.     If m_Style = ButtonGroup Then
  1335.         'toggle button state
  1336.         If m_Value = Down Then
  1337.             State = btDown
  1338.         Else
  1339.             If State <> btOver Then
  1340.                 State = btUp
  1341.             End If
  1342.         End If
  1343.     End If
  1344.     
  1345.     If m_Appearance = Skin And Not (m_SkinUp Is Nothing) Then
  1346.         Call DrawSkin(State, bFocus And bUserMode)
  1347.     Else
  1348.         Call DrawStandard(State, bFocus And bUserMode)
  1349.     End If
  1350.     
  1351.     Call DrawPicture(State)
  1352.     Call DrawCaption(State)
  1353. End Sub
  1354.  
  1355. Private Sub DrawStandard(ByVal State As StateConstants, ByVal WithFocus As Boolean)
  1356.     'draw standard button (like CommandButton)
  1357.     Dim rct As RECT
  1358.     Dim lPrevColor As OLE_COLOR
  1359.     
  1360.     UserControl.BackStyle = 1
  1361.     
  1362.     'get rect
  1363.     With rct
  1364.         .Left = 0
  1365.         .Top = 0
  1366.         .Bottom = UserControl.ScaleHeight
  1367.         .Right = UserControl.ScaleWidth
  1368.     End With
  1369.     
  1370.     Select Case State
  1371.         Case btUp
  1372.             If m_Appearance = [3D] Then
  1373.                 'draw raised border
  1374.                 If WithFocus Then
  1375.                     Call DrawEdge(UserControl.hdc, rct, BDR_OUTER, BF_RECT Or BF_ADJUST Or BF_MONO)
  1376.                     Call DrawEdge(UserControl.hdc, rct, EDGE_RAISED, BF_RECT)
  1377.                 Else
  1378.                     Call DrawEdge(UserControl.hdc, rct, EDGE_RAISED, BF_RECT)
  1379.                 End If
  1380.             Else
  1381.                 WithFocus = False
  1382.             End If
  1383.         
  1384.         Case btOver
  1385.             'draw raised border
  1386.             If WithFocus Then
  1387.                 Call DrawEdge(UserControl.hdc, rct, BDR_OUTER, BF_RECT Or BF_ADJUST Or BF_MONO)
  1388.                 Call DrawEdge(UserControl.hdc, rct, EDGE_RAISED, BF_RECT)
  1389.             Else
  1390.                 Call DrawEdge(UserControl.hdc, rct, EDGE_RAISED, BF_RECT)
  1391.             End If
  1392.         
  1393.         Case btDown
  1394.             'draw sunken border
  1395.             If WithFocus Then
  1396.                 Call DrawEdge(UserControl.hdc, rct, BDR_OUTER, BF_RECT Or BF_ADJUST Or BF_MONO)
  1397.                 Call DrawEdge(UserControl.hdc, rct, BDR_SUNKENOUTER, BF_RECT Or BF_FLAT)
  1398.             Else
  1399.                 Call DrawEdge(UserControl.hdc, rct, EDGE_SUNKEN, BF_RECT)
  1400.             End If
  1401.     End Select
  1402.  
  1403.     If WithFocus Then
  1404.         'draw focus rect
  1405.         With rct
  1406.             .Left = clFocusOffset
  1407.             .Top = clFocusOffset
  1408.             .Bottom = UserControl.ScaleHeight - clFocusOffset
  1409.             .Right = UserControl.ScaleWidth - clFocusOffset
  1410.         End With
  1411.         
  1412.         lPrevColor = UserControl.ForeColor
  1413.         UserControl.ForeColor = vbBlack
  1414.         Call DrawFocusRect(UserControl.hdc, rct)
  1415.         UserControl.ForeColor = lPrevColor
  1416.     End If
  1417.     
  1418.     'set state
  1419.     lState = State
  1420. End Sub
  1421.  
  1422. Private Sub DrawSkin(ByVal State As StateConstants, ByVal WithFocus As Boolean)
  1423.     'draw button using skins
  1424.     
  1425.     'set state
  1426.     lState = State
  1427.     
  1428.     If Not m_Enabled Then
  1429.         State = btDisabled
  1430.         lState = State
  1431.     ElseIf WithFocus And State = btUp Then
  1432.         State = btFocus
  1433.     End If
  1434.  
  1435.     'set default picture
  1436.     UserControl.BackStyle = 0
  1437.     Set UserControl.Picture = m_SkinUp
  1438.     
  1439.     'set usercontrol picture
  1440.     Select Case State
  1441.         Case btDisabled
  1442.             If Not (m_SkinDisabled Is Nothing) Then
  1443.                 Set UserControl.Picture = m_SkinDisabled
  1444.             End If
  1445.         
  1446.         Case btDown
  1447.             If Not (m_SkinDown Is Nothing) Then
  1448.                 Set UserControl.Picture = m_SkinDown
  1449.             End If
  1450.         
  1451.         Case btUp
  1452.             Set UserControl.Picture = m_SkinUp
  1453.         
  1454.         Case btOver
  1455.             If Not (m_SkinOver Is Nothing) Then
  1456.                 Set UserControl.Picture = m_SkinOver
  1457.             End If
  1458.         
  1459.         Case btFocus
  1460.             If Not (m_SkinFocus Is Nothing) Then
  1461.                 Set UserControl.Picture = m_SkinFocus
  1462.             End If
  1463.     End Select
  1464.     
  1465.     If UserControl.Picture <> 0 Then
  1466.         'set mask picture
  1467.         Set UserControl.MaskPicture = UserControl.Picture
  1468.     
  1469.         'resize control
  1470.         UserControl.Width = UserControl.Picture.Width / 1.76
  1471.         UserControl.Height = UserControl.Picture.Height / 1.76
  1472.     End If
  1473. End Sub
  1474.  
  1475. Private Sub DrawCaption(ByVal State As StateConstants)
  1476.     'draw caption in button
  1477.     Dim lFormat As Long
  1478.     Dim lLeft As Long
  1479.     Dim lTop As Long
  1480.     
  1481.     'initialize variable
  1482.     UserControl.ForeColor = m_ForeColor
  1483.     
  1484.     Select Case State
  1485.         Case btOver
  1486.             UserControl.ForeColor = m_HighlightColor
  1487.         
  1488.         Case btDown
  1489.             If tPrevEvent <> "MouseExit" Then
  1490.                 UserControl.ForeColor = m_HighlightColor
  1491.             End If
  1492.     End Select
  1493.     
  1494.     'calculate caption position
  1495.     If State = btDown And Not (m_Picture Is Nothing) Then
  1496.         lLeft = -1
  1497.     Else
  1498.         lLeft = 0
  1499.     End If
  1500.     lTop = -1
  1501.     
  1502.     If imgPicture.Picture <> 0 Then
  1503.         lLeft = lLeft + imgPicture.Left + imgPicture.Width
  1504.         lLeft = (((UserControl.ScaleWidth + lLeft) \ 2) - (UserControl.TextWidth(m_Caption) \ 2))
  1505.     Else
  1506.         lLeft = lLeft + ((UserControl.ScaleWidth \ 2) - (UserControl.TextWidth(m_Caption) \ 2))
  1507.     End If
  1508.     
  1509.     lTop = lTop + ((UserControl.ScaleHeight \ 2) - (UserControl.TextHeight(m_Caption) \ 2))
  1510.     
  1511.     If State = btDown Then
  1512.         lLeft = lLeft + clDownOffset
  1513.         lTop = lTop + clDownOffset
  1514.     End If
  1515.     
  1516.     'draw caption in button
  1517.     lFormat = DST_PREFIXTEXT Or DSS_NORMAL
  1518.     If Not m_Enabled Then
  1519.         lFormat = lFormat Or DSS_DISABLED
  1520.     End If
  1521.     If m_RightToLeft Then
  1522.         lFormat = lFormat Or DSS_RIGHT
  1523.     End If
  1524.     
  1525.     Call DrawStateText(UserControl.hdc, 0, 0, m_Caption, Len(m_Caption), lLeft + m_CaptionOffsetX, lTop + m_CaptionOffsetY + clDownOffset, 0, 0, lFormat)
  1526. End Sub
  1527.  
  1528. Private Sub DrawPicture(ByVal State As StateConstants)
  1529.     'draw picture on button
  1530.     Dim lLeft As Long
  1531.     Dim lTop As Long
  1532.     Dim ptDest As POINTAPI
  1533.     Dim ptSrc As POINTAPI
  1534.     
  1535.     'set default picture
  1536.     Set imgPicture.Picture = m_Picture
  1537.     
  1538.     'set usercontrol picture
  1539.     Select Case State
  1540.         Case btDisabled
  1541.             If Not (m_PictureDisabled Is Nothing) Then
  1542.                 Set imgPicture.Picture = m_PictureDisabled
  1543.             End If
  1544.         
  1545.         Case btDown
  1546.             If Not (m_PictureDown Is Nothing) Then
  1547.                 Set imgPicture.Picture = m_PictureDown
  1548.             End If
  1549.         
  1550.         Case btUp
  1551.             Set imgPicture.Picture = m_Picture
  1552.         
  1553.         Case btOver
  1554.             If Not (m_PictureOver Is Nothing) Then
  1555.                 Set imgPicture.Picture = m_PictureOver
  1556.             End If
  1557.  
  1558.         Case btFocus
  1559.             If Not (m_PictureFocus Is Nothing) Then
  1560.                 Set imgPicture.Picture = m_PictureFocus
  1561.             End If
  1562.     End Select
  1563.     
  1564. '    If m_Enabled Then
  1565. '        Set imgPicture.Picture = m_Picture
  1566. '    Else
  1567. '        If Not (m_PictureDisabled Is Nothing) Then
  1568. '            Set imgPicture.Picture = m_PictureDisabled
  1569. '        Else
  1570. '            Set imgPicture.Picture = m_Picture
  1571. '
  1572. '
  1573. '            Dim X As Long
  1574. '            Dim Y As Long
  1575. '            For X = 0 To imgPicture.ScaleWidth
  1576. '                For Y = 0 To imgPicture.ScaleHeight
  1577. '
  1578. '                    Select Case imgPicture.Point(X, Y)
  1579. '
  1580. '                    Case 16777215, &HC0C0C0
  1581. '
  1582. '                        imgPicture.PSet (X, Y), &HC0C0C0
  1583. '
  1584. '                    Case 0 To &H808080, 0
  1585. '
  1586. '                        imgPicture.PSet (X, Y), &H808080
  1587. '
  1588. '                    Case &H808080 To &HFF0000
  1589. '
  1590. '                        imgPicture.PSet (X, Y), &HC0C0C1
  1591. '
  1592. '                    Case &HFF0000 To &HFFFFFF
  1593. '
  1594. '                        imgPicture.PSet (X, Y), &HE0E0E0
  1595. '
  1596. '                    End Select
  1597. '                Next
  1598. '            Next
  1599. '
  1600. '
  1601. '        End If
  1602. '    End If
  1603.  
  1604.     'move image
  1605.     With imgPicture
  1606.         If .Picture <> 0 Then
  1607.             If m_Appearance = Skin Then
  1608.                 lLeft = 0
  1609.                 lTop = (UserControl.ScaleHeight \ 2) - (.Height \ 2)
  1610.                 If lTop < 0 Then
  1611.                     lTop = 0
  1612.                 End If
  1613.             Else
  1614.                 lLeft = clLeft
  1615.                 lTop = (UserControl.ScaleHeight \ 2) - (.Height \ 2)
  1616.                 If lTop < clTop Then
  1617.                     lTop = clTop
  1618.                 End If
  1619.             End If
  1620.             
  1621.             If State = btDown Then
  1622.                 lLeft = lLeft + clDownOffset
  1623.                 lTop = lTop + clDownOffset
  1624.             End If
  1625.         
  1626.             lLeft = lLeft + m_PictureOffsetX
  1627.             lTop = lTop + m_PictureOffsetY
  1628.             
  1629.             If .Left <> lLeft Then
  1630.                 .Left = lLeft
  1631.             End If
  1632.             If .Top <> lTop Then
  1633.                 .Top = lTop
  1634.             End If
  1635.         
  1636.             ptDest.X = .Left
  1637.             ptDest.Y = .Top
  1638.             ptSrc.X = 0
  1639.             ptSrc.Y = 0
  1640.             
  1641.             If (State = btDown Or State = btOver Or (Not m_Enabled And State = btUp)) And m_HighlightPicture = True Then
  1642.                 If m_Enabled Then
  1643.                     Call HighlightBltEx(imgPicture, UserControl, pictTempDestination, pictTempHighlight, m_HighlightColor, .Left, .Top, 0, 0, .Width, .Height)
  1644.                 Else
  1645.                     Call HighlightBltEx(imgPicture, UserControl, pictTempDestination, pictTempHighlight, vbGrayText, .Left, .Top, 0, 0, .Width, .Height)
  1646.                 End If
  1647.             Else
  1648.                 Call TransparentBlt_New2(UserControl.hdc, imgPicture, ptDest, ptSrc, imgPicture.Width, imgPicture.Height, m_TransparentColor)
  1649.             End If
  1650.         End If
  1651.     End With
  1652. End Sub
  1653.  
  1654.