VERSION 5.00
Begin VB.UserControl chkcontrol 
   BackColor       =   &H00000000&
   ClientHeight    =   1335
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1830
   BeginProperty Font 
      Name            =   "Times New Roman"
      Size            =   15.75
      Charset         =   162
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   PropertyPages   =   "chkcontrol.ctx":0000
   ScaleHeight     =   1335
   ScaleWidth      =   1830
   ToolboxBitmap   =   "chkcontrol.ctx":0040
   Begin VB.Image Image1 
      Height          =   195
      Left            =   30
      Stretch         =   -1  'True
      Top             =   30
      Width           =   195
   End
   Begin VB.Image thetick 
      Height          =   240
      Left            =   1560
      Picture         =   "chkcontrol.ctx":0352
      Stretch         =   -1  'True
      Top             =   120
      Visible         =   0   'False
      Width           =   225
   End
   Begin VB.Image thecross 
      Height          =   195
      Left            =   1560
      Picture         =   "chkcontrol.ctx":065C
      Stretch         =   -1  'True
      Top             =   360
      Visible         =   0   'False
      Width           =   195
   End
   Begin VB.Label thelabel 
      Caption         =   "ChkControl"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   240
      TabIndex        =   0
      Top             =   0
      Width           =   1215
   End
   Begin VB.Shape backbox 
      BackColor       =   &H00000000&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00FFFFFF&
      Height          =   225
      Left            =   120
      Top             =   960
      Width           =   225
   End
End
Attribute VB_Name = "chkcontrol"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "PropPageWizardRun" ,"Yes"
'Default Property Values
Enum PictureType
leftside = 0 'tick/cross left
rightside = 1 'tick/cross right
End Enum
Enum PictureBackColor
black = 0 ' color behind tick/cross black
white = 1 ' color behind tick/cross white
none = 2 'nothing behind tick/cross
End Enum
Enum CrossVisibleyn
crossvisible = 0 'see the cross
crossinvisible = 1 'dont see the cross
End Enum
Enum buttons
LeftMouseOnly = 0 'only left mouse will work default
RightMouseOnly = 1 'only right mouse will work
BothButtons = 2 'both mouse buttons will work
End Enum
'Property Variables:
Dim P_Align As PictureType 'right/left tick/cross
Dim P_pbc As PictureBackColor 'what color behind
Dim Cr_tac As CrossVisibleyn 'see the cross
Dim Co_enable As Boolean 'control enabled
Dim Cr_civ As Boolean 'cross is visible
Dim V_thevalue As OLE_TRISTATE 'value checked,unchecked
'const
Const L_labelll = 270 'label left when left
Const L_labelrl = 30 'label left when right
Const L_labelnt = 30 'label  top
Dim L_left As Integer 'label left mouseup
Dim L_top As Integer 'label top mouseup
Dim M_buttons As buttons

Dim Col_fcc As OLE_COLOR 'forecolor when cross
Dim Col_fct As OLE_COLOR 'forecolor when tick
Dim Col_fcmc As OLE_COLOR 'forecolor when mousedown
'Event Declarations:
Event Change()
Event Click()
Event DblClick()
Event KeyDown(KeyCode As Integer, Shift As Integer)
Event KeyPress(KeyAscii As Integer)
Event KeyUp(KeyCode As Integer, Shift As Integer)
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)

Private Sub clickevent(ByVal theevent As String, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Co_enable = True Then
Select Case theevent
 
 Case "double"
     RaiseEvent DblClick
 Case "change"
    RaiseEvent Change
 Case "mu"
    RaiseEvent MouseUp(Button, Shift, X, Y)
 Case "md"
     RaiseEvent MouseDown(Button, Shift, X, Y)
     RaiseEvent Click 'here so mouse buttons work correctly
 Case "mm"
     RaiseEvent MouseMove(Button, Shift, X, Y)
 Case "kd"
    RaiseEvent KeyDown(Button, Shift) 'button=keycode
 Case "ku"
    RaiseEvent KeyUp(Button, Shift) 'button=keycode
 Case "kp"
    RaiseEvent KeyPress(Button) 'button=keyascii
 End Select
End If
End Sub
Private Sub image1_DblClick()

    clickevent "DblClick", 0, 0, 0, 0

End Sub

Private Sub image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
 thelabel_MouseDown Button, Shift, X, Y
    
End Sub

Private Sub image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
clickevent "mm", Button, Shift, X, Y
   

End Sub

Private Sub image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
thelabel_MouseUp Button, Shift, X, Y
    

End Sub


Private Sub thelabel_DblClick()
    clickevent "DblClick", 0, 0, 0, 0
End Sub

Private Sub thelabel_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
'if left,right or both buttons selected under mousebuttons
If Button = M_buttons + 1 Or M_buttons = 2 Then
If Co_enable = True Then
    thelabel.Left = thelabel.Left + 20
    thelabel.Top = thelabel.Top + 20
    thelabel.ForeColor = Col_fcmc
    clickevent "md", Button, Shift, X, Y 'also sends mouse 'click' event
End If
End If
End Sub

Private Sub thelabel_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
clickevent "mm", Button, Shift, X, Y
    
End Sub

Private Sub thelabel_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = M_buttons + 1 Or M_buttons = 2 Then
If Co_enable = True Then
 If V_thevalue = Unchecked Then
    V_thevalue = Checked
 ElseIf V_thevalue = Checked Then
    V_thevalue = Unchecked
 End If
    Value = V_thevalue
    thelabel.Left = L_left
    thelabel.Top = L_top
    
    clickevent "mu", Button, Shift, X, Y
End If
End If
End Sub


Private Sub UserControl_InitProperties()
   thelabel.Left = L_labelll
   thelabel.Top = L_labelnt
   L_left = L_labelll
   L_top = L_labelnt
  Col_fcc = &H0
  Col_fct = vbGreen
  Col_fcmc = vbYellow
   Cr_civ = True
   Image1.Picture = thecross.Picture
   Image1.Visible = True
End Sub
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)

    thelabel.Caption = PropBag.ReadProperty("Caption", UserControl.Name)
    
    Set thelabel.Font = PropBag.ReadProperty("Font", UserControl.Font)
  'thelabel.Font = UserControl.Font
    Col_fcc = PropBag.ReadProperty("ForeColorCross", &H0)
    Col_fct = PropBag.ReadProperty("ForeColorTick", vbGreen)
    Col_fcmc = PropBag.ReadProperty("ForeColorMouseClick", vbYellow)
    thelabel.BackColor = PropBag.ReadProperty("BackColor", vbButtonFace)
    
    UserControl.BackColor = thelabel.BackColor
    P_pbc = PropBag.ReadProperty("BackColorPicture", 0)
    pictbackchange
    Cr_civ = PropBag.ReadProperty("CrossIsVisible", True)
    Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
    UserControl.MousePointer = PropBag.ReadProperty("MousePointer", 0)
    V_thevalue = PropBag.ReadProperty("Value", Unchecked)
    M_buttons = PropBag.ReadProperty("ButtonsMouse", LeftMouseOnly)
  
    Image1.Visible = True
    If V_thevalue = Checked Then
        thelabel.ForeColor = ForeColorTick
    ElseIf V_thevalue = Unchecked Then
        thelabel.ForeColor = ForeColorCross
    End If
    If V_thevalue = Checked Then
       Image1.Picture = thetick.Picture
    ElseIf V_thevalue = Unchecked Then
     If Cr_civ = False Then
       Image1.Visible = False
     ElseIf Cr_civ = True Then
       Image1.Picture = thecross.Picture
     End If
    End If
        P_Align = PropBag.ReadProperty("AlignPicture", leftside)
    On Error Resume Next 'error here because shape cannot be enabled/disabled
    For Each Control In UserControl
        Control.Enabled = PropBag.ReadProperty("Enabled", True)
        If Image1.Enabled = True Then Co_enable = True Else Co_enable = False
    Next
    On Error GoTo 0 'turns off error
    
    If P_Align = rightside Then
        Rightalign
    ElseIf P_Align = leftside Then
        Leftalign
    End If
End Sub
Public Sub pictbackchange()

      backbox.Visible = True
    If P_pbc = white Then
        backbox.BackColor = &HFFFFFF
        backbox.BorderColor = &H0
    ElseIf P_pbc = black Then
        backbox.BackColor = &H0
        backbox.BorderColor = &HFFFFFF
    ElseIf P_pbc = none Then
        backbox.Visible = False
    End If
   
End Sub
Private Sub Rightalign()
    Image1.Left = UserControl.Width - 240
    backbox.Left = Image1.Left - 15
    thelabel.Top = L_labelnt
    thelabel.Left = L_labelrl
    thelabel.Width = UserControl.Width - 300
    thelabel.Height = UserControl.Height - 30
    Image1.Top = (UserControl.Height - Image1.Height) / 2
    If Image1.Top < 30 Then Image1.Top = 30
    L_left = L_labelrl: L_top = L_labelnt
    backbox.Top = Image1.Top - 15
End Sub
Private Sub Leftalign()
    Image1.Left = 30
    backbox.Left = Image1.Left - 15
    thelabel.Top = L_labelnt
    thelabel.Left = L_labelll
    L_left = L_labelll: L_top = L_labelnt
    thelabel.Width = UserControl.Width - 300
    thelabel.Height = UserControl.Height - 30
    Image1.Top = (UserControl.Height - Image1.Height) / 2
    If Image1.Top < 30 Then Image1.Top = 30
    backbox.Top = Image1.Top - 15
End Sub

Private Sub UserControl_Resize()
    If P_Align = rightside Then
        Rightalign
    ElseIf P_Align = leftside Then
        Leftalign
    End If
    
End Sub
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("BackColor", thelabel.BackColor, &H80000012)
    Call PropBag.WriteProperty("BackColorPicture", P_pbc, vbBlack)
    Call PropBag.WriteProperty("Caption", thelabel.Caption, "")
    Call PropBag.WriteProperty("Font", thelabel.Font, UserControl.Font)
    Call PropBag.WriteProperty("ForeColorCross", Col_fcc, &H0)
    Call PropBag.WriteProperty("ForeColorTick", Col_fct, &H80FF8)
    Call PropBag.WriteProperty("ForeColorMouseClick", Col_fcmc, vbYellow)
    Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
    Call PropBag.WriteProperty("MousePointer", UserControl.MousePointer, 0)
    Call PropBag.WriteProperty("CrossIsVisible", Cr_civ, True)
    Call PropBag.WriteProperty("Enabled", Image1.Enabled, True)
    Call PropBag.WriteProperty("Value", V_thevalue, Unchecked)
    Call PropBag.WriteProperty("AlignPicture", P_Align, leftside)
    Call PropBag.WriteProperty("ButtonsMouse", M_buttons, LeftMouseOnly)
      
End Sub


Public Property Get Caption() As String
    Caption = thelabel.Caption
    
End Property

Public Property Let Caption(ByVal New_Caption As String)
    thelabel.Caption() = New_Caption
    
    PropertyChanged "Caption"
    If P_Align = rightside Then
        Rightalign
    ElseIf P_Align = leftside Then
        Leftalign
   End If
        
End Property


Public Property Get Font() As StdFont
    Set Font = thelabel.Font
End Property

Public Property Set Font(ByVal New_Font As StdFont)
    Set thelabel.Font = New_Font
    Debug.Print "Z"; thelabel.Font, "X"; UserControl.FontSize; "X"
    'thelabel.Font = UserControl.Font
    If P_Align = rightside Then
        Rightalign
    ElseIf P_Align = leftside Then
        Leftalign
   
    End If
       PropertyChanged "Font"
       Value = V_thevalue
End Property


Public Property Get ForeColorCross() As OLE_COLOR

    ForeColorCross = Col_fcc
End Property

Public Property Let ForeColorCross(ByVal New_ForeColor As OLE_COLOR)
    Col_fcc = New_ForeColor
    PropertyChanged "ForeColorCross"
   Value = V_thevalue 'Sets value to itself so it passes through Value to reset color
End Property

Public Property Get ForeColorTick() As OLE_COLOR
    ForeColorTick = Col_fct
End Property
Public Property Let ForeColorTick(ByVal NewValue As OLE_COLOR)
    Col_fct = NewValue
    PropertyChanged "ForeColorTick"
       Value = V_thevalue 'Sets value to itself so it passes through Value to reset color
End Property
Public Property Get ForeColorMouseClick() As OLE_COLOR

    ForeColorMouseClick = Col_fcmc
End Property

Public Property Let ForeColorMouseClick(ByVal New_ForeColor As OLE_COLOR)
    Col_fcmc = New_ForeColor
    PropertyChanged "ForeColorMouseClick"
    Value = V_thevalue 'Sets value to itself so it passes through Value to reset color
End Property

Public Property Get BackColor() As OLE_COLOR

    BackColor = thelabel.BackColor
     UserControl.BackColor = thelabel.BackColor
    
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)

    thelabel.BackColor() = New_BackColor
    PropertyChanged "BackColor"
     UserControl.BackColor = thelabel.BackColor
     
           
End Property

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
clickevent "kd", KeyCode, Shift, 0, 0
End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)
clickevent "kp", KeyAscii, 0, 0, 0
    


End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
clickevent "kd", KeyCode, Shift, 0, 0
    
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    thelabel_MouseDown Button, Shift, X, Y
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    thelabel_MouseUp Button, Shift, X, Y
End Sub
Public Property Get MouseIcon() As Picture
    Set MouseIcon = UserControl.MouseIcon
End Property
Public Property Set MouseIcon(ByVal New_MouseIcon As Picture)
    Set UserControl.MouseIcon = New_MouseIcon
    PropertyChanged "MouseIcon"
End Property
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
clickevent "mm", Button, Shift, X, Y
End Sub

Public Property Get MousePointer() As Integer
    MousePointer = UserControl.MousePointer
End Property
Public Property Let MousePointer(ByVal New_MousePointer As Integer)
    UserControl.MousePointer() = New_MousePointer
    PropertyChanged "MousePointer"
End Property
Public Property Get Enabled() As Boolean
    Enabled = Image1.Enabled
End Property
Public Property Let Enabled(ByVal New_Enabled As Boolean)
On Error Resume Next 'error here because of shape
    For Each Control In UserControl
        Control.Enabled = New_Enabled
        Image1.Enabled = Control.Enabled
        thelabel.Enabled = Control.Enabled
        Co_enable = Control.Enabled
    Next
    On Error GoTo 0
   PropertyChanged "Enabled"
End Property
Public Property Get AlignPicture() As PictureType
    AlignPicture = P_Align
End Property

Public Property Let AlignPicture(ByVal NewAlign As PictureType)
   P_Align = NewAlign
    
    If P_Align = rightside Then
        Rightalign
    ElseIf P_Align = leftside Then
        Leftalign
    End If
         
        PropertyChanged "AlignPicture"
End Property
Public Property Get BackColorpicture() As PictureBackColor
Attribute BackColorpicture.VB_Description = "Returns/Sets color behind the Tick/Cross"
    BackColorpicture = P_pbc
End Property

Public Property Let BackColorpicture(ByVal NewBackColor As PictureBackColor)
   P_pbc = NewBackColor
   pictbackchange
   PropertyChanged "BackColorPicture"
End Property

Private Sub UserControl_DblClick()
    clickevent "DblClick", 0, 0, 0, 0
End Sub
Public Property Get Value() As OLE_TRISTATE
    Value = V_thevalue
End Property

Public Property Let Value(ByVal New_Value As OLE_TRISTATE)
     V_thevalue = New_Value
If V_thevalue = Checked Then
    Image1.Visible = True
    Image1.Picture = thetick.Picture
    thelabel.ForeColor = ForeColorTick
ElseIf V_thevalue = Unchecked And Cr_civ = True Then
    Image1.Visible = True
    Image1.Picture = thecross.Picture
    thelabel.ForeColor = ForeColorCross
ElseIf V_thevalue = Unchecked And Cr_civ = False Then
    Image1.Visible = False
    thelabel.ForeColor = ForeColorCross
End If
    PropertyChanged "Value"
    clickevent "change", 0, 0, 0, 0
End Property
Public Property Get CrossIsVisible() As CrossVisibleyn
    CrossIsVisible = Cr_tac
End Property

Public Property Let CrossIsVisible(ByVal NewCross As CrossVisibleyn)
   Cr_tac = NewCross
  
    If Cr_tac = crossvisible Then
        Cr_civ = True
        Image1.Visible = True
    ElseIf Cr_tac = crossinvisible Then
        Cr_civ = False
        Image1.Visible = False
    End If
    PropertyChanged "CrossIsVisible"
    Value = V_thevalue
End Property
Public Property Get MouseButtons() As buttons
     MouseButtons = M_buttons
End Property

Public Property Let MouseButtons(ByVal NewButtons As buttons)
   M_buttons = NewButtons
   
   PropertyChanged "ButtonsMouse"
End Property
