home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 6_2008-2009.ISO / data / zips / MM_CheckBo214306272009.psc / mon_advanced_checkbox.ctl < prev    next >
Text File  |  2009-02-07  |  23KB  |  666 lines
  1. VERSION 5.00
  2. Begin VB.UserControl mm_checkbox 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00FFFFFF&
  5.    ClientHeight    =   1110
  6.    ClientLeft      =   0
  7.    ClientTop       =   0
  8.    ClientWidth     =   2055
  9.    ClipBehavior    =   0  'None
  10.    BeginProperty Font 
  11.       Name            =   "Tahoma"
  12.       Size            =   8.25
  13.       Charset         =   0
  14.       Weight          =   400
  15.       Underline       =   0   'False
  16.       Italic          =   0   'False
  17.       Strikethrough   =   0   'False
  18.    EndProperty
  19.    KeyPreview      =   -1  'True
  20.    ScaleHeight     =   74
  21.    ScaleMode       =   3  'Pixel
  22.    ScaleWidth      =   137
  23.    ToolboxBitmap   =   "mon_advanced_checkbox.ctx":0000
  24.    Begin VB.PictureBox pic_des_small_uncheck_avec_caption 
  25.       AutoRedraw      =   -1  'True
  26.       AutoSize        =   -1  'True
  27.       BorderStyle     =   0  'None
  28.       Height          =   225
  29.       Left            =   1530
  30.       Picture         =   "mon_advanced_checkbox.ctx":0312
  31.       ScaleHeight     =   225
  32.       ScaleWidth      =   375
  33.       TabIndex        =   5
  34.       Top             =   1815
  35.       Width           =   375
  36.    End
  37.    Begin VB.PictureBox pic_des_small_check_avec_caption 
  38.       AutoRedraw      =   -1  'True
  39.       AutoSize        =   -1  'True
  40.       BorderStyle     =   0  'None
  41.       Height          =   225
  42.       Left            =   1035
  43.       Picture         =   "mon_advanced_checkbox.ctx":07C8
  44.       ScaleHeight     =   225
  45.       ScaleWidth      =   375
  46.       TabIndex        =   4
  47.       Top             =   1800
  48.       Width           =   375
  49.    End
  50.    Begin VB.PictureBox picarcsmall 
  51.       AutoRedraw      =   -1  'True
  52.       AutoSize        =   -1  'True
  53.       BorderStyle     =   0  'None
  54.       Height          =   225
  55.       Left            =   630
  56.       Picture         =   "mon_advanced_checkbox.ctx":0C7E
  57.       ScaleHeight     =   225
  58.       ScaleWidth      =   45
  59.       TabIndex        =   3
  60.       Top             =   720
  61.       Visible         =   0   'False
  62.       Width           =   45
  63.    End
  64.    Begin VB.PictureBox picarc 
  65.       AutoRedraw      =   -1  'True
  66.       AutoSize        =   -1  'True
  67.       BorderStyle     =   0  'None
  68.       Height          =   435
  69.       Left            =   1530
  70.       Picture         =   "mon_advanced_checkbox.ctx":0D74
  71.       ScaleHeight     =   435
  72.       ScaleWidth      =   105
  73.       TabIndex        =   2
  74.       Top             =   180
  75.       Visible         =   0   'False
  76.       Width           =   105
  77.    End
  78.    Begin VB.PictureBox picbig 
  79.       Appearance      =   0  'Flat
  80.       AutoRedraw      =   -1  'True
  81.       AutoSize        =   -1  'True
  82.       BackColor       =   &H80000005&
  83.       BorderStyle     =   0  'None
  84.       ForeColor       =   &H80000008&
  85.       Height          =   435
  86.       Left            =   780
  87.       Picture         =   "mon_advanced_checkbox.ctx":106E
  88.       ScaleHeight     =   435
  89.       ScaleWidth      =   720
  90.       TabIndex        =   1
  91.       Top             =   180
  92.       Visible         =   0   'False
  93.       Width           =   720
  94.    End
  95.    Begin VB.PictureBox picsmall 
  96.       Appearance      =   0  'Flat
  97.       AutoRedraw      =   -1  'True
  98.       AutoSize        =   -1  'True
  99.       BackColor       =   &H80000005&
  100.       BorderStyle     =   0  'None
  101.       ForeColor       =   &H80000008&
  102.       Height          =   225
  103.       Left            =   225
  104.       Picture         =   "mon_advanced_checkbox.ctx":2100
  105.       ScaleHeight     =   225
  106.       ScaleWidth      =   345
  107.       TabIndex        =   0
  108.       Top             =   750
  109.       Visible         =   0   'False
  110.       Width           =   345
  111.    End
  112.    Begin VB.Image pic_des_big_check_avec_caption 
  113.       Height          =   435
  114.       Left            =   120
  115.       Picture         =   "mon_advanced_checkbox.ctx":257A
  116.       Top             =   2730
  117.       Width           =   780
  118.    End
  119.    Begin VB.Image pic_des_big_uncheck_avec_caption 
  120.       Height          =   435
  121.       Left            =   945
  122.       Picture         =   "mon_advanced_checkbox.ctx":3768
  123.       Top             =   2745
  124.       Width           =   780
  125.    End
  126.    Begin VB.Image pic_des_small_check 
  127.       Height          =   225
  128.       Left            =   210
  129.       Picture         =   "mon_advanced_checkbox.ctx":4956
  130.       Top             =   1785
  131.       Width           =   345
  132.    End
  133.    Begin VB.Image pic_des_small_uncheck 
  134.       Height          =   225
  135.       Left            =   600
  136.       Picture         =   "mon_advanced_checkbox.ctx":4DD0
  137.       Top             =   1800
  138.       Width           =   345
  139.    End
  140.    Begin VB.Image pic_des_big_uncheck 
  141.       Height          =   435
  142.       Left            =   915
  143.       Picture         =   "mon_advanced_checkbox.ctx":524A
  144.       Top             =   2130
  145.       Width           =   720
  146.    End
  147.    Begin VB.Image pic_des_big_check 
  148.       Height          =   435
  149.       Left            =   135
  150.       Picture         =   "mon_advanced_checkbox.ctx":62DC
  151.       Top             =   2115
  152.       Width           =   720
  153.    End
  154. End
  155. Attribute VB_Name = "mm_checkbox"
  156. Attribute VB_GlobalNameSpace = False
  157. Attribute VB_Creatable = True
  158. Attribute VB_PredeclaredId = False
  159. Attribute VB_Exposed = True
  160. Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
  161. Option Explicit
  162.  
  163. 'EVENTS.
  164. Public Event Click()
  165. Public Event DoubleClick()
  166. Public Event KeyDown(KeyCode As Integer, Shift As Integer)
  167. Public Event KeyPress(KeyAscii As Integer)
  168. Public Event KeyUp(KeyCode As Integer, Shift As Integer)
  169. Public Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  170. Public Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  171. Public Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  172. Public Event MouseEnters(ByVal X As Long, ByVal Y As Long)
  173. Public Event MouseLeaves(ByVal X As Long, ByVal Y As Long)
  174.  
  175.  
  176. Private udtPoint As POINTAPI
  177. Private bolMouseDown As Boolean
  178. Private bolMouseOver As Boolean
  179. 'Private bolHasFocus As Boolean
  180. Private bolEnabled As Boolean
  181. Private bolChecked As Boolean
  182. Private bolSmall As Boolean
  183. Private lonRoundValue As Long
  184. Private lonRect As Long
  185. Private button_clique As Integer
  186.  
  187. Private Type POINTAPI
  188.         X As Long
  189.         Y As Long
  190. End Type
  191. Private Type RECT
  192.         Left As Long
  193.         Top As Long
  194.         Right As Long
  195.         Bottom As Long
  196. End Type
  197.  
  198. Dim mon_rect As RECT
  199.  
  200. Private Declare Function CreateRoundRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
  201. Private Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long
  202. Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
  203. Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
  204. Private Declare Function RoundRect Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long, ByVal X3 As Long, ByVal Y3 As Long) As Long
  205. Private Declare Function SetRect Lib "user32" (lpRect As RECT, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  206.  
  207. Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
  208. Private Declare Function ReleaseCapture Lib "user32" () As Long
  209.  
  210.  
  211. 'pour le gradient (le petit circle)
  212. Dim AA1 As New LineGS 'DrawRadial
  213.  
  214. Private m_Activecolor As OLE_COLOR
  215. Private m_desActivecolor As OLE_COLOR
  216. Private m_Caption As String
  217. Private fntFont As Font 'Caption font.
  218. Private m_CaptionColor As OLE_COLOR
  219.  
  220.  
  221. Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
  222. Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long, ByVal dwRop As Long) As Long
  223.  
  224. 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
  225. Private Const DT_WORDBREAK = &H10
  226. Private Const DT_CENTER = &H1 Or DT_WORDBREAK Or &H4
  227.  
  228. Sub mon_gradient(mcolor As Long, X As Integer, Y As Integer, iCircle As Integer)
  229.    Dim I As Integer
  230.        
  231.    'UserControl.Cls
  232.    UserControl.DrawStyle = 5
  233.    UserControl.FillStyle = 0
  234.                                                       '|                                            |
  235.     
  236.       With UserControl
  237.          'Copier DIBits dans un array
  238.          AA1.DIB .hdc, .Image.Handle, .ScaleWidth, .ScaleHeight
  239.       End With
  240.    
  241.    '1er cercle en gris
  242.     If Not Small Then
  243.         'bordure
  244.         'For I = 1 To 2
  245.         '    AA1.CircleDIB UserControl.ScaleWidth / 2, UserControl.ScaleHeight / 2, UserControl.ScaleWidth - 28 - I, UserControl.ScaleHeight - 15 - I, vbWhite '&HDAD4CE
  246.         'Next I
  247.         For I = 5 To 6
  248.             'AA1.DIB .hdc, .Image.Handle, .ScaleWidth, .ScaleHeight
  249.             AA1.CircleDIB X, Y, iCircle + I, iCircle + I, &HDAD4CE  'RGB(128, 128, 128) 'vbRed ''100, 100, I * 0.75, I * 0.75, vbRed
  250.             'AA1.Array2Pic
  251.         Next I
  252.     Else
  253.         'For I = 3 To 4
  254.             AA1.CircleDIB X, Y, iCircle + 3, iCircle + 3, &HDAD4CE  'RGB(128, 128, 128) 'vbRed ''100, 100, I * 0.75, I * 0.75, vbRed
  255.             'AA1.Array2Pic
  256.         'Next I
  257.     End If
  258.    
  259. '    'simulate a circle with blendcolor
  260.     AA1.CircleDIB X, Y, iCircle + 1, iCircle + 1, BlendColor(mcolor, vbWhite, 100) '&HDAD4CE    'RGB(128, 128, 128) 'vbRed ''100, 100, I * 0.75, I * 0.75, vbRed
  261.     AA1.CircleDIB X, Y, iCircle + 2, iCircle + 2, BlendColor(mcolor, vbWhite, 50) '&HDAD4CE    'RGB(128, 128, 128) 'vbRed ''100, 100, I * 0.75, I * 0.75, vbRed
  262.  
  263.       For I = iCircle To 0 Step -1
  264.         AA1.CircleDIB X, Y, I, I, BlendColor(mcolor, vbWhite, I * (255 / iCircle))
  265.      Next I
  266.      
  267.      'refresh picture for usercontrol
  268.       AA1.Array2Pic
  269.       
  270. End Sub
  271.  
  272. Public Sub About()
  273. Attribute About.VB_UserMemId = -552
  274.     dlgAbout.Show 1
  275. End Sub
  276.  
  277.  
  278. Private Function PointInControl(X As Single, Y As Single) As Boolean
  279.   If X >= 0 And X <= UserControl.ScaleWidth And _
  280.     Y >= 0 And Y <= UserControl.ScaleHeight Then
  281.     PointInControl = True
  282.   End If
  283. End Function
  284.  
  285. Private Sub PaintControl()
  286.     
  287. Dim rc As RECT
  288.  
  289.     UserControl.Refresh
  290.     UserControl.Picture = LoadPicture("")
  291.     UserControl.Refresh
  292.     UserControl.Cls
  293.     
  294.     'If bolEnabled Then
  295.         pic_des_small_check.Top = -200
  296.         pic_des_small_uncheck.Top = -200
  297.         pic_des_big_check.Top = -200
  298.         pic_des_big_uncheck.Top = -200
  299.         pic_des_small_check_avec_caption.Top = -200
  300.         pic_des_small_uncheck_avec_caption.Top = -200
  301.         pic_des_big_uncheck_avec_caption.Top = -200
  302.         pic_des_big_check_avec_caption.Top = -200
  303.         
  304.     'Else
  305.     If Not bolEnabled Then
  306.         If bolSmall Then
  307.             If Checked Then
  308.                 If m_Caption <> "" Then
  309.                     pic_des_small_check_avec_caption.Top = 0
  310.                     pic_des_small_check_avec_caption.Left = 0
  311.                 Else
  312.                     pic_des_small_check.Top = 0
  313.                     pic_des_small_check.Left = 0
  314.                 End If
  315.             Else
  316.                 If m_Caption <> "" Then
  317.                     pic_des_small_uncheck_avec_caption.Top = 0
  318.                     pic_des_small_uncheck_avec_caption.Left = 0
  319.                 Else
  320.                     pic_des_small_uncheck.Top = 0
  321.                     pic_des_small_uncheck.Left = 0
  322.                 End If
  323.             End If
  324.         Else
  325.             If Checked Then
  326.                 If m_Caption <> "" Then
  327.                     pic_des_big_check_avec_caption.Top = 0
  328.                     pic_des_big_check_avec_caption.Left = 0
  329.                 Else
  330.                     pic_des_big_check.Top = 0
  331.                     pic_des_big_check.Left = 0
  332.                 End If
  333.             Else
  334.                 If m_Caption <> "" Then
  335.                     pic_des_big_uncheck_avec_caption.Top = 0
  336.                     pic_des_big_uncheck_avec_caption.Left = 0
  337.                 Else
  338.                     pic_des_big_uncheck.Top = 0
  339.                     pic_des_big_uncheck.Left = 0
  340.                 End If
  341.             End If
  342.         End If
  343.     End If
  344.     '-----------------------------------------
  345.     
  346.     If Small Then
  347.         UserControl_Resize
  348.         UserControl.Cls
  349.         If m_Caption <> "" Then
  350.             'Center stretch
  351.             StretchBlt UserControl.hdc, 0, 0, ScaleWidth, ScaleHeight, picsmall.hdc, 5, 0, 1, ScaleHeight, vbSrcCopy
  352.             'Left
  353.             'StretchBlt UserControl.hdc, 0, 0, 10, ScaleHeight, picsmall.hdc, 0, 0, 10, ScaleHeight, vbSrcCopy
  354.             BitBlt UserControl.hdc, 0, 0, 6, ScaleHeight, picsmall.hdc, 0, 0, vbSrcCopy
  355.             'Right
  356.             BitBlt UserControl.hdc, ScaleWidth - 10, 0, 9, ScaleHeight, picsmall.hdc, picsmall.Width - 9, 0, vbSrcCopy
  357.             'end of checkbox
  358.             If bolEnabled Then BitBlt UserControl.hdc, picsmall.Width - 1, 0, picarcsmall.Width, ScaleHeight, picarcsmall.hdc, 0, 0, vbSrcCopy
  359.             'draw caption
  360.             rc.Left = picsmall.Width + 6: rc.Top = (picsmall.Height - (picsmall.TextHeight("-") / Screen.TwipsPerPixelY)) / 2 '8
  361.             rc.Right = UserControl.ScaleWidth: rc.Bottom = UserControl.ScaleHeight
  362.             If bolEnabled Then
  363.                 UserControl.ForeColor = m_CaptionColor 'm_Activecolor
  364.             Else
  365.                 UserControl.ForeColor = vbGrayText
  366.             End If
  367.             DrawText UserControl.hdc, m_Caption, Len(m_Caption), rc, 0 ', DT_CENTER
  368.         Else
  369.             UserControl.Picture = picsmall.Picture
  370.         End If
  371.         
  372.         UserControl.Refresh
  373.         
  374.         If Checked Then
  375.             mon_gradient m_Activecolor, 7, (UserControl.ScaleHeight / 2) - 1, 3
  376.         Else
  377.             mon_gradient m_desActivecolor, picsmall.Width - 8, (UserControl.ScaleHeight / 2) - 1, 3 '6
  378.         End If
  379.     Else
  380.         UserControl_Resize
  381.         UserControl.Cls
  382.         If m_Caption <> "" Then
  383.             'center stretch
  384.             StretchBlt UserControl.hdc, 0, 0, ScaleWidth, ScaleHeight, picbig.hdc, 20, 0, 2, ScaleHeight, vbSrcCopy
  385.             'Left
  386.             BitBlt UserControl.hdc, 0, 0, 15, ScaleHeight, picbig.hdc, 0, 0, vbSrcCopy
  387.             'Right
  388.             BitBlt UserControl.hdc, ScaleWidth - 16, 0, 15, ScaleHeight, picbig.hdc, picbig.Width - 15, 0, vbSrcCopy
  389.             'End of checkbox
  390.             If bolEnabled Then BitBlt UserControl.hdc, picbig.Width - 3, 0, picarc.Width, ScaleHeight, picarc.hdc, 0, 0, vbSrcCopy
  391.             'draw caption
  392.             rc.Left = picbig.Width + 8: rc.Top = (picbig.Height - (picbig.TextHeight("-") / Screen.TwipsPerPixelY)) / 2 '8 'picbig.Height / 2
  393.             rc.Right = UserControl.ScaleWidth: rc.Bottom = UserControl.ScaleHeight
  394.             If bolEnabled Then
  395.                 UserControl.ForeColor = m_CaptionColor 'm_Activecolor
  396.             Else
  397.                 UserControl.ForeColor = vbGrayText 'vbButtonShadow
  398.             End If
  399.             DrawText UserControl.hdc, m_Caption, Len(m_Caption), rc, 0 ', DT_CENTER
  400.         Else
  401.             UserControl.Picture = picbig.Picture
  402.         End If
  403.         
  404.         UserControl.Refresh
  405.         
  406.         If Checked Then
  407.             mon_gradient m_Activecolor, 15, (UserControl.ScaleHeight / 2) - 1, 8
  408.         Else
  409.             mon_gradient m_desActivecolor, picbig.Width - 16, (picbig.Height / 2) - 1, 8 '9
  410.         End If
  411.     
  412.     End If
  413.     
  414. End Sub
  415.  
  416. Public Property Get Activecolor() As OLE_COLOR
  417.    Activecolor = m_Activecolor
  418. End Property
  419. Public Property Get CaptionColor() As OLE_COLOR
  420.    CaptionColor = m_CaptionColor
  421. End Property
  422. Public Property Get desActivecolor() As OLE_COLOR
  423.    desActivecolor = m_desActivecolor
  424. End Property
  425. Public Property Let Activecolor(ByVal New_Activecolor As OLE_COLOR)
  426.    m_Activecolor = New_Activecolor
  427.    PropertyChanged "Activecolor"
  428.    PaintControl
  429. End Property
  430. Public Property Let CaptionColor(ByVal New_CaptionColor As OLE_COLOR)
  431.    m_CaptionColor = New_CaptionColor
  432.    PropertyChanged "CaptionColor"
  433.    PaintControl
  434. End Property
  435. Public Property Get Font() As Font
  436. Set Font = fntFont
  437. End Property
  438. Public Property Set Font(ByVal NewValue As Font)
  439. Set fntFont = NewValue
  440. Set UserControl.Font = NewValue
  441.  
  442. Set picbig.Font = UserControl.Font
  443. Set picsmall.Font = UserControl.Font
  444.  
  445.  
  446. PropertyChanged "Font"
  447. PaintControl
  448. End Property
  449. Public Property Let desActivecolor(ByVal New_desActivecolor As OLE_COLOR)
  450.    m_desActivecolor = New_desActivecolor
  451.    PropertyChanged "desActivecolor"
  452.    PaintControl
  453. End Property
  454. Public Property Get Enabled() As Boolean
  455. Attribute Enabled.VB_Description = "Button Enabled/Disable."
  456. Enabled = bolEnabled
  457. End Property
  458.  
  459.  
  460. Public Property Get Small() As Boolean
  461. Small = bolSmall
  462. End Property
  463. Public Property Get Checked() As Boolean
  464. Checked = bolChecked
  465. End Property
  466.  
  467. Public Property Let Enabled(ByVal NewValue As Boolean)
  468. bolEnabled = NewValue
  469. PropertyChanged "Enabled"
  470.  
  471. UserControl.Enabled = bolEnabled
  472.  
  473. PaintControl
  474. End Property
  475.  
  476.  
  477. Public Property Let Small(ByVal NewValue As Boolean)
  478. bolSmall = NewValue
  479. PropertyChanged "Small"
  480.  
  481. PaintControl
  482.  
  483.  
  484. If Small = True Then
  485.     RoundedValue = 9 '10
  486. Else
  487.     RoundedValue = 26
  488. End If
  489.  
  490.  
  491. End Property
  492. Public Property Let Checked(ByVal NewValue As Boolean)
  493. bolChecked = NewValue
  494. PropertyChanged "Checked"
  495.  
  496. PaintControl
  497.  
  498.  
  499. End Property
  500. Public Property Get RoundedValue() As Long
  501. Attribute RoundedValue.VB_Description = "Button Border Rounded Value."
  502. RoundedValue = lonRoundValue
  503. End Property
  504.  
  505. Public Property Let RoundedValue(ByVal NewValue As Long)
  506.  
  507.  
  508. lonRoundValue = NewValue
  509. PropertyChanged "RoundedValue"
  510.  
  511.  
  512. UserControl_Resize
  513.  
  514. End Property
  515.  
  516. Private Sub UserControl_Click()
  517. If bolEnabled = True Then
  518.     If button_clique = 1 Then
  519.         
  520.         Checked = Not Checked
  521.         'PaintControl
  522.         
  523.         RaiseEvent Click
  524.         RaiseEvent MouseLeaves(0, 0)
  525.     End If
  526. End If
  527. End Sub
  528.  
  529. Private Sub UserControl_Initialize()
  530. m_Activecolor = &H8000&
  531. m_desActivecolor = &H808080
  532. m_Caption = ""
  533. m_CaptionColor = vbBlack
  534. End Sub
  535.  
  536. Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  537. If bolEnabled = True Then
  538.     button_clique = Button
  539.     If Button = 1 Then
  540.         bolMouseDown = True
  541.         RaiseEvent MouseDown(Button, Shift, X, Y)
  542. '        PaintControl
  543.     End If
  544. End If
  545.  
  546. End Sub
  547. Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  548.     If bolEnabled = False Then Exit Sub
  549.     RaiseEvent MouseMove(Button, Shift, X, Y)
  550.     SetCapture hWnd
  551.     If PointInControl(X, Y) Then
  552.         'pointer on control
  553.         If Not bolMouseOver Then
  554.             bolMouseOver = True
  555.             RaiseEvent MouseEnters(udtPoint.X, udtPoint.Y)
  556.         End If
  557.     Else
  558.         'pointer out of control
  559.         bolMouseOver = False
  560.         bolMouseDown = False
  561.         ReleaseCapture
  562.         RaiseEvent MouseLeaves(udtPoint.X, udtPoint.Y)
  563.     End If
  564. End Sub
  565.  
  566. Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  567. If bolEnabled = True Then
  568.     button_clique = Button
  569.     If Button = 1 Then
  570.         RaiseEvent MouseUp(Button, Shift, X, Y)
  571.         bolMouseDown = False
  572.     End If
  573. End If
  574. End Sub
  575.  
  576. Private Sub UserControl_Paint()
  577. 'PaintControl
  578. End Sub
  579.  
  580. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  581. 'On Error Resume Next
  582. With PropBag
  583.     
  584.     Let Enabled = .ReadProperty("Enabled", True)
  585.     Let Checked = .ReadProperty("Checked", False)
  586.     Let Small = .ReadProperty("Small", True)
  587.     Let RoundedValue = .ReadProperty("RoundedValue", 5)
  588.     Let Activecolor = .ReadProperty("Activecolor", m_Activecolor) ' &H117B28) 'vbGreen)
  589.     Let desActivecolor = .ReadProperty("desActivecolor", m_desActivecolor) ' &H117B28) 'vbGreen)
  590.     
  591.     Let Caption = .ReadProperty("Caption", "")
  592.     Set Font = .ReadProperty("Font", Ambient.Font)
  593.     Let CaptionColor = .ReadProperty("CaptionColor", m_CaptionColor)
  594. End With
  595. End Sub
  596. Private Sub UserControl_Resize()
  597.     
  598.     If Small Then
  599.         'UserControl.Width = (picsmall.Width + 1) * Screen.TwipsPerPixelX
  600.         If m_Caption <> "" Then
  601.             UserControl.Width = ((picsmall.Width + 1) * Screen.TwipsPerPixelX) + (picsmall.TextWidth(m_Caption) + 300)
  602.         Else
  603.             UserControl.Width = (picsmall.Width + 1) * Screen.TwipsPerPixelX '* 2
  604.         End If
  605.         UserControl.Height = (picsmall.Height + 1) * Screen.TwipsPerPixelY
  606.     Else
  607.         If m_Caption <> "" Then
  608.             UserControl.Width = ((picbig.Width + 1) * Screen.TwipsPerPixelX) + (picbig.TextWidth(m_Caption) + 300)
  609.         Else
  610.             UserControl.Width = (picbig.Width + 1) * Screen.TwipsPerPixelX '* 2
  611.         End If
  612.         UserControl.Height = (picbig.Height + 1) * Screen.TwipsPerPixelY
  613.     End If
  614.     
  615.  
  616. lonRect = CreateRoundRectRgn(0, 0, ScaleWidth, ScaleHeight, lonRoundValue, lonRoundValue)     '- 1
  617. SetWindowRgn UserControl.hWnd, lonRect, True
  618.  
  619.  
  620.  
  621. End Sub
  622.  
  623. Private Sub UserControl_Terminate()
  624. bolMouseDown = False
  625. bolMouseOver = False
  626. 'bolHasFocus = False
  627. 'UserControl.Cls
  628. End Sub
  629. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  630. 'On Error Resume Next
  631. With PropBag
  632.     .WriteProperty "Enabled", bolEnabled, True
  633.     .WriteProperty "Checked", bolChecked, False
  634.     .WriteProperty "Small", bolSmall, True
  635.     .WriteProperty "RoundedValue", lonRoundValue, 5
  636.     .WriteProperty "Activecolor", m_Activecolor, &H8000& '&H117B28 'vbGreen
  637.     .WriteProperty "desActivecolor", m_desActivecolor, &H808080 '&H94A392
  638.     
  639.     .WriteProperty "Caption", m_Caption, ""
  640.     .WriteProperty "Font", fntFont, Ambient.Font
  641.     .WriteProperty "CaptionColor", m_CaptionColor, vbBlack
  642. End With
  643. End Sub
  644. Private Sub UserControl_InitProperties()
  645. Let Enabled = True
  646. Let Checked = False
  647. Let Small = False 'True
  648. Let RoundedValue = 27 '26 '5
  649.  
  650. m_Activecolor = &H8000&
  651. m_desActivecolor = &H808080
  652. m_CaptionColor = vbBlack
  653. Set Font = UserControl.Font '"tahoma" 'Ambient.Font
  654.  
  655. End Sub
  656.  
  657. Public Property Get Caption() As String
  658. Caption = m_Caption
  659. End Property
  660.  
  661. Public Property Let Caption(ByVal New_Caption As String)
  662.    m_Caption = New_Caption
  663.    PropertyChanged "Caption"
  664.    PaintControl
  665. End Property
  666.