xpcheckbox.ctl

vb.net开发的考试系统,界面美观

Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Enabled = False Then Exit Sub
        If p.Picture = pc.GraphicCell(chVal) Then Exit Sub 'No reason to came in all the time
           If btnDown = 1 Then Exit Sub
            Timer1.Enabled = True
                If mValue = Checked Then
                    p.Picture = pc.GraphicCell(5)
                        chVal = 5
                            ElseIf mValue = Mixed Then
                                p.Picture = pc.GraphicCell(9)
                                    chVal = 9
                                ElseIf mValue = Unchecked Then
                            p.Picture = pc.GraphicCell(1)
                        chVal = 1
                End If
        RaiseEvent MouseMove(Button, Shift, X, Y)
End Sub ' wssccc's qq  151884336

Private Sub p_KeyDown(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyDown(KeyCode, Shift)
End Sub ' wssccc's qq  151884336

Private Sub p_KeyPress(KeyAscii As Integer) 'Like Sub MouseDown(just using KeyPress)
    If KeyAscii <> vbKeySpace Then Exit Sub 'only "space" can come in
           RaiseEvent KeyPress(KeyAscii)
              RaiseEvent Click
                   Call UserControl_MouseDown(1, 0, 0, 0)
    End Sub ' wssccc's qq  151884336

Private Sub p_KeyUp(KeyCode As Integer, Shift As Integer) 'Like MouseUp
    If KeyCode <> vbKeySpace Then Exit Sub ' and come out
       RaiseEvent KeyUp(KeyCode, Shift)
           Call UserControl_Click 'we didn't call MouseUp 'cause he will not change the picture
               btnDown = 0 'this is also in sub MouseUp
End Sub ' wssccc's qq  151884336
Private Sub p_AccessKeyPress(KeyAscii As Integer)
  RaiseEvent Click
End Sub ' wssccc's qq  151884336

Private Sub lbl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call UserControl_MouseDown(Button, Shift, X, Y)
End Sub ' wssccc's qq  151884336

Private Sub lbl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call UserControl_MouseMove(Button, Shift, X, Y)
End Sub ' wssccc's qq  151884336

Private Sub lbl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call UserControl_MouseUp(Button, Shift, X, Y)
End Sub ' wssccc's qq  151884336

Private Sub p_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call UserControl_MouseDown(Button, Shift, X, Y)
End Sub ' wssccc's qq  151884336

Private Sub p_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Call UserControl_MouseMove(Button, Shift, X, Y)
End Sub ' wssccc's qq  151884336

Private Sub p_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call UserControl_MouseUp(Button, Shift, X, Y)
End Sub ' wssccc's qq  151884336
Private Sub lbl_Change()
    UserControl_Resize
End Sub ' wssccc's qq  151884336

Private Sub lbl_Click()
    Call UserControl_Click
End Sub ' wssccc's qq  151884336

Private Sub p_Click()
    UserControl_Click
End Sub ' wssccc's qq  151884336

Private Sub UserControl_Click()
    RaiseEvent Click
        If mValue = Checked Then
            Value = Unchecked
                ElseIf mValue = Unchecked Then
                    Value = Checked
                ElseIf mValue = Mixed Then
            Value = Unchecked
        End If
    DisablePc
End Sub ' wssccc's qq  151884336

Private Sub UserControl_Initialize()
    pc.Picture = pcChoice(3).Picture
    DisablePc
    UserControl_Resize
    UserControl.BackColor = mBackColor
    chVal = 1
End Sub ' wssccc's qq  151884336

Private Sub UserControl_InitProperties()
    Enabled = True
    BackColor = defBackColor
    CheckBoxLook = XP_Default
    Value = Unchecked
    Caption = Ambient.DisplayName
    Set Font = UserControl.Ambient.Font
    ForeColor = defForeColor
End Sub ' wssccc's qq  151884336

Private Sub UserControl_Resize()
    UserControl.ScaleMode = 1
    p.Height = 195
    p.Width = 195
    p.Left = 0
    p.Top = (UserControl.Height - p.Height) \ 2
    lbl.Top = (UserControl.Height - lbl.Height) \ 2
    lbl.Left = 240
End Sub ' wssccc's qq  151884336

Private Function DisablePc()
    If Enabled = True Then
        If mValue = Checked Then
            p.Picture = pc.GraphicCell(4)
                ElseIf mValue = Mixed Then
                    p.Picture = pc.GraphicCell(8)
                ElseIf mValue = Unchecked Then
            p.Picture = pc.GraphicCell(0)
        End If
            Else: EnablePc
    End If
End Function

Private Function EnablePc()
    If mValue = Checked Then
        p.Picture = pc.GraphicCell(7)
            ElseIf mValue = Mixed Then
                p.Picture = pc.GraphicCell(11)
            ElseIf mValue = Unchecked Then
        p.Picture = pc.GraphicCell(3)
    End If
End Function

Private Sub DoIt(z As Integer)
    pc.Picture = pcChoice(z).Picture
End Sub ' wssccc's qq  151884336

Private Sub CheckEnabled()
    If Enabled = False Then
        EnablePc
            lbl.ForeColor = &H80000011
                Timer1.Enabled = False
            Else: DisablePc
        lbl.ForeColor = mForeColor
    End If
End Sub ' wssccc's qq  151884336

Private Sub p_GotFocus() 'in case that you move with key "Tab" or mouse click, picure p get focus
    Call UserControl_MouseMove(0, 0, 0, 0)
        Timer1.Enabled = False 'timer must be disabled 'cause we will not see the change
End Sub ' wssccc's qq  151884336

Private Sub p_LostFocus() 'here p losts focus and must change picture
    chVal = 11 'must be done 'cause else will not change the picture
        Call UserControl_MouseMove(0, 0, 0, 0)
End Sub ' wssccc's qq  151884336

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    Enabled = PropBag.ReadProperty("Enabled", True)
    CheckBoxLook = PropBag.ReadProperty("CheckBoxLook", mPicDefault)
    Value = PropBag.ReadProperty("Value", defValue)
    Caption = PropBag.ReadProperty("Caption", "CheckBox1")
    BackColor = PropBag.ReadProperty("BackColor", defBackColor)
    Set Font = PropBag.ReadProperty("Font", UserControl.Ambient.Font)
    ForeColor = PropBag.ReadProperty("ForeColor", defForeColor)
End Sub ' wssccc's qq  151884336

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
    Call PropBag.WriteProperty("CheckBoxLook", mPic, defPic)
    Call PropBag.WriteProperty("Value", mValue, defValue)
    Call PropBag.WriteProperty("Caption", lbl.Caption, "CheckBox")
    Call PropBag.WriteProperty("BackColor", mBackColor, defBackColor)
    Call PropBag.WriteProperty("Font", mFont, UserControl.Ambient.Font)
    Call PropBag.WriteProperty("ForeColor", mForeColor, defForeColor)
End Sub ' wssccc's qq  151884336

Public Property Get Enabled() As Boolean
    Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal NewEnabled As Boolean)
    UserControl.Enabled() = NewEnabled
    CheckEnabled
    PropertyChanged "Enabled"
End Property

Public Property Get CheckBoxLook() As Pict
    CheckBoxLook = mPic
End Property

Public Property Let CheckBoxLook(ByVal NewCheckBoxLook As Pict)
    mPic = NewCheckBoxLook
    PropertyChanged "CheckBoxLook"
    DoIt (mPic)
    CheckEnabled
End Property

Public Property Get Value() As State
    Value = mValue
End Property

Public Property Let Value(ByVal NewValue As State)
    mValue = NewValue
    DisablePc
    PropertyChanged "Value"
End Property

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

Public Property Let Caption(ByVal NewCaption As String)
    lbl.Caption() = NewCaption
    Call UserControl_Resize
    PropertyChanged "Caption"
End Property

Public Property Get BackColor() As OLE_COLOR
    BackColor = mBackColor
End Property

Public Property Let BackColor(ByVal NewBackColor As OLE_COLOR)
    mBackColor = NewBackColor
    PropertyChanged "BackColor"
    UserControl.BackColor = mBackColor
End Property

Public Property Get Font() As Font
    Set Font = mFont
End Property

Public Property Set Font(ByVal NewFont As Font)
    Set mFont = NewFont
    Set UserControl.Font = NewFont
    Set lbl.Font = mFont
    Call UserControl_Resize
    PropertyChanged "Font"
End Property

Public Property Get ForeColor() As OLE_COLOR
    ForeColor = mForeColor
End Property

Public Property Let ForeColor(ByVal NewForeColor As OLE_COLOR)
    mForeColor = NewForeColor
    CheckEnabled
    PropertyChanged "ForeColor"
End Property

Private Sub Timer1_Timer()
    Dim dot As POINT_API
    UserControl.ScaleMode = 3 '
    Call GetCursorPos(dot) '鼠标位置
        ScreenToClient UserControl.hwnd, dot 'must have
  
  '检测鼠标是否在控件之上
            If dot.X < UserControl.ScaleLeft Or _
                dot.Y < UserControl.ScaleTop Or _
                    dot.X > (UserControl.ScaleLeft + UserControl.ScaleWidth) Or _
                        dot.Y > (UserControl.ScaleTop + UserControl.ScaleHeight) Then
                        If btnDown = 1 Then Exit Sub 'in case that user clicked and did not
                            DisablePc                            'left the button, this will prevent from calling
                        Timer1.Enabled = False            ' DisablePc with no end
                RaiseEvent MouseOut
            End If
End Sub ' wssccc's qq  151884336