frmstuffmanage.frm

工资管理系统

      AutoSize        =   -1  'True
      Caption         =   "所属部门"
      Height          =   180
      Left            =   608
      TabIndex        =   20
      Top             =   768
      Width           =   720
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "员工编号"
      Height          =   180
      Left            =   3158
      TabIndex        =   19
      Top             =   403
      Width           =   720
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "员工姓名"
      Height          =   180
      Left            =   608
      TabIndex        =   15
      Top             =   403
      Width           =   720
   End
End
Attribute VB_Name = "StuffManage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim isAdding As Boolean
Dim objCn As Connection, objRs As Recordset
Private Sub cmdExit_Click()
    Unload Me               '关闭员工信息管理窗体
End Sub

Private Sub cmdRefresh_Click()
    objRs.Requery       '刷新记录集数据
    ShowCurrentRecord
    cmdAdd.Enabled = True
    cmdDelete.Enabled = True
    isAdding = False
    picNavigation.Enabled = True
End Sub

Private Sub Form_Load()
    On Error GoTo DealError
    '建立数据库连接
    Set objCn = New Connection
    strcn = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                    "Data Source=" & App.Path & "\数据库\工资管理.mdb"
     objCn.ConnectionString = strcn
     objCn.Open
        
    '创建RecordSet对象，获取员工信息数据
    Set objRs = New Recordset
    Set objRs.ActiveConnection = objCn
    objRs.CursorLocation = adUseClient
    objRs.CursorType = adOpenDynamic
    objRs.LockType = adLockOptimistic
    strsql = "SELECT * FROM 员工信息"
    objRs.Open strsql
    
    '显示第一条记录
    ShowCurrentRecord
    Exit Sub
DealError:
    msg = "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
    ShowError msg
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set objRs = Nothing
    objCn.Close
    Set objCn = Nothing
End Sub

Private Sub cmdAdd_Click()
    txtUser = ""
    txtDept = ""
    txtBirth = ""
    txtTime = ""
    txtNum = ""
    cmbDuty.ListIndex = 4
    cmbTitle.ListIndex = 4
    chkHouse = 0
    chkExpert = 0
    txtNews = "添加新记录"
    isAdding = True
    cmdAdd.Enabled = False          '在保存新记录之前禁用控件
    cmdDelete.Enabled = False
    picNavigation.Enabled = False
End Sub

Private Sub cmdDelete_Click()
    On Error GoTo DealError
    With objRs
        If Not .EOF Then
            If MsgBox("将删除<" & Trim(txtUser) & ">的用户数据，是否继续？", _
                       vbCritical + vbYesNo, "员工信息管理") = vbYes Then
                .Delete
                .MoveNext
                If .EOF And .RecordCount > 0 Then .MoveLast
                ShowCurrentRecord
            End If
        End If
    End With
     Exit Sub
DealError:
     msg = "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
    ShowError msg
End Sub

Private Sub cmdSave_Click()
    On Error GoTo DealError
    If Trim(txtUser) = "" Then
        MsgBox "用户名不能为空！", vbCritical, "员工信息管理"
        txtUser.SetFocus
    ElseIf Not IsDate(txtBirth) Then
        MsgBox "无效的出生日期！", vbCritical, "员工信息管理"
        txtBirth.SetFocus
    ElseIf Trim(txtNum) = "" Then
        MsgBox "员工编号不能为空！", vbCritical, "员工信息管理"
        txtNum.SetFocus
    ElseIf Not IsDate(txtTime) Then
        MsgBox "无效的工作时间！", vbCritical, "员工信息管理"
        txtTime.SetFocus
    Else
        If isRepeat Then
            MsgBox "编号：<" & Trim(txtNum) & ">已被使用，请使用其他编号！", _
            vbCritical, "员工信息管理"
            txtNum.SetFocus
            txtUser.SelStart = 0
        Else
            '保存记录
            If isAdding Then objRs.AddNew
            objRs!编号 = txtNum
            objRs!姓名 = txtUser
            objRs!生日 = txtBirth
            objRs!工作时间 = txtTime
            If txtDept <> "" Then objRs!部门 = txtDept
            objRs!职务 = cmbDuty
            objRs!职称 = cmbTitle
            If chkHouse = 0 Then
                objRs!有住房 = False
            Else
                objRs!有住房 = True
            End If
            If chkExpert = 0 Then
                objRs!是专家 = False
            Else
                objRs!是专家 = True
            End If
            objRs.Update
            MsgBox "数据保存成功！", vbInformation, "员工信息管理"
            cmdAdd.Enabled = True
            cmdDelete.Enabled = True
            isAdding = False
            picNavigation.Enabled = True
            ShowCurrentRecord
        End If
    End If
     Exit Sub
DealError:
     msg = "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
    ShowError msg
End Sub

Private Sub cmdMove_Click(Index As Integer)
    On Error GoTo DealError
    With objRs
        Select Case Index       '切换当前记录
            Case 0              '使第一个记录成为当前记录
                If .RecordCount > 0 And Not .BOF Then .MoveFirst
            Case 1              '使上一个记录成为当前记录
                If .RecordCount > 0 And Not .BOF Then
                    .MovePrevious
                    If .BOF Then .MoveFirst
                End If
            Case 2              '使下一个记录成为当前记录
                If .RecordCount > 0 And Not .EOF Then
                    .MoveNext
                    If .EOF Then .MoveLast
                End If
            Case 3              '使最后一个记录成为当前记录
                If .RecordCount > 0 And Not .EOF Then .MoveLast
        End Select
        ShowCurrentRecord
    End With
     Exit Sub
DealError:
     msg = "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
    ShowError msg
End Sub

Private Sub ShowCurrentRecord()
    On Error GoTo DealError
    If objRs.BOF And objRs.EOF Then
       txtNews = "记录：无"
    Else
        txtNum = objRs!编号
        txtUser = objRs!姓名
        txtBirth = objRs!生日
        txtTime = objRs!工作时间
        txtDept = objRs!部门
        Select Case objRs!职务
            Case "正处"
                cmbDuty.ListIndex = 0
            Case "副处"
                cmbDuty.ListIndex = 1
            Case "正科"
                cmbDuty.ListIndex = 2
            Case "副科"
                cmbDuty.ListIndex = 3
            Case "一般"
                cmbDuty.ListIndex = 4
        End Select
        Select Case objRs!职称
            Case "正高"
                cmbTitle.ListIndex = 0
            Case "副高"
                cmbTitle.ListIndex = 1
            Case "中级"
                cmbTitle.ListIndex = 2
            Case "初级"
                cmbTitle.ListIndex = 3
            Case "普通"
                cmbTitle.ListIndex = 4
        End Select
        If objRs!有住房 Then
            chkHouse = 1
        Else
            chkHouse = 0
        End If
        If objRs!是专家 Then
            chkExpert = 1
        Else
            chkExpert = 0
        End If
       '显示当前记录编号和记录总数
       txtNews = "记录：" & objRs.AbsolutePosition & "/" & objRs.RecordCount
    End If
     Exit Sub
DealError:
     msg = "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
    ShowError msg
End Sub

Private Function isRepeat() As Boolean
    '检查当前修改后的数据是否重复
    Dim objCopy As New Recordset
    Set objCopy = objRs.Clone
    If objCopy.RecordCount > 0 Then
        objCopy.MoveFirst
        objCopy.Find "编号='" & Trim(txtNum) & "'"
        If objCopy.EOF Then
            isRepeat = False
        ElseIf isAdding Then
            isRepeat = True
        ElseIf objCopy.AbsolutePosition <> objRs.AbsolutePosition Then
            isRepeat = True
        Else
            isRepeat = False
        End If
    Else
        isRepeat = False
    End If
    Set objCopy = Nothing
End Function