frmuser.frm

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

      Width           =   1095
      _ExtentX        =   1931
      _ExtentY        =   661
      Caption         =   "删除(&D)"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin XPButton.ccXPButton cmdEdit 
      Height          =   375
      Left            =   1680
      TabIndex        =   3
      Top             =   600
      Width           =   1095
      _ExtentX        =   1931
      _ExtentY        =   661
      Caption         =   "修改(&E)"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin XPButton.ccXPButton cmdAdd 
      Height          =   375
      Left            =   240
      TabIndex        =   2
      Top             =   600
      Width           =   1095
      _ExtentX        =   1931
      _ExtentY        =   661
      Caption         =   "添加(&A)"
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Verdana"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.PictureBox PicTop 
      BackColor       =   &H00808080&
      BorderStyle     =   0  'None
      Height          =   450
      Left            =   45
      ScaleHeight     =   30
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   452
      TabIndex        =   0
      TabStop         =   0   'False
      Top             =   45
      Width           =   6780
      Begin VB.Image imgIcon 
         Height          =   240
         Left            =   120
         Picture         =   "frmUser.frx":058A
         Top             =   120
         Width           =   240
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackStyle       =   0  'Transparent
         Caption         =   "考官管理"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   10.5
            Charset         =   134
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H00FFFFFF&
         Height          =   210
         Left            =   600
         TabIndex        =   1
         Top             =   120
         Width           =   900
      End
   End
End
Attribute VB_Name = "frmUser"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Private Sub cmdAdd_Click()
    cmdOK.Caption = "添加"
    freItem.Caption = " 添加考官    "
    txtUser.Text = ""
    txtPW.Text = ""
    txtPW2.Text = ""
    lbPW.Visible = False
    ShowItemFrame True
    txtUser.SetFocus
End Sub

Private Sub cmdDel_Click()
On Error GoTo aaaa
    Dim Item As ListItem
    Set Item = List1.SelectedItem
    If MsgBox("确定删除这个考官吗:" & Item.SubItems(1), vbInformation + vbOKCancel) = vbCancel Then Exit Sub
    Conn.Execute "Delete From kg Where name='" & Item.SubItems(1) & "'"
    SetSB 2, "删除用户 " & Item.SubItems(1) & " 成功."
    List1.ListItems.Remove Item.Index
    List1.SetFocus
Exit Sub
aaaa:
    MsgBox Err.Description, vbCritical
End Sub

Private Sub cmdEdit_Click()
On Error GoTo aaaa
    Dim Item As ListItem
    Set Item = List1.SelectedItem
    txtUser.Text = Item.SubItems(1)
    txtUser.Tag = Item.SubItems(1)
    txtPW.Text = ""
    txtPW2.Text = ""
    lbPW.Visible = True
    cmdOK.Caption = "修改"
    freItem.Caption = " 修改用户 "
    ShowItemFrame True
    txtUser.SetFocus
Exit Sub
aaaa:
    MsgBox Err.Description, vbCritical
End Sub

Private Sub cmdExit_Click()
    ShowItemFrame False
    List1.SetFocus
End Sub

Private Sub cmdOK_Click()
On Error GoTo aaaa
    If txtUser.Text = "" Then
        MsgBox "必须填写考官名。", vbInformation
        txtUser.SetFocus
        Exit Sub
    End If
    If cmdOK.Caption = "添加" Then
        If txtPW.Text = "" Then
            MsgBox "必须填写密码。", vbInformation
            txtPW.SetFocus
            Exit Sub
        End If
        If txtPW2.Text = "" Then
            MsgBox "必须填写确认密码。", vbInformation
            txtPW2.SetFocus
            Exit Sub
        End If
    End If
    If txtPW.Text <> txtPW2.Text Then
        MsgBox "密码前后不一致。", vbInformation
        txtPW2.SetFocus
        Exit Sub
    End If
    If cmdOK.Caption = "添加" Then
        Conn.Execute "insert into kg (name,password)values('" & txtUser.Text & "','" & txtPW.Text & "')"
        LoadUserList
        SetSB 2, "添加用户 " & txtUser.Text & " 成功."
    Else
        If txtPW.Text = "" Then
            Conn.Execute "update kg set name='" & txtUser.Text & "', where name='" & txtUser.Text & "'"
        Else
            Conn.Execute "update kg set name='" & txtUser.Text & "',password='" & txtPW.Text & "', where name='" & txtUser.Text & "'"
        End If
        List1.SelectedItem.SubItems(1) = txtUser.Text
        SetSB 2, "修改用户 " & txtUser.Text & " 成功."
    End If
    cmdExit_Click
Exit Sub
aaaa:
    MsgBox "操作失败，可能是该用户名已经存在！", vbCritical
End Sub

Private Sub Form_Load()
    Me.WindowState = 2
    '读取用户数据列表
    LoadUserList
End Sub

'读取用户数据列表
Public Sub LoadUserList()
    Dim Item As ListItem
    Dim rs As ADODB.Recordset
    Set rs = New ADODB.Recordset
    List1.ListItems.Clear
    rs.Open "Select * From kg", Conn, 1, 1
    Do Until rs.EOF
        Set Item = List1.ListItems.Add(, , rs("id"))
        Item.SubItems(1) = rs("name")
        Item.SubItems(2) = rs("password")
        rs.MoveNext
        i = i + 1
    Loop
    rs.Close
    SetSB 2, "共 " & i & " 条用户员记录."
End Sub

Public Sub ShowItemFrame(ByVal b As Boolean)
    List1.Visible = Not b
    freItem.Visible = b
    cmdDel.Enabled = Not b
    cmdEdit.Enabled = Not b
    cmdAdd.Enabled = Not b
End Sub

Private Sub Form_Resize()
On Error Resume Next
    List1.Width = Width / 15 - 40
    List1.Height = Height / 15 - 116
    PicTop.Width = Width / 15 - 16
    Cls
    Line (2, 2)-(Width / 15 - 14, Height / 15 - 29), 10921638, B
End Sub

Private Sub List1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
On Error Resume Next
    With List1
        If (ColumnHeader.Index - 1) = .SortKey Then
            .SortOrder = 1 - .SortOrder
            .Sorted = True
        Else
            .Sorted = False
            .SortOrder = 0
            .SortKey = ColumnHeader.Index - 1
            .Sorted = True
        End If
    End With
End Sub

Private Sub List1_DblClick()
On Error GoTo aaaa
    Dim j As Long
    j = List1.SelectedItem.Index
    cmdEdit_Click
aaaa:
End Sub

Private Sub List1_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo aaaa
    If KeyCode = vbKeyDelete Then
        Dim j As Long
        j = List1.SelectedItem.Index
        cmdDel_Click
    End If
aaaa:
End Sub