xpcheckbox.ctl

驾驶员考试系统界面不错在98下运行C/S模式

VERSION 5.00
Begin VB.UserControl xpcheckbox 
   AutoRedraw      =   -1  'True
   ClientHeight    =   465
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   1665
   FillStyle       =   0  'Solid
   ScaleHeight     =   31
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   111
   ToolboxBitmap   =   "xpcheckbox.ctx":0000
   Begin VB.PictureBox p 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000005&
      BorderStyle     =   0  'None
      ForeColor       =   &H80000008&
      Height          =   195
      Left            =   30
      Picture         =   "xpcheckbox.ctx":0312
      ScaleHeight     =   13
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   13
      TabIndex        =   1
      Top             =   150
      Width           =   195
   End
   Begin VB.Label lbl 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      AutoSize        =   -1  'True
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "Check1"
      ForeColor       =   &H80000008&
      Height          =   195
      Left            =   330
      TabIndex        =   0
      Top             =   150
      Width           =   555
   End
End
Attribute VB_Name = "xpcheckbox"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINT_API) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINT_API) As Long

Private Type POINT_API
    X As Long
    Y As Long
End Type

Public Enum State
    Unchecked = 0
    Checked = 1
    Mixed = 2
End Enum

Dim m_Font As Font
Dim m_Value As State
Dim m_BackColor As OLE_COLOR
Dim m_ForeColor As OLE_COLOR

Const m_def_Value = State.Unchecked
Const m_def_BackColor = vbButtonFace
Const m_def_ForeColor = vbBlack

Event Click()
Attribute Click.VB_UserMemId = -600
Event KeyDown(KeyCode As Integer, Shift As Integer)
Attribute KeyDown.VB_UserMemId = -602
Event KeyPress(KeyAscii As Integer)
Attribute KeyPress.VB_UserMemId = -603
Event KeyUp(KeyCode As Integer, Shift As Integer)
Attribute KeyUp.VB_UserMemId = -604
Event MouseOut()
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Attribute MouseDown.VB_UserMemId = -605
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Attribute MouseMove.VB_UserMemId = -606
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Attribute MouseUp.VB_UserMemId = -607

Private Sub lbl_Change()
  UserControl_Resize
End Sub

Private Sub lbl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  p_MouseDown Button, Shift, X, Y
End Sub

Private Sub lbl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Call p_MouseMove(Button, Shift, 0, 0)
End Sub

Private Sub lbl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  Call p_MouseUp(Button, Shift, X, Y)
End Sub

Private Sub p_Click()
  RaiseEvent Click
End Sub

Private Sub p_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Value = Checked Then
    p.PaintPicture p.Picture, 0, 0, 13, 13, 0, 78, 13, 13
  ElseIf Value = Mixed Then
    p.PaintPicture p.Picture, 0, 0, 13, 13, 0, 130, 13, 13
  ElseIf Value = Unchecked Then
    p.PaintPicture p.Picture, 0, 0, 13, 13, 0, 26, 13, 13
  End If
End Sub

Private Sub p_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If Not ((X < 0) Or (Y < 0) Or (X > p.ScaleWidth) Or (Y > p.ScaleHeight)) Then
    If Button <> vbLeftButton Or UserControl.Tag <> "" Then
      If Button = vbLeftButton Then
        If Enabled Then
          If Value = Checked Then
            p.PaintPicture p.Picture, 0, 0, 13, 13, 0, 78, 13, 13
          ElseIf Value = Mixed Then
            p.PaintPicture p.Picture, 0, 0, 13, 13, 0, 130, 13, 13
          ElseIf Value = Unchecked Then
            p.PaintPicture p.Picture, 0, 0, 13, 13, 0, 26, 13, 13
          End If
        End If
      Else
        If Enabled Then
          If Value = Checked Then
            p.PaintPicture p.Picture, 0, 0, 13, 13, 0, 65, 13, 13
          ElseIf Value = Mixed Then
            p.PaintPicture p.Picture, 0, 0, 13, 13, 0, 9, 13, 13
          ElseIf Value = Unchecked Then
            p.PaintPicture p.Picture, 0, 0, 13, 13, 0, 13, 13, 13
          End If
        End If
      End If
    End If
    
    SetCapture p.hWnd
  Else
    define_pic
    ReleaseCapture
    
    RaiseEvent MouseOut
  End If
End Sub

Private Sub p_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  If UserControl.Tag <> "" Then
    Call UserControl_MouseUp(Button, Shift, X, Y)
  
    If Value = Checked Then
      Value = Unchecked
    ElseIf Value = Unchecked Then
      Value = Checked
    ElseIf Value = Mixed Then
      Value = Unchecked
    End If
  
    define_pic
  End If
End Sub

Private Sub UserControl_EnterFocus()
  UserControl.Tag = "1"
End Sub

Private Sub UserControl_ExitFocus()
  UserControl.Tag = ""
End Sub

Private Sub UserControl_Initialize()
  define_pic
  UserControl_Resize
  UserControl.BackColor = m_BackColor
End Sub

Public Property Get Enabled() As Boolean
Attribute Enabled.VB_ProcData.VB_Invoke_Property = ";Behavior"
Attribute Enabled.VB_UserMemId = -514
  Enabled = UserControl.Enabled
End Property

Public Property Let Enabled(ByVal New_Enabled As Boolean)
  UserControl.Enabled() = New_Enabled
  
  If Enabled = False Then
    enabled_pic
  Else
    define_pic
  End If
  
  If Enabled = True Then
    lbl.ForeColor = m_ForeColor
  Else
    lbl.ForeColor = RGB(131, 131, 146)
  End If
End Property

Private Sub UserControl_InitProperties()
  Caption = Ambient.DisplayName
  Enabled = True
  Value = Unchecked
  Set Font = UserControl.Ambient.Font
  BackColor = m_def_BackColor
  ForeColor = m_def_ForeColor
End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
  RaiseEvent KeyDown(KeyCode, Shift)
End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)
  RaiseEvent KeyPress(KeyAscii)
End Sub

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
  RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  RaiseEvent MouseUp(Button, Shift, X, Y)
End Sub

Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  Value = PropBag.ReadProperty("Value", m_def_Value)
  Caption = PropBag.ReadProperty("Caption", Ambient.DisplayName)
  Enabled = PropBag.ReadProperty("Enabled", True)
  Set Font = PropBag.ReadProperty("Font", UserControl.Ambient.Font)
  BackColor = PropBag.ReadProperty("BackColor", m_def_BackColor)
  ForeColor = PropBag.ReadProperty("ForeColor", m_def_ForeColor)
End Sub

Private Sub UserControl_Resize()
  p.Left = 0
  p.Top = (UserControl.ScaleHeight - p.ScaleHeight) \ 2
  lbl.Top = p.Top + 1
  lbl.Left = 18
End Sub

Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  Call PropBag.WriteProperty("Font", m_Font, UserControl.Ambient.Font)
  Call PropBag.WriteProperty("Value", m_Value, m_def_Value)
  Call PropBag.WriteProperty("Caption", lbl.Caption, Ambient.DisplayName)
  Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  Call PropBag.WriteProperty("BackColor", m_BackColor, m_def_BackColor)
  Call PropBag.WriteProperty("ForeColor", m_ForeColor, m_def_ForeColor)
End Sub

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

Public Property Let Value(ByVal vNewValue As State)
  m_Value = vNewValue
  define_pic
  PropertyChanged "Value"
End Property

Public Property Get Caption() As String
Attribute Caption.VB_ProcData.VB_Invoke_Property = ";Appearance"
Attribute Caption.VB_UserMemId = -518
  Caption = lbl.Caption
End Property

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

Public Property Get Font() As Font
Attribute Font.VB_ProcData.VB_Invoke_Property = ";Font"
Attribute Font.VB_UserMemId = -512
  Set Font = m_Font
End Property

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

Private Function define_pic()
  If Enabled = True Then
    If Value = Checked Then
      p.PaintPicture p.Picture, 0, 0, 13, 13, 0, 52, 13, 13
    ElseIf Value = Mixed Then
      p.PaintPicture p.Picture, 0, 0, 13, 13, 0, 104, 13, 13
    ElseIf Value = Unchecked Then
      p.PaintPicture p.Picture, 0, 0, 13, 13, 0, 0, 13, 13
    End If
  Else
    enabled_pic
  End If
End Function

Private Function enabled_pic()
  If Value = Checked Then
    p.PaintPicture p.Picture, 0, 0, 13, 13, 0, 91, 13, 13
  ElseIf Value = Mixed Then
    p.PaintPicture p.Picture, 0, 0, 13, 13, 0, 143, 13, 13
  ElseIf Value = Unchecked Then
    p.PaintPicture p.Picture, 0, 0, 13, 13, 0, 39, 13, 13
  End If
End Function

Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
Attribute BackColor.VB_UserMemId = -501
  BackColor = m_BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
  m_BackColor = New_BackColor
  PropertyChanged "BackColor"
  UserControl.BackColor = m_BackColor
End Property

Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
Attribute ForeColor.VB_UserMemId = -513
  ForeColor = m_ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
  m_ForeColor = New_ForeColor
  PropertyChanged "ForeColor"
  If Enabled = True Then lbl.ForeColor = m_ForeColor Else lbl.ForeColor = RGB(131, 131, 146)
End Property