VERSION 5.00
Begin VB.UserControl optcontrol 
   BackColor       =   &H00C0C0FF&
   ClientHeight    =   1020
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1980
   BeginProperty Font 
      Name            =   "Times New Roman"
      Size            =   15.75
      Charset         =   162
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   PropertyPages   =   "optcontrol.ctx":0000
   ScaleHeight     =   1020
   ScaleWidth      =   1980
   ToolboxBitmap   =   "optcontrol.ctx":0040
   Begin VB.Image Image1 
      Height          =   195
      Left            =   30
      Picture         =   "optcontrol.ctx":0352
      Stretch         =   -1  'True
      Top             =   30
      Visible         =   0   'False
      Width           =   195
   End
   Begin VB.Image thecircle 
      Height          =   195
      Left            =   1680
      Picture         =   "optcontrol.ctx":0C1C
      Stretch         =   -1  'True
      Top             =   600
      Visible         =   0   'False
      Width           =   195
   End
   Begin VB.Label thelabel 
      Caption         =   "OptControl"
      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             =   120
      Width           =   1215
   End
   Begin VB.Image thecross 
      Height          =   195
      Left            =   1680
      Picture         =   "optcontrol.ctx":14E6
      Stretch         =   -1  'True
      Top             =   30
      Visible         =   0   'False
      Width           =   195
   End
   Begin VB.Image thetick 
      Height          =   195
      Left            =   1680
      Picture         =   "optcontrol.ctx":1DB0
      Stretch         =   -1  'True
      Top             =   360
      Visible         =   0   'False
      Width           =   195
   End
End
Attribute VB_Name = "optcontrol"
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 PictureType1
leftside = 0
rightside = 1
End Enum
Enum CrossType
FilledCircle = 0
HollowCircle = 1
End Enum
Dim P_Align As PictureType1 'picture side
Dim P_ct As CrossType 'hollow or filled
Dim Co_enable As Boolean 'control enabled
'const
Const L_labelll = 270 'label when left
Const L_labelrl = 30 'label when right
Const L_labelnt = 30 'label  top
Dim L_left As Integer
Dim L_top As Integer
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 m
Dim V_thevalue As OLE_OPTEXCLUSIVE
Dim M_buttons As buttons 'mouse buttons
'Event Declarations:
Event Change()
Attribute Change.VB_Description = "Occurs when the contents of a control have changed."
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 'if enabled allow programer to get control output
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)
     'the click event is here so that the mouse buttons
     'work as left/right/ or both, otherwise the click
     'event would work all the time
     RaiseEvent Click
 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 enabled
 If Co_enable = True Then
  'if thetick is the picture
  'otherwise will accept click to de-select option
  'options will not work correctly
  If Image1.Picture <> thetick.Picture 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 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 Image1.Picture <> thetick.Picture Then
    Value = Not Value 'change the value
    thelabel.Left = L_left 'reset the label
    thelabel.Top = L_top
    
    clickevent "mu", Button, Shift, X, Y
  End If
 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

   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", thelabel.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_ct = PropBag.ReadProperty("NotSelectedType", FilledCircle)
    Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
    UserControl.MousePointer = PropBag.ReadProperty("MousePointer", 0)
    V_thevalue = PropBag.ReadProperty("Value", False)
    M_buttons = PropBag.ReadProperty("ButtonsMouse", LeftMouseOnly)
  
    Image1.Visible = True
    If V_thevalue Then
        thelabel.ForeColor = Col_fct
        Image1.Picture = thetick.Picture
    ElseIf Not V_thevalue Then
        thelabel.ForeColor = Col_fcc
     If P_ct = FilledCircle Then
       Image1.Picture = thecross.Picture
     ElseIf P_ct = HollowCircle Then
       Image1.Picture = thecircle.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

Private Sub Rightalign()
    Image1.Left = UserControl.Width - 240
    
    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
    
End Sub
Private Sub Leftalign()
    Image1.Left = 30
    
    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
    
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("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("NotSelectedType", P_ct, FilledCircle)
    Call PropBag.WriteProperty("Enabled", Image1.Enabled, True)
    Call PropBag.WriteProperty("Value", V_thevalue, False)
    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
    
    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

Private Sub UserControl_DblClick()
    clickevent "DblClick", 0, 0, 0, 0
End Sub
Public Property Get Value() As OLE_OPTEXCLUSIVE
Attribute Value.VB_UserMemId = 0
    Value = V_thevalue
End Property

Public Property Let Value(ByVal New_Value As OLE_OPTEXCLUSIVE)
V_thevalue = New_Value

If V_thevalue Then
    Image1.Picture = thetick.Picture
    thelabel.ForeColor = Col_fct
ElseIf Not V_thevalue Then
    thelabel.ForeColor = Col_fcc
 If P_ct = FilledCircle Then
    Image1.Picture = thecross.Picture
 ElseIf P_ct = HollowCircle Then
    Image1.Picture = thecircle.Picture
 End If
End If

    PropertyChanged "Value"
        RaiseEvent Change



    
   

End Property
Public Property Get NotSelectedType() As CrossType
        NotSelectedType = P_ct
End Property

Public Property Let NotSelectedType(ByVal NewCross As CrossType)
        P_ct = NewCross
  
    If P_ct = FilledCircle Then
        Image1.Picture = thecross.Picture
    ElseIf P_ct = HollowCircle Then
        Image1.Picture = thecircle.Picture
    End If
         PropertyChanged "NotSelectedType"
         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

