home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 5_2007-2008.ISO / data / Zips / My_ucContr2093141282007.psc / CheckBoxTrans.ctl < prev    next >
Text File  |  2006-11-26  |  10KB  |  285 lines
  1. VERSION 5.00
  2. Begin VB.UserControl CkBx 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00FF24FF&
  5.    BackStyle       =   0  'Transparent
  6.    ClientHeight    =   375
  7.    ClientLeft      =   0
  8.    ClientTop       =   0
  9.    ClientWidth     =   4350
  10.    MaskColor       =   &H00FF24FF&
  11.    ScaleHeight     =   375
  12.    ScaleWidth      =   4350
  13.    ToolboxBitmap   =   "CheckBoxTrans.ctx":0000
  14.    Begin VB.Image imgGrayChecked 
  15.       Height          =   240
  16.       Left            =   2190
  17.       Picture         =   "CheckBoxTrans.ctx":0312
  18.       Top             =   2805
  19.       Width           =   240
  20.    End
  21.    Begin VB.Image imgGrayUnChecked 
  22.       Height          =   240
  23.       Left            =   1860
  24.       Picture         =   "CheckBoxTrans.ctx":089C
  25.       Top             =   2805
  26.       Width           =   240
  27.    End
  28.    Begin VB.Image imgBlueCheck 
  29.       Height          =   240
  30.       Left            =   1530
  31.       Picture         =   "CheckBoxTrans.ctx":0E26
  32.       Top             =   2805
  33.       Width           =   240
  34.    End
  35.    Begin VB.Image imgStore 
  36.       Height          =   375
  37.       Left            =   135
  38.       Top             =   2820
  39.       Width           =   270
  40.    End
  41.    Begin VB.Image imgGreenCheck 
  42.       Height          =   240
  43.       Left            =   1185
  44.       Picture         =   "CheckBoxTrans.ctx":13B0
  45.       Top             =   2805
  46.       Width           =   240
  47.    End
  48.    Begin VB.Image imgRedCheck 
  49.       Height          =   240
  50.       Left            =   795
  51.       Picture         =   "CheckBoxTrans.ctx":193A
  52.       Top             =   2805
  53.       Width           =   240
  54.    End
  55.    Begin VB.Image imgBlankCheck 
  56.       Height          =   240
  57.       Left            =   435
  58.       Picture         =   "CheckBoxTrans.ctx":1EC4
  59.       Top             =   2805
  60.       Width           =   240
  61.    End
  62. End
  63. Attribute VB_Name = "CkBx"
  64. Attribute VB_GlobalNameSpace = False
  65. Attribute VB_Creatable = True
  66. Attribute VB_PredeclaredId = False
  67. Attribute VB_Exposed = False
  68. Option Explicit
  69.  
  70. '*******************************************************************
  71. '**                            Transparent CheckBox
  72. '**                               Version 1.0.0
  73. '**                               By Ken Foster
  74. '**                                August 2005
  75. '**                     Freeware--- no copyrights claimed
  76. '*******************************************************************
  77.  
  78. Private Declare Function DrawTextEx Lib "user32" Alias "DrawTextExA" (ByVal hdc As Long, _
  79.      ByVal lpsz As String, ByVal n As Long, lpRect As RECT, ByVal un As Long, _
  80.      ByVal lpDrawTextParams As Any) As Long
  81. Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, _
  82.      ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
  83.      
  84. Private Type RECT
  85.     Left As Long
  86.     Top As Long
  87.     Right As Long
  88.     Bottom As Long
  89. End Type
  90.  
  91. Enum eCheckColor
  92.    Red = 0
  93.    Green = 1
  94.    Blue = 2
  95. End Enum
  96.  
  97. Enum eValue
  98.    Unchecked = 0
  99.    Checked = 1
  100. End Enum
  101.  
  102.  
  103. Const m_def_Caption = "CkBox"
  104. Const m_def_CheckColor = 0
  105. Const m_def_Enabled = True
  106. Const m_def_Value = 0
  107.  
  108. Private m_CaptionRect As RECT
  109. Private m_Flag As Long
  110. Private m_CheckColor As Integer
  111. Private m_Caption As String
  112. Private m_Enabled As Boolean
  113. Private m_Value As Integer
  114. Event Click()
  115.  
  116. Private Sub UserControl_InitProperties()
  117.      Caption = Extender.Name                          'assigns Caption name of usercontrol
  118.      UserControl.FontSize = 10                        'font size as a start
  119.      UserControl.FontBold = True                      'make it bold so it is easier to read caption
  120.      Enabled = True
  121. End Sub
  122.  
  123. Private Sub UserControl_Click()
  124.      If Enabled = False Then Exit Sub                 'disabled so exit sub
  125.      If Value = 1 Then                                'if check then uncheck
  126.       Value = 0
  127.      Else
  128.         Value = 1
  129.      End If
  130.  
  131.      RaiseEvent Click                                 'show we did something
  132.      DrawCaption
  133.   
  134. End Sub
  135.  
  136. Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  137.     If UserControl.Picture = imgStore.Picture Then                       'toggles check mark on or off
  138.         UserControl.Picture = imgBlankCheck.Picture                      'Blank Check box
  139.      Else
  140.         UserControl.Picture = imgStore.Picture                           'selected check mark
  141.      End If
  142. End Sub
  143.  
  144. Public Property Get Caption() As String
  145. Attribute Caption.VB_Description = "Enter text to describe action."
  146.      Caption = m_Caption
  147. End Property
  148.  
  149. Public Property Let Caption(NewCaption As String)
  150.      m_Caption = NewCaption
  151.      PropertyChanged "Caption"
  152.      DrawCaption
  153. End Property
  154.  
  155. Public Property Get CheckColor() As eCheckColor
  156. Attribute CheckColor.VB_Description = "Select color of check mark."
  157.     CheckColor = m_CheckColor
  158. End Property
  159.  
  160. Public Property Let CheckColor(NewCheckColor As eCheckColor)
  161.     m_CheckColor = NewCheckColor
  162.     GetCheckColor
  163.     UserControl.Picture = imgStore.Picture                               'show check color change in IDE mode
  164.     PropertyChanged "CheckColor"
  165.     DrawCaption
  166. End Property
  167.  
  168. Public Property Get Enabled() As Boolean
  169. Attribute Enabled.VB_Description = "Makes checkbox active or inactive"
  170.    Enabled = m_Enabled
  171. End Property
  172.  
  173. Public Property Let Enabled(NewEnabled As Boolean)
  174.      m_Enabled = NewEnabled
  175.      Value = m_Value                                                             'just to make sure it is current
  176.      
  177.      If Value = 0 Then                                                           'Unchecked
  178.         If Enabled = False Then UserControl.Picture = imgGrayUnChecked.Picture   'unchecked disabled
  179.         If Enabled = True Then UserControl.Picture = imgBlankCheck.Picture       'unchecked enabled
  180.      Else
  181.         If Enabled = False Then UserControl.Picture = imgGrayChecked.Picture     'checked disabled
  182.         If Enabled = True Then UserControl.Picture = imgStore.Picture            'checked enabled
  183.      End If
  184.      GetCheckColor                                                               ' get check color
  185.      PropertyChanged "Enabled"
  186.      DrawCaption
  187. End Property
  188. Public Property Get Font() As Font
  189. Attribute Font.VB_Description = "Selects font to display text"
  190.      Set Font = UserControl.Font
  191. End Property
  192.  
  193. Public Property Set Font(ByVal NewFont As Font)
  194.      Set UserControl.Font = NewFont
  195.      PropertyChanged "Font"
  196.      DrawCaption
  197. End Property
  198.  
  199. Public Property Get ForeColor() As OLE_COLOR
  200. Attribute ForeColor.VB_Description = "Sets color of font"
  201.      ForeColor = UserControl.ForeColor
  202. End Property
  203.  
  204. Public Property Let ForeColor(NewForeColor As OLE_COLOR)
  205.      UserControl.ForeColor() = NewForeColor
  206.      PropertyChanged "ForeColor"
  207.      DrawCaption
  208. End Property
  209.  
  210. Public Property Get Value() As eValue
  211. Attribute Value.VB_Description = "Sets state of checkbox to checked or unchecked."
  212.      Value = m_Value
  213. End Property
  214.  
  215. Public Property Let Value(NewValue As eValue)
  216.      m_Value = NewValue
  217.    
  218.      GetCheckColor
  219.      If Enabled = False Then                                                  'Disabled
  220.          If Value = 0 Then UserControl.Picture = imgGrayUnChecked.Picture     'unchecked disabled
  221.          If Value = 1 Then UserControl.Picture = imgGrayChecked.Picture       'checked disabled
  222.      Else                                                                     ' Enabled
  223.          If Value = 0 Then UserControl.Picture = imgBlankCheck.Picture        'unchecked enabled
  224.          If Value = 1 Then UserControl.Picture = imgStore.Picture             'Checked enabled
  225.      End If
  226.      PropertyChanged "Value"
  227.      DrawCaption
  228. End Property
  229.  
  230. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  231.      With PropBag
  232.           Caption = .ReadProperty("Caption", Extender.Name)
  233.           CheckColor = .ReadProperty("CheckColor", m_def_CheckColor)
  234.           Enabled = .ReadProperty("Enabled", m_def_Enabled)
  235.           Value = .ReadProperty("Value", m_def_Value)
  236.           Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
  237.           UserControl.ForeColor = .ReadProperty("ForeColor", Ambient.ForeColor)
  238.      End With
  239.      DrawCaption
  240. End Sub
  241.  
  242. Private Sub UserControl_Resize()
  243.    DrawCaption
  244. End Sub
  245.  
  246. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  247.    With PropBag
  248.           Call .WriteProperty("Caption", m_Caption, Extender.Name)
  249.           Call .WriteProperty("CheckColor", m_CheckColor, m_def_CheckColor)
  250.           Call .WriteProperty("Enabled", m_Enabled, m_def_Enabled)
  251.           Call .WriteProperty("Value", m_Value, m_def_Value)
  252.           Call .WriteProperty("Font", UserControl.Font, Ambient.Font)
  253.           Call .WriteProperty("ForeColor", UserControl.ForeColor, Ambient.ForeColor)
  254.      End With
  255. End Sub
  256. Private Sub DrawCaption()
  257.      Dim lRtn As Long
  258.     
  259.      Cls                                                                            'clear screen of trash
  260.      UserControl.Font = Font
  261.      m_CaptionRect.Left = 20                                                        'used to locate position of Caption
  262.      m_CaptionRect.Top = 0                                                         'as well as draw rectangle
  263.      m_CaptionRect.Right = UserControl.ScaleWidth
  264.      m_CaptionRect.Bottom = UserControl.ScaleHeight
  265.      lRtn = DrawTextEx(UserControl.hdc, m_Caption, Len(m_Caption), m_CaptionRect, _
  266.           m_Flag, ByVal 0&)                                                         'draw caption
  267.      UserControl.MaskPicture = UserControl.Image
  268. End Sub
  269. Private Sub GetCheckColor()
  270.      If Enabled = False Then Exit Sub                              'disabled so exit
  271.      If Value = 1 Then                                             'Checked
  272.        Select Case CheckColor
  273.           Case 0
  274.                imgStore.Picture = imgRedCheck.Picture              'Red Check
  275.           Case 1
  276.                imgStore.Picture = imgGreenCheck.Picture            'Green Check
  277.           Case 2
  278.                imgStore.Picture = imgBlueCheck.Picture             'Blue Check
  279.        End Select
  280.        Else
  281.            imgStore.Picture = imgBlankCheck.Picture
  282.      End If
  283. End Sub
  284.  
  285.