frmbaseinputnew.frm

教务管理系统,用VB 完成,以SQL SERVER 2000作为后台数据库

    End If
    
    

End Sub

Private Sub cboZZMM_KeyPress(KeyAscii As Integer)
Dim sqlModify As String

If KeyAscii = 13 Then

    If bModify Then
        'If MsgBox("确信要修改?", vbQuestion + vbYesNo, "删除前询问") = vbYes Then
            sqlModify = "update zbqkb set zzmm='" + Trim(cboZZMM) + "' where id=" + Trim(rec!ID) + ""
            dbStudent.Execute sqlModify
        'End If
    End If
    
    txtZY.SetFocus
End If
End Sub

Private Sub cboZZMM_LostFocus()
Dim sqlModify As String
    If bModify Then
        'If MsgBox("确信要修改?", vbQuestion + vbYesNo, "删除前询问") = vbYes Then
            sqlModify = "update zbqkb set zzmm='" + Trim(cboZZMM) + "' where id=" + Trim(rec!ID) + ""
            dbStudent.Execute sqlModify
        'End If
    End If
    
    

End Sub

Private Sub cmdAddnew_Click()
AddnewStatus
InitItem
ShowStatus
YesEdit
End Sub

Private Sub cmdDelete_Click()
Dim sqlDelete As String
If MsgBox("您确定要删除此记录?", vbQuestion + vbOKCancel) = vbOK Then
    sqlDelete = "delete * from zbqkb where xh='" + Trim(rec!XH) + "'"
    dbStudent.Execute sqlDelete
    sqlDelete = "delete * from jtqkb where xh='" + Trim(txtXH) + "'"
    dbStudent.Execute sqlDelete
    UpdateQuery
Else
    QueryStatus
End If
ShowStatus
End Sub

Private Sub cmdExit_Click()
Unload Me
End Sub

Private Sub cmdFirst_Click()
ShowStatus
StaBar1.Panels.Item(1) = "第" & CStr(BookMark) & "条"
StaBar1.Panels.Item(2) = "库中共有" & CStr(recCount) & "条记录"
If bAddnew Then
    UpdateQuery
End If
If bModify Then
    If MsgBox("要完成当前记录修改?", vbQuestion + vbYesNo) = vbYes Then
        'MsgBox "如果要继续修改" & vbCrLf & "请移到相应记录后" & "按修改键"
        QueryStatus
        rec.MoveFirst
        ShowRecord
        BookMark = 1
    End If

End If
If bQuery Then
    BookMark = 1
    rec.MoveFirst
    ShowRecord
End If
ShowStatus
End Sub

Private Sub cmdLast_Click()
ShowStatus
StaBar1.Panels.Item(1) = "第" & CStr(BookMark) & "条"
StaBar1.Panels.Item(2) = "库中共有" & CStr(recCount) & "条记录"
If bAddnew Then
    UpdateQuery
End If
If bModify Then
    If MsgBox("要完成当前记录修改?", vbQuestion + vbYesNo) = vbYes Then
        'MsgBox "如果要继续修改" & vbCrLf & "请移到相应记录后" & "按修改键"
        QueryStatus
        BookMark = recCount
        rec.MoveLast
        ShowRecord
    End If
End If
If bQuery Then
    BookMark = recCount
    rec.MoveLast
    ShowRecord
End If
ShowStatus
End Sub

Private Sub cmdModify_Click()
If cmdModify.Caption = "修改" Then
ModifyStatus
ShowStatus
YesEdit
cmdPrevious.Enabled = False
cmdNext.Enabled = False
cmdLast.Enabled = False
cmdFirst.Enabled = False
Exit Sub
End If
If cmdModify.Caption = "恢复" Then
QueryStatus
ShowStatus
NOEdit
cmdDelete.Enabled = True
cmdSave.Enabled = True
cmdAddnew.Enabled = True
cmdModify.Caption = "修改"
cmdPrevious.Enabled = True
cmdNext.Enabled = True
cmdLast.Enabled = True
cmdFirst.Enabled = True
End If

End Sub

Private Sub cmdNext_Click()
ShowStatus
StaBar1.Panels.Item(1) = "第" & CStr(BookMark) & "条"
StaBar1.Panels.Item(2) = "库中共有" & CStr(recCount) & "条记录"
If bAddnew Then
    UpdateQuery
End If
If bModify Then
    If MsgBox("要完成当前记录修改?", vbQuestion + vbYesNo) = vbYes Then
        'MsgBox "如果要继续修改" & vbCrLf & "请移到相应记录后" & "按修改键"
        QueryStatus
        If BookMark < recCount Then
            BookMark = BookMark + 1
            rec.MoveNext
        End If
        ShowRecord
     End If
End If
If bQuery Then
    If BookMark = recCount Then
        MsgBox "这是最后一条记录!", vbInformation, "hello"
    Else
        BookMark = BookMark + 1
        rec.MoveNext
        ShowRecord
    End If
End If
ShowStatus
End Sub

Private Sub cmdPrevious_Click()
ShowStatus
StaBar1.Panels.Item(1) = "第" & CStr(BookMark) & "条"
StaBar1.Panels.Item(2) = "库中共有" & CStr(recCount) & "条记录"
If bAddnew Then
    UpdateQuery
End If
If bModify Then
    If MsgBox("要完成当前记录修改?", vbQuestion + vbYesNo) = vbYes Then
        'MsgBox "如果要继续修改" & vbCrLf & "请移到相应记录后" & "按修改键"
        QueryStatus
        If BookMark > 1 Then
            BookMark = BookMark - 1
            rec.MovePrevious
        End If
        ShowRecord
    End If
End If
If bQuery Then
    If BookMark = 1 Then
        MsgBox "这是第一条记录!", vbInformation, "hello"
    Else
        BookMark = BookMark - 1
        rec.MovePrevious
        ShowRecord
    End If
End If
ShowStatus
End Sub

Private Sub cmdSave_Click()
Dim sqlZBQKB As String
Dim sqlJTQKB As String

If CheckItem Then

    '输入基本库数据
    sqlZBQKB = "insert into zbqkb(xh,xm,csny,xb,mz,yx,bj,hksx,nj,sy,zzmm,tc,sfzhm,ltkhm,ss,dh,xl,zy,pyfs,byzx) "
    sqlZBQKB = sqlZBQKB + "values('" + Trim(txtXH) + "','" + Trim(txtXM) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(CDate(txtCSNY)) + "','" + Trim(cboXB) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(cboMZ) + "','" + Trim(cboYX) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(txtBJ) + "','" + Trim(cboHKSX) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(cboNJ) + "','" + Trim(cboSY) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(cboZZMM) + "','" + Trim(txtTC) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(txtSFZHM) + "','" + Trim(txtLTKHM) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(txtSS) + "','" + Trim(txtDH) + "','" + Trim(cboXL) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(txtZY) + "','" + Trim(cboPYFS) + "','" + Trim(txtBYZX) + "')"
    dbStudent.Execute sqlZBQKB
    
    '输入家庭情况表
    sqlJTQKB = "insert into jtqkb(xh,xm,jzxm1,gx1,dw1,ym1,jzxm2,gx2,dw2,ym2,dh1,dh2)"
    sqlJTQKB = sqlJTQKB + "values('" + Trim(txtXH) + "','" + Trim(txtXM) + "',"
    sqlJTQKB = sqlJTQKB + "'" + Trim(txtJZXM1) + "','" + Trim(TXTGX1) + "',"
    sqlJTQKB = sqlJTQKB + "'" + Trim(txtDW1) + "','" + Trim(txtYM1) + "',"
    sqlJTQKB = sqlJTQKB + "'" + Trim(txtJZXM2) + "','" + Trim(txtGX2) + "',"
    sqlJTQKB = sqlJTQKB + "'" + Trim(txtDW2) + "','" + Trim(txtYM2) + "',"
    sqlJTQKB = sqlJTQKB + "'" + Trim(txtDH1) + "','" + Trim(txtDH2) + "')"
    dbStudent.Execute sqlJTQKB
Else
    Exit Sub
End If

InitItem

If MsgBox("继续添加下一条记录?", vbQuestion + vbYesNo, "提示框") = vbNo Then
    UpdateQuery
End If
ShowStatus
End Sub

Private Function CheckItem() As Boolean
'检查数据重复
Dim recRepeat As Recordset
Dim sqlRepeat As String

CheckItem = True
sqlRepeat = "select * from zbqkb where xh='" + Trim(txtXH) + "'"
Set recRepeat = dbStudent.OpenRecordset(sqlRepeat, dbOpenSnapshot)
If recRepeat.RecordCount <> 0 Then
   MsgBox "学号不能重复!", vbInformation + vbOKOnly, "错误"
   txtXH.SetFocus
   CheckItem = False
   recRepeat.Close
   Exit Function
End If

If txtXH = "" Or txtXM = "" Or cboXB = "" Then
    MsgBox "重要数据('学号'或'姓名'或'性别')未填写!", vbInformation + vbOKOnly, "错误"
    CheckItem = False
    If txtXH = "" Then
        txtXH.SetFocus
    End If
    
    If txtXM = "" Then
       txtXM.SetFocus
    End If
    
    If cboXB = "" Then
       cboXB.SetFocus
    End If
    Exit Function
End If
If txtCSNY = " " Then
   txtCSNY = "2000/01/01"
Else
   If Not IsDate(txtCSNY) Then
      MsgBox "日期输入不正确!", vbInformation + vbOKOnly, "错误"
      CheckItem = False
      txtCSNY = ""
      txtCSNY.SetFocus
      Exit Function
   End If
End If


End Function

Public Sub InitItem()
'初始化数据
On Error Resume Next
txtXH = ""
txtXM = ""
txtCSNY = ""
cboXB = ""
cboMZ = ""
cboYX = ""
txtBJ = ""
cboHKSX = ""
cboNJ = ""
cboSY = ""
cboZZMM = ""
txtTC = ""
txtSFZHM = ""
txtLTKHM = ""
txtSS = ""
txtZY = ""
cboPYFS = ""
txtBYZX = ""
txtDH = ""
cboXL = ""
txtJZXM1 = ""
TXTGX1 = ""
txtDW1 = ""
txtYM1 = ""
txtJZXM2 = ""
txtGX2 = ""
txtDW2 = ""
txtYM2 = ""
txtDH1 = ""
txtDH2 = ""
End Sub

Public Sub ComboData()
With cboMZ
  .AddItem "汉族"
  .AddItem "回族"
  .AddItem "藏族"
  .AddItem "满族"
  .AddItem "壮族"
End With
With cboXL
  .AddItem "博士"
  .AddItem "硕士"
  .AddItem "本科"
  .AddItem "大专"
  .AddItem "进修生"
  .AddItem "双学士"
End With
With cboXB
  .AddItem "男"
  .AddItem "女"
End With
With cboSY
  .AddItem "北京"
  .AddItem "天津"
  .AddItem "上海"
  .AddItem "重庆"
  .AddItem "黑龙"
  .AddItem "吉林"
  .AddItem "辽宁"
  .AddItem "内蒙"
  .AddItem "河北"
  .AddItem "河南"
  .AddItem "山西"
  .AddItem "陕西"
  .AddItem "宁夏"
  .AddItem "甘肃"
  .AddItem "青海"
  .AddItem "新疆"
  .AddItem "西藏"
  .AddItem "四川"
  .AddItem "云南"
  .AddItem "贵州"
  .AddItem "广西"
  .AddItem "广东"
  .AddItem "福建"
  .AddItem "江西"
  .AddItem "湖南"
  .AddItem "湖北"
  .AddItem "山东"
  .AddItem "安徽"
  .AddItem "江苏"
  .AddItem "浙江"
End With
With cboYX
  .AddItem "船舶与海洋工程学院"
  .AddItem "动力与能源工程学院"
  .AddItem "电子信息学院"
  .AddItem "电力与能源学院"
  .AddItem "机械工程学院"
  .AddItem "理学院"
  .AddItem "人文社会科学学院"
  .AddItem "生命技术科学学院"
  .AddItem "化学化工学院"
  .AddItem "管理学院"
  .AddItem "建筑工程力学学院"
  .AddItem "外国语学院"
  .AddItem "塑性成形工程系"
  .AddItem "体育系"
End With
With cboNJ
  .AddItem "94级"
  .AddItem "95级"
  .AddItem "96级"
  .AddItem "97级"
  .AddItem "98级"
  .AddItem "99级"
  .AddItem "2000级"
End With
With cboZZMM
  .AddItem "党员"
  .AddItem "团员"
  .AddItem "群众"
End With
With cboHKSX
  .AddItem "城市"
  .AddItem "农村"
End With
With cboPYFS
    .AddItem "统分"
    .AddItem "委培"
    .AddItem "自费"
End With
End Sub


Public Sub UpdateQuery()
Dim sqlQuery As String
QueryStatus
sqlQuery = "select zbqkb.id,zbqkb.xh,zbqkb.xm,zbqkb.csny,zbqkb.xb,zbqkb.mz,zbqkb.xl,"
sqlQuery = sqlQuery & "zbqkb.yx,zbqkb.bj,zbqkb.hksx,zbqkb.nj,zbqkb.sy,zbqkb.zzmm,"
sqlQuery = sqlQuery & "zbqkb.tc,zbqkb.sfzhm,zbqkb.ltkhm,zbqkb.ss,zbqkb.dh,zbqkb.zy,"
sqlQuery = sqlQuery & "zbqkb.pyfs,zbqkb.