frmoptions.frm

人事资源管理系统

End If
'提示警告信息
str = MsgBox("是否删除当前记录？", vbOKCancel, "删除当前记录")
If str = vbOK Then
 Select Case tbsOptions.SelectedItem.Index
    Case 1 '当前标签是职务设置
        txtTest = "select DutyId from tbDuty where DutyId ='" + Trim(txtId.Text) + "'"
        If DBExist(txtTest) = 0 Then
            MsgBox "无此记录！", vbOKOnly + vbExclamation, "警告"
            txtId.BackColor = BLUE
            txtId.SetFocus
         Else
         txtTest = "select * from tbEmployee where DutyId ='" + Trim(txtId.Text) + "'"
            If DBExist(txtTest) <> 0 Then
                MsgBox "该记录在职员表中被引用，不能删除！", vbOKOnly + vbExclamation, "警告"
                txtId.BackColor = BLUE
            Else
                txtSQLUpdate = "delete from tbDuty where DutyId='" + Trim(txtId.Text) + "'"
                results = ExecuteSQL(txtSQLUpdate, rstOption, True)
                MsgBox "删除成功！", vbOKOnly + vbExclamation, "警告"
                txtId.Text = ""
                txtName.Text = ""
                txtSQL = "select DutyId as 职务编号,DutyName as 职务名称 from tbDuty order by DutyId"
                result = viewData(txtSQL, dgBasicData)
            End If
        End If
    Case 2   '当前标签是民族设置
        txtTest = "select NationId from tbNation where NationId ='" + Trim(txtId.Text) + "'"
        If DBExist(txtTest) = 0 Then
            MsgBox "无此记录！", vbOKOnly + vbExclamation, "警告"
            txtId.BackColor = BLUE
            txtId.SetFocus
         Else
         txtTest = "select * from tbEmployee where NationId ='" + Trim(txtId.Text) + "'"
            If DBExist(txtTest) <> 0 Then
                MsgBox "该记录在职员表中被引用，不能删除！", vbOKOnly + vbExclamation, "警告"
                txtId.BackColor = BLUE
            Else
                txtSQLUpdate = "delete from tbNation where NationId='" + Trim(txtId.Text) + "'"
                results = ExecuteSQL(txtSQLUpdate, rstOption, True)
                MsgBox "删除成功！", vbOKOnly + vbExclamation, "警告"
                txtId.Text = ""
                txtName.Text = ""
                txtSQL = "select NationId as 民族编号,NationName as 民族名称 from tbNation order by NationId"
                result = viewData(txtSQL, dgBasicData)
            End If
        End If
    Case 3 '当前标签是文化程度族设置
        txtTest = "select EduId from tbEdu where EduId ='" + Trim(txtId.Text) + "'"
        If DBExist(txtTest) = 0 Then
            MsgBox "无此记录！", vbOKOnly + vbExclamation, "警告"
            txtId.BackColor = BLUE
            txtId.SetFocus
         Else
         txtTest = "select * from tbEmployee where EduId ='" + Trim(txtId.Text) + "'"
            If DBExist(txtTest) <> 0 Then
                MsgBox "该记录在职员表中被引用，不能删除！", vbOKOnly + vbExclamation, "警告"
                txtId.BackColor = BLUE
            Else
                txtSQLUpdate = "delete from tbEdu where EduId='" + Trim(txtId.Text) + "'"
                results = ExecuteSQL(txtSQLUpdate, rstOption, True)
                MsgBox "删除成功！", vbOKOnly + vbExclamation, "警告"
                txtId.Text = ""
                txtName.Text = ""
                txtSQL = "select EduId as 文化程度编号,EduName as 文化程度名称 from tbEdu order by EduId"
                result = viewData(txtSQL, dgBasicData)
            End If
        End If
 End Select
End If
End Sub
Private Sub cmdModify_Click()
If txtIsNull(txtId) Then
    MsgBox "请选择需要修改的记录！", vbOKOnly + vbExclamation, "警告"
    Exit Sub
End If
If txtIsNull(txtName) Then
    MsgBox "*项目不能为空！", vbOKOnly + vbExclamation, "警告"
    Exit Sub
Else
    If IsOverStringLen(txtName.Text, 20) Then
        MsgBox "名称不能超过20位！", vbOKOnly + vbExclamation, "警告"
        txtName.SetFocus
        txtName.BackColor = BLUE
        Exit Sub
    End If
End If
str = MsgBox("是否修改当前记录？", vbOKCancel, "修改当前记录") '提示警告信息
If str = vbOK Then
 Select Case tbsOptions.SelectedItem.Index
    Case 1 '当前标签是职务设置
        txtTest = "select DutyId from tbDuty where DutyId ='" + Trim(txtId.Text) + "'"
        If DBExist(txtTest) = 0 Then
            MsgBox "无此记录！", vbOKOnly + vbExclamation, "警告"
            txtId.BackColor = BLUE
         Else
            txtSQLUpdate = "update tbDuty set DutyId = '" + Trim(txtId.Text) + "',DutyName = '" + Trim(txtName.Text)
            txtSQLUpdate = txtSQLUpdate + "' where DutyId='" + Trim(txtId.Text) + "'"
            results = ExecuteSQL(txtSQLUpdate, rstOption, True)
            MsgBox "修改成功！", vbOKOnly + vbExclamation, "警告"
            txtSQL = "select DutyId as 职务编号,DutyName as 职务名称 from tbDuty order by DutyId"
            result = viewData(txtSQL, dgBasicData)
        End If
    Case 2   '当前标签是民族设置
        txtTest = "select NationId from tbNation where NationId ='" + Trim(txtId.Text) + "'"
        If DBExist(txtTest) = 0 Then
            MsgBox "无此记录！", vbOKOnly + vbExclamation, "警告"
            txtId.BackColor = BLUE
         Else
            txtSQLUpdate = "update tbNation set NationId = '" + Trim(txtId.Text) + "',NationName = '" + Trim(txtName.Text)
            txtSQLUpdate = txtSQLUpdate + "' where NationId='" + Trim(txtId.Text) + "'"
            results = ExecuteSQL(txtSQLUpdate, rstOption, True)
            MsgBox "修改成功！", vbOKOnly + vbExclamation, "警告"
            txtSQL = "select NationId as 民族编号,NationName as 民族名称 from tbNation order by NationId"
            result = viewData(txtSQL, dgBasicData)
        End If
    Case 3 '当前标签是文化程度族设置
        txtTest = "select EduId from tbEdu where EduId ='" + Trim(txtId.Text) + "'"
        If DBExist(txtTest) = 0 Then
            MsgBox "无此记录！", vbOKOnly + vbExclamation, "警告"
            txtId.BackColor = BLUE
         Else
            txtSQLUpdate = "update tbEdu set EduId = '" + Trim(txtId.Text) + "',EduName = '" + Trim(txtName.Text)
            txtSQLUpdate = txtSQLUpdate + "' where EduId='" + Trim(txtId.Text) + "'"
            results = ExecuteSQL(txtSQLUpdate, rstOption, True)
            MsgBox "修改成功！", vbOKOnly + vbExclamation, "警告"
            txtSQL = "select EduId as 文化程度编号,EduName as 文化程度名称 from tbEdu order by EduId"
            result = viewData(txtSQL, dgBasicData)
        End If
 End Select
End If
End Sub
Private Sub cmdOK_Click()
If txtIsNull(txtId) Then '检验输入值不能为空
    MsgBox "*项目不能为空！", vbOKOnly + vbExclamation, "警告"
    Exit Sub
Else
Select Case tbsOptions.SelectedItem.Index
    Case 1 '当前标签是职务设置
        If Not ISEquelLen(txtId, 8) Then
            MsgBox "职务编号为8位！", vbOKOnly + vbExclamation, "警告"
            Exit Sub
        End If
    Case 2   '当前标签是民族设置
        If Not ISEquelLen(txtId, 3) Then
            MsgBox "民族编号为3位！", vbOKOnly + vbExclamation, "警告"
            Exit Sub
        End If
    Case 3 '当前标签是文化程度族设置
        If Not ISEquelLen(txtId, 2) Then
            MsgBox "学历编号为2位！", vbOKOnly + vbExclamation, "警告"
            Exit Sub
        End If
End Select
If txtIsNull(txtName) Then
    MsgBox "*项目不能为空！", vbOKOnly + vbExclamation, "警告"
    Exit Sub
Else
    If IsOverStringLen(txtName.Text, 20) Then
        MsgBox "名称不能超过20位！", vbOKOnly + vbExclamation, "警告"
        txtName.SetFocus
        txtName.BackColor = BLUE
        Exit Sub
    End If
End If
Select Case tbsOptions.SelectedItem.Index
    Case 1 '当前标签是职务设置
        '检验此编号是否已经存在
        txtTest = "select DutyId from tbDuty where DutyId ='" + Trim(txtId.Text) + "'"
        If DBExist(txtTest) <> 0 Then
            MsgBox "编号已经存在，请重新输入！", vbOKOnly + vbExclamation, "警告"
            txtId.BackColor = BLUE
        Else
            txtSQLUpdate = "insert into tbDuty(DutyId,DutyName)" + "values('" + Trim(txtId.Text) + "','" + Trim(txtName.Text) + "')"
            results = ExecuteSQL(txtSQLUpdate, rstOption, True)
            txtSQL = "select DutyId as 职务编号,DutyName as 职务名称 from tbDuty order by DutyId"
            result = viewData(txtSQL, dgBasicData)
            MsgBox "添加成功！", vbOKOnly + vbExclamation, "警告"
        End If
    Case 2 '当前标签是民族设置
        '检验此编号是否已经存在
        txtTest = "select NationId from tbNation where NationId ='" + Trim(txtId.Text) + "'"
        If DBExist(txtTest) <> 0 Then
            MsgBox "编号已经存在，请重新输入！", vbOKOnly + vbExclamation, "警告"
            txtId.BackColor = BLUE
        Else
            txtSQLUpdate = "insert into tbNation(NationId,NationName)" + "values('" + Trim(txtId.Text) + "','" + Trim(txtName.Text) + "')"
            results = ExecuteSQL(txtSQLUpdate, rstOption, True)
            txtSQL = "select NationId as 民族编号,NationName as 民族名称 from tbNation order by NationId"
            result = viewData(txtSQL, dgBasicData)
            MsgBox "添加成功！", vbOKOnly + vbExclamation, "警告"
        End If
    Case 3 '当前标签是文化程度族设置
            '检验此编号是否已经存在
            txtTest = "select EduId from tbEdu where EduId ='" + Trim(txtId.Text) + "'"
        If DBExist(txtTest) <> 0 Then
            MsgBox "编号已经存在，请重新输入！", vbOKOnly + vbExclamation, "警告"
            txtId.BackColor = BLUE
        Else
            txtSQLUpdate = "insert into tbEdu(EduId,EduName)" + "values('" + Trim(txtId.Text) + "','" + Trim(txtName.Text) + "')"
            results = ExecuteSQL(txtSQLUpdate, rstOption, True)
            txtSQL = "select EduId as 文化程度编号,EduName as 文化程度名称 from tbEdu order by EduId"
            result = viewData(txtSQL, dgBasicData)
            MsgBox "添加成功！", vbOKOnly + vbExclamation, "警告"
    End If
  End Select
End If
End Sub
Private Sub dgBasicData_RowColChange(LastRow As Variant, ByVal LastCol As Integer)
    'dg的RowColChange事件，用来获取鼠标点击到的dg的单元格
If result <> 0 Then
    txtId.Text = dgBasicData.Columns(0).Text
    txtName.Text = dgBasicData.Columns(1).Text
End If
End Sub
' ******************************************************************************
'过程名：Form_KeyDown
'说  明：处理 ctrl+tab 键来移动到下一个选项，选项对话框自动生成
'参  数：KeyCode As Integer, Shift As Integer
'返回值：无
' ******************************************************************************
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim i As Integer
    '处理 ctrl+tab 键来移动到下一个选项
    If Shift = vbCtrlMask And KeyCode = vbKeyTab Then
        i = tbsOptions.SelectedItem.Index
        If i = tbsOptions.Tabs.Count Then
            '已到达最后的选项,转回到选项 1
            Set tbsOptions.SelectedItem = tbsOptions.Tabs(1)
        Else
            '递增选项
            Set tbsOptions.SelectedItem = tbsOptions.Tabs(i + 1)
        End If
    End If
End Sub
' ******************************************************************************
'过程名：Form_Load
'说  明：窗体加载事件
'参  数：无
'返回值：无
' ******************************************************************************
Private Sub Form_Load()
    '置中窗体
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
    lblId.Caption = "职务编号"
    lblName.Caption = "职务名称"
    '窗体第一次加载，表格中显示职务信息
    txtSQL = "select DutyId as 职务编号,DutyName as 职务名称 from tbDuty order by DutyId"
    result = viewData(txtSQL, dgBasicData)
End Sub
' ******************************************************************************
'过程名：tbsOptions_Click
'说  明：点击窗体上的标签，显示不同的窗体内容
'参  数：无
'返回值：无
' ******************************************************************************
Private Sub tbsOptions_Click()
 Select Case tbsOptions.SelectedItem.Index
    Case 1
        lblId.Caption = "职务编号"
        lblName.Caption = "职务名称"
        txtSQL = "select DutyId as 职务编号,DutyName as 职务名称 from tbDuty order by DutyId"
        result = viewData(txtSQL, dgBasicData)
        txtId.Text = ""
        txtName.Text = ""
    Case 2
        lblId.Caption = "民族编号"
        lblName.Caption = "民族名称"
        txtSQL = "select NationId as 民族编号,NationName as 民族名称 from tbNation order by NationId"
        result = viewData(txtSQL, dgBasicData)
        txtId.Text = ""
        txtName.Text = ""
    Case 3
        lblId.Caption = "文化程度编号"
        lblName.Caption = "文化程度名称"
        txtSQL = "select EduId as 文化程度编号,EduName as 文化程度名称 from tbEdu order by EduId"
        result = viewData(txtSQL, dgBasicData)
        txtId.Text = ""
        txtName.Text = ""
    Case Else
        lblId.Caption = ""
        lblName.Caption = ""
        txtId.Text = ""
        txtName.Text = ""
 End Select
End Sub
Private Sub txtId_Change()
 txtId.BackColor = WHITE  '当编号内容改变时恢复白色背景
End Sub
Private Sub txtName_Change()
txtName.BackColor = WHITE   '当编号内容改变时恢复白色背景
End Sub