e奖惩录入.frm

人事管理系统:包括员工公资的管理,考勤的管理,还有各种考核等功能

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomct2.ocx"
Begin VB.Form E奖惩录入 
   Caption         =   "奖惩录入"
   ClientHeight    =   4005
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   8295
   LinkTopic       =   "Form1"
   ScaleHeight     =   4005
   ScaleWidth      =   8295
   StartUpPosition =   3  'Windows Default
   Begin VB.Frame Frame 
      Caption         =   "奖惩录入"
      Height          =   3735
      Index           =   0
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   8175
      Begin VB.Frame FrameList 
         Caption         =   "学生奖惩信息列表"
         Height          =   3375
         Left            =   120
         TabIndex        =   15
         Top             =   240
         Width           =   2175
         Begin VB.ListBox ListJCxx 
            Height          =   2400
            ItemData        =   "E奖惩录入.frx":0000
            Left            =   120
            List            =   "E奖惩录入.frx":0007
            TabIndex        =   16
            Top             =   600
            Width           =   1935
         End
         Begin VB.Label LblNotes 
            Height          =   375
            Left            =   120
            TabIndex        =   17
            Top             =   240
            Width           =   1935
         End
      End
      Begin VB.Frame FrameInfo 
         Caption         =   "奖惩信息"
         Height          =   3375
         Left            =   2400
         TabIndex        =   1
         Top             =   240
         Width           =   5655
         Begin VB.TextBox txtDep 
            Height          =   375
            Left            =   3360
            TabIndex        =   20
            Top             =   960
            Width           =   1935
         End
         Begin VB.TextBox txtName 
            Height          =   375
            Left            =   3360
            TabIndex        =   19
            Top             =   480
            Width           =   1935
         End
         Begin VB.Frame Frame2 
            Height          =   645
            Index           =   0
            Left            =   120
            TabIndex        =   5
            Top             =   2640
            Width           =   5475
            Begin VB.CommandButton CmdSave 
               BackColor       =   &H00C0C0C0&
               Caption         =   "保存"
               Height          =   360
               Left            =   2640
               Style           =   1  'Graphical
               TabIndex        =   6
               Top             =   195
               Width           =   800
            End
            Begin VB.CommandButton CmdModify 
               BackColor       =   &H00C0C0C0&
               Caption         =   "修改"
               Height          =   360
               Left            =   1065
               Style           =   1  'Graphical
               TabIndex        =   11
               Top             =   195
               Width           =   800
            End
            Begin VB.CommandButton CmdExit 
               BackColor       =   &H00C0C0C0&
               Caption         =   "退出"
               Height          =   360
               Left            =   4245
               Style           =   1  'Graphical
               TabIndex        =   10
               Top             =   195
               Width           =   800
            End
            Begin VB.CommandButton CmdCancel 
               BackColor       =   &H00C0C0C0&
               Caption         =   "取消"
               Height          =   360
               Left            =   3450
               Style           =   1  'Graphical
               TabIndex        =   9
               Top             =   195
               Width           =   800
            End
            Begin VB.CommandButton CmdDelete 
               BackColor       =   &H00C0C0C0&
               Caption         =   "删除"
               Height          =   360
               Left            =   1860
               Style           =   1  'Graphical
               TabIndex        =   8
               Top             =   195
               Width           =   800
            End
            Begin VB.CommandButton CmdAdd 
               BackColor       =   &H00C0C0C0&
               Caption         =   "添加"
               Height          =   360
               Left            =   255
               Style           =   1  'Graphical
               TabIndex        =   7
               Top             =   195
               Width           =   800
            End
         End
         Begin VB.TextBox txtReason 
            Height          =   855
            Left            =   840
            MaxLength       =   50
            MultiLine       =   -1  'True
            ScrollBars      =   2  'Vertical
            TabIndex        =   4
            Top             =   1560
            Width           =   4455
         End
         Begin VB.ComboBox CboSelect 
            Height          =   315
            Left            =   840
            TabIndex        =   3
            Top             =   480
            Width           =   1695
         End
         Begin MSComCtl2.DTPicker DTPicker1 
            Height          =   375
            Left            =   840
            TabIndex        =   2
            Top             =   960
            Width           =   1695
            _ExtentX        =   2990
            _ExtentY        =   661
            _Version        =   393216
            Format          =   66977793
            CurrentDate     =   38891
         End
         Begin VB.Label Label1 
            Caption         =   "单位："
            Height          =   375
            Index           =   1
            Left            =   2640
            TabIndex        =   21
            Top             =   1080
            Width           =   855
         End
         Begin VB.Label Label1 
            Caption         =   "名称："
            Height          =   375
            Index           =   0
            Left            =   2640
            TabIndex        =   18
            Top             =   600
            Width           =   855
         End
         Begin VB.Label Label5 
            Caption         =   "类别："
            Height          =   255
            Index           =   1
            Left            =   120
            TabIndex        =   14
            Top             =   480
            Width           =   615
         End
         Begin VB.Label Label7 
            Caption         =   "日期："
            Height          =   375
            Index           =   1
            Left            =   120
            TabIndex        =   13
            Top             =   1080
            Width           =   975
         End
         Begin VB.Label Label5 
            Caption         =   "原因："
            Height          =   255
            Index           =   2
            Left            =   120
            TabIndex        =   12
            Top             =   1680
            Width           =   1335
         End
      End
   End
End
Attribute VB_Name = "E奖惩录入"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim rs As ADODB.Recordset
Dim SQL As String
Dim msg As String
Dim Index As Integer
Dim stuNo As String
Dim flag As String '判断是新增加记录还是修改记录
Private Sub FixData()
    Dim Name As String
    '显示奖惩具体信息
    If ListJCxx.ListCount > 0 Then
        Name = Left(Trim(ListJCxx.Text), InStr(Trim(ListJCxx.Text), ":") - 1)
    Else
        Exit Sub
    End If
    LblNotes.Caption = stuNo & "号学生奖惩"
    '查询数据
    rs.MoveFirst
    rs.Find ("名称='" & Name & "'")
    '显示数据
    CboSelect.Text = Trim(rs.Fields("类别"))
    txtName.Text = Trim(rs.Fields("名称"))
    txtDep.Text = Trim(rs.Fields("单位"))
    If IsDate(Trim(rs.Fields("日期"))) Then
        DTPicker1.Value = Trim(rs.Fields("日期")) '时间控件
    End If
    txtReason.Text = Trim(rs.Fields("原因"))
    '控件可用性
    CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
    CmdSave.Enabled = False: CmdCancel.Enabled = False
End Sub
Private Function CheckData() As Boolean
    '检查数据的合法性
    Dim rst As ADODB.Recordset
    '检查非空性
    If (Trim(txtName.Text) = "") Then
        MsgBox ("名称不能为空！")
        CheckData = False
        Exit Function
    End If
    '检查唯一性
    SQL = " select 奖惩ID from 奖惩信息表 where " & "学号='"
    SQL = SQL & stuNo & "' and 名称='" & Trim(txtName.Text) & "'"
    Set rst = SelectSQL(SQL, msg)
    If flag = "Add" And rst.RecordCount > 0 Then
        MsgBox ("名称重复，重复添加!")
        rst.Close
        CheckData = False
        Exit Function
    End If
    CheckData = True '合法
End Function
Private Sub ControlActiveX(kind As String, flag As Boolean)
'控制控件
    If kind = "Add" Or kind = "Delete" Or kind = "Save" Then
        CboSelect.ListIndex = 0
        txtName.Text = ""
        txtDep.Text = ""
        DTPicker1.Refresh
        txtReason.Text = ""
    End If
    CboSelect.Enabled = flag
    If kind = "Modify" Then
        txtName.Enabled = False
    Else
        txtName.Enabled = flag
    End If
    txtDep.Enabled = flag
    DTPicker1.Enabled = flag
    txtReason.Enabled = flag
    ListJCxx.Enabled = Not flag
End Sub
Private Sub LoadData()
    Dim strItem As String
    '得到学生的奖惩信息
    SQL = " select * from 奖惩信息表"
    SQL = SQL & " where 学号='" & stuNo & "'  order by 奖惩ID"
    Set rs = Nothing
    Set rs = SelectSQL(SQL, msg)
    ListJCxx.Clear
    If rs.RecordCount > 0 Then
        Do While (Not rs.EOF) And (Not rs.BOF)
            strItem = Trim(rs.Fields(3)) & ":" & Trim(rs.Fields(2))
            ListJCxx.AddItem (strItem)
            rs.MoveNext
        Loop
        rs.MoveFirst
        ListJCxx.ListIndex = 0
    Else
        MsgBox ("目前没有奖惩信息！")
        '控件可用性
        CmdAdd.Enabled = True: CmdModify.Enabled = False: CmdDelete.Enabled = False
        CmdCancel.Enabled = False: CmdSave.Enabled = False
        Exit Sub
    End If
    Call FixData '在文本框中显示详细信息
    '控件可用性
    CmdAdd.Enabled = True: CmdModify.Enabled = True: CmdDelete.Enabled = True
    CmdCancel.Enabled = False: CmdSave.Enabled = False
End Sub
Private Sub CboStu_Click()
    Call LoadData  '重新装载数据
End Sub
Private Sub CmdAdd_Click()
    Call ControlActiveX("Add", True)
    '设置标志flag
    flag = "Add"
    '添加、修改、删除按钮不可用，取消、保存按钮可用
    CmdAdd.Enabled = False: CmdModify.Enabled = False: CmdDelete.Enabled = False
    CmdCancel.Enabled = True: CmdSave.Enabled = True
End Sub
Private Sub CmdModify_Click()
    '修改操作
    If rs.RecordCount > 0 Then
        '可用性
        Call ControlActiveX("Modify", True)
        '设置标志flag
        flag = "Modify"
        '添加、修改、删除按钮不可用，取消、保存按钮可用
        CmdCancel.Enabled = True: CmdSave.Enabled = True
        CmdAdd.Enabled = False: CmdModify.Enabled = False: CmdDelete.Enabled = False
    Else
        MsgBox ("没有可以修改的数据!")
    End If
End Sub
Private Sub CmdDelete_Click()
'删除操作
    On Error GoTo ErrMsg
    If txtName.Text = "" Then
        MsgBox ("选择需要删除的异动信息！")
        Exit Sub
    End If
    If rs.RecordCount > 0 Then
        msg = MsgBox("删除该条记录吗?", vbYesNo)
        If msg = vbYes Then
            rs.Delete
            Call LoadData '重新装载数据
            '清空文本框,重新设置下拉框
            Call ControlActiveX("Delete", False)
            '按钮可用性处理
            CmdAdd.Enabled = True: CmdModify.Enabled = False: CmdDelete.Enabled = True
            CmdSave.Enabled = False: CmdCancel.Enabled = False
            MsgBox ("成功删除的数据!")
        End If
    Else
        MsgBox ("没有可删除的数据!")
    End If
    Exit Sub
ErrMsg:
         MsgBox Err.Description, vbExclamation, "出错"
End Sub
Private Sub cmdCancel_Click()
    '取消操作
    Call FixData '设置数据
    ListJCxx.Enabled = True
    '修改、删除、添加按钮可用,保存和取消按钮不可用
    CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
    CmdSave.Enabled = False: CmdCancel.Enabled = False
End Sub
Private Sub setData()
    rs.Fields("学号") = stuNo
    rs.Fields("类别") = Trim(CboSelect.Text)
    rs.Fields("名称") = Trim(txtName.Text)
    rs.Fields("日期") = Trim(DTPicker1.Value)
    rs.Fields("单位") = Trim(txtDep.Text)
    rs.Fields("原因") = Trim(txtReason.Text)
End Sub
Private Sub CmdSave_Click()
'保存操作
    On Error GoTo ErrMsg
    If Not CheckData Then Exit Sub '如果数据不合法退出
    If flag = "Modify" Then '如果是修改数据
        msg = MsgBox("您确实要修改这条数据吗?", vbYesNo)
        If msg = vbYes Then
            Call setData '赋值
        Else
            Exit Sub
        End If
    ElseIf flag = "Add" Then '如果是添加新数据
        rs.AddNew
        Call setData
    End If
    '更新数据处理控件
    rs.Update
    Call LoadData '重新装载数据
    '控件清空和可用性
    Call ControlActiveX("Save", False)
    CmdModify.Enabled = True: CmdDelete.Enabled = True: CmdAdd.Enabled = True
    CmdSave.Enabled = False: CmdCancel.Enabled = False
    If flag = "Add" Then
        MsgBox ("成功添加数据!")
    Else
        MsgBox ("成功更新数据!")
    End If
    Exit Sub
ErrMsg:
       MsgBox Err.Description, vbExclamation, "出错"
End Sub
Private Sub CmdExit_Click()
'退出操作
    学生档案管理.Enabled = True
    rs.Close
    E奖惩查询.Enabled = True
    Unload Me
End Sub
Private Sub Form_Load()
     Dim strItem As String
     '得到学号
     stuNo = E奖惩查询.strQuery
    '初始化下拉框
     CboSelect.AddItem "奖励"
     CboSelect.AddItem "惩处"
     CboSelect.ListIndex = 0
     Call LoadData '装载学生奖惩数据
End Sub
Private Sub Form_Unload(Cancel As Integer)
'退出操作
    学生档案管理.Enabled = True
    E奖惩查询.Enabled = True
    Unload Me
End Sub
Private Sub ListJCxx_Click()
    Call FixData
End Sub