frmuserg.frm

北大青鸟教学管理系统是学习规范编程范本.功能非常完备,代码编写有章法,不可多得

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmUserG 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "用户管理"
   ClientHeight    =   4005
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8055
   Icon            =   "frmUserG.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MDIChild        =   -1  'True
   MinButton       =   0   'False
   ScaleHeight     =   4005
   ScaleWidth      =   8055
   Begin VB.CommandButton cmdModiUser 
      Caption         =   "修改用户"
      Height          =   375
      Left            =   4440
      TabIndex        =   4
      ToolTipText     =   "修改用户权限、当前状态"
      Top             =   3480
      Width           =   975
   End
   Begin MSFlexGridLib.MSFlexGrid MsFGUserInfo 
      Height          =   3135
      Left            =   120
      TabIndex        =   3
      ToolTipText     =   "所有用户信息列表"
      Top             =   120
      Width           =   7815
      _ExtentX        =   13785
      _ExtentY        =   5530
      _Version        =   393216
      Rows            =   3
      Cols            =   7
      FixedRows       =   2
      FocusRect       =   0
      SelectionMode   =   1
      AllowUserResizing=   1
   End
   Begin VB.CommandButton cmdAdd 
      Caption         =   "保存用户"
      Height          =   375
      Left            =   6840
      TabIndex        =   2
      ToolTipText     =   "保存所作更改"
      Top             =   3480
      Width           =   975
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "删除用户"
      Height          =   375
      Left            =   5640
      TabIndex        =   1
      ToolTipText     =   "删除存在的用户"
      Top             =   3480
      Width           =   975
   End
   Begin VB.CommandButton cmdNew 
      Caption         =   "新增用户"
      Height          =   375
      Left            =   3240
      TabIndex        =   0
      ToolTipText     =   "添加用户，并指派权限"
      Top             =   3480
      Width           =   975
   End
End
Attribute VB_Name = "frmUserG"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim IfSave As Boolean

Private Sub cmdAdd_Click()
    Dim intIndex As Integer
    Rst.MoveFirst
    Do While Rst.EOF = False '清空记录集中所有记录
        Rst.Delete
        Rst.MoveNext
    Loop
    Rst.AddNew
    For intIndex = 2 To MsFGUserInfo.Rows - 1
        MsFGUserInfo.Row = intIndex
        MsFGUserInfo.Col = 1
        Rst.Fields("Username") = MsFGUserInfo.Text
        MsFGUserInfo.Col = 2
        Rst.Fields("RegisterDate") = CDate(MsFGUserInfo.Text)
        MsFGUserInfo.Col = 3
        If MsFGUserInfo.Text <> "" Then
            Rst.Fields("Logoutdate") = MsFGUserInfo.Text
        End If
        MsFGUserInfo.Col = 4
        Rst.Fields("status") = MsFGUserInfo.Text
        MsFGUserInfo.Col = 5
        Rst.Fields("popedom") = MsFGUserInfo.Text
        MsFGUserInfo.Col = 6
        Rst.Fields("remark") = MsFGUserInfo.Text
        Rst.Update
        Rst.MoveNext
        
        If Rst.EOF Then
            Rst.AddNew
        End If
    
    Next intIndex
   ' Rst.UpdateBatch
    IfSave = True       '声明数据已经保存
    MsgBox "数据保存成功", vbInformation + vbOKOnly, "保存"
    'Rst.Close
    Unload Me

End Sub

Private Sub cmdDelete_Click()

On Error GoTo Err_Del
        MsFGUserInfo.Col = 1
    If MsFGUserInfo.Row > 0 And MsFGUserInfo.Row < MsFGUserInfo.Rows - 1 Then
        If MsFGUserInfo.Text = StrUserName Then             '禁止用户删除当前用户
            MsgBox "不能删除当前用户....", vbCritical + vbOKOnly, "删除错误"
        Else
            If MsgBox("是否真的要删除用户：" & MsFGUserInfo.Text, vbInformation + vbYesNo, "删除用户") = vbYes Then
                MsFGUserInfo.RemoveItem MsFGUserInfo.Row
            End If
        End If
    Else
        MsFGUserInfo.Row = MsFGUserInfo.Rows - 1
        If MsFGUserInfo.Text = StrUserName Then
            MsgBox "不能删除当前用户....", vbCritical + vbOKOnly, "删除错误"        '禁止用户删除当前用户
        Else
            If MsgBox("是否真的要删除用户：" & MsFGUserInfo.Text, vbInformation + vbYesNo, "删除用户") = vbYes Then
                MsFGUserInfo.RemoveItem MsFGUserInfo.Row
            End If
        End If
    End If
    Exit Sub
Err_Del:
    If Err.Number = 30015 Then
        MsgBox "至少要有一条记录存在", vbCritical + vbOKOnly, "删除错误"
    End If
End Sub


Private Sub cmdModiUser_Click()
    frmModiUser.Show vbModal
End Sub

Private Sub cmdNew_Click()
    frmAddUser.Show vbModal
End Sub



Private Sub Form_Load()
Dim intIndex As Integer
Set Rst = Nothing
Call Fun_Rst("Select * from sysUser")

On Error GoTo Err_User          '打开记录集

    MsFGUserInfo.MergeCells = flexMergeFree     '初始化MSFlexGrid
    MsFGUserInfo.Row = 0
    MsFGUserInfo.ColWidth(0) = 600                '设定第一列宽为600
    For intIndex = 1 To MsFGUserInfo.Cols - 1     '合并第一行
        MsFGUserInfo.Col = intIndex
        MsFGUserInfo.Text = "用户信息列表"
        MsFGUserInfo.ColWidth(intIndex) = 1100

    Next intIndex
    MsFGUserInfo.MergeRow(0) = True
    
    MsFGUserInfo.Row = 1
    MsFGUserInfo.Col = 0
    MsFGUserInfo.Text = "序号"
    
    MsFGUserInfo.Col = 1
    MsFGUserInfo.Text = "用户名"

    MsFGUserInfo.Col = 2
    MsFGUserInfo.Text = "注册日期"

    MsFGUserInfo.Col = 3
    MsFGUserInfo.Text = "注销日期"
    
    MsFGUserInfo.Col = 4
    MsFGUserInfo.Text = "状态"
    
    MsFGUserInfo.Col = 5
    MsFGUserInfo.Text = "权限"
    
    MsFGUserInfo.Col = 6
    MsFGUserInfo.Text = "备注"

    
    Rst.MoveFirst
    intIndex = 1
    Do While Rst.EOF = False    '从数据库中读取记录到MsFlexGrid
        MsFGUserInfo.Row = MsFGUserInfo.Rows - 1
        MsFGUserInfo.Col = 0
        MsFGUserInfo.Text = intIndex
        MsFGUserInfo.Col = 1
        MsFGUserInfo.Text = Rst.Fields("Username")
        MsFGUserInfo.Col = 2
        MsFGUserInfo.Text = Rst.Fields("RegisterDate")
        MsFGUserInfo.Col = 3
        MsFGUserInfo.Text = Rst.Fields("Logoutdate")
        MsFGUserInfo.Col = 4
        MsFGUserInfo.Text = Rst.Fields("status")
        MsFGUserInfo.Col = 5
        MsFGUserInfo.Text = Rst.Fields("popedom")
        MsFGUserInfo.Col = 6
        MsFGUserInfo.Text = Rst.Fields("remark")
        intIndex = intIndex + 1
        Rst.MoveNext
        If Not Rst.EOF Then
            MsFGUserInfo.AddItem ""
        End If
    Loop
    Exit Sub
Err_User:
    If Err.Number = 94 Then
        Resume Next
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    If IfSave = False Then
        If MsgBox("您尚未保存数据" & vbCrLf & "是否保存所作的更改", vbYesNo + vbInformation, "保存") = vbYes Then
            Call cmdAdd_Click
        End If
    End If
End Sub



Private Sub MsFGUserInfo_Click()
    Dim intCol As Integer
    Dim intRow As Integer
    Dim TmpRow As Integer
    TmpRow = MsFGUserInfo.Row
    For intRow = 2 To MsFGUserInfo.Rows - 1
        MsFGUserInfo.Row = intRow
        If TmpRow = intRow Then
            For intCol = 1 To MsFGUserInfo.Cols - 1
                MsFGUserInfo.Col = intCol
                MsFGUserInfo.CellForeColor = vbYellow
                MsFGUserInfo.CellBackColor = &H8000000D
            Next intCol
        Else
            For intCol = 1 To MsFGUserInfo.Cols - 1
                MsFGUserInfo.Col = intCol
                MsFGUserInfo.CellBackColor = vbWhite
                MsFGUserInfo.CellForeColor = vbBlack
            Next intCol
        End If
    Next intRow
    MsFGUserInfo.Row = TmpRow
End Sub