frmpartyinput.frm

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

Private Sub cmdYes_Click()
On Error Resume Next
Dim sqlZBQKB As String
Dim sqlJTQKB As String
'检测数据
Checked = True
CheckItem
'输入数据
 If Checked Then
 
    '输入基本库数据
    
    sqlZBQKB = "insert into Party(xh,xm,csny,mz,yx,nj,sy,xl,tgsj,zzsj,zdsj,zddd) "
    sqlZBQKB = sqlZBQKB + "values('" + Trim(txtXH) + "','" + Trim(txtXM) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(CDate(MSKCSNY)) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(cboMZ) + "','" + Trim(cboYX) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(cboNJ) + "','" + Trim(cboSY) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(cboXL) + "','" + Trim(CDate(MSKTGSJ)) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(CDate(MSKZZSJ)) + "','" + Trim(CDate(MSKZDSJ)) + "',"
    sqlZBQKB = sqlZBQKB + "'" + Trim(txtZDDD) + "')"
    Dbstudent.Execute sqlZBQKB
    ' 初始化数据
    If MsgBox("继续添加下一条记录?", vbQuestion + vbYesNo) = vbYes Then
    InitItem
    Command1.Enabled = False
    Command2.Enabled = False
    Command3.Enabled = False
    Command4.Enabled = False
    Command6.Enabled = False
    Exit Sub
    Else
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
    Command6.Enabled = True
    cmdExit.Enabled = True
    Data1.Refresh
    Data1.Recordset.MoveLast
    cmdYes.Enabled = False
    Exit Sub
    End If
    
 Else
    Data1.Refresh
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
    Command6.Enabled = True
    Exit Sub
 End If
 
 AddNew = False
 Data1.Recordset.MoveLast
 Data1.Recordset.MoveFirst
 SBar1.Panels.Item(2).Text = "共有" & Data1.Recordset.RecordCount & "条记录!"

End Sub

Public Sub CheckItem()
'检查数据重复
On Error Resume Next
Dim sqlRepeat As String
Dim recRepeat As Recordset

'检查重复
sqlRepeat = "select * from party where xh='" + Trim(txtXH) + "'"
Set recRepeat = Dbstudent.OpenRecordset(sqlRepeat, dbOpenSnapshot)
If recRepeat.RecordCount <> 0 Then
    MsgBox "库中已有该同学记录！", vbInformation + vbOKOnly, "提示"
    txtXH = ""
    txtXH.SetFocus
    Checked = False
    Exit Sub
End If
'测试出生日期
If MSKCSNY = "" Then
   MSKCSNY = "2000-01-01"
Else
   If Not IsDate(MSKCSNY) Then
      MsgBox "出生日期输入不正确!", vbCritical + vbOKOnly, "错误"
      MSKCSNY = ""
      MSKCSNY.SetFocus
      Checked = False
      Exit Sub
   End If
End If
'测试通过时间
If MSKTGSJ = "" Then
   MSKTGSJ = "2000-01-01"
Else
   If Not IsDate(MSKTGSJ) Then
      MsgBox "通过日期输入不正确!", vbCritical + vbOKOnly, "错误"
      MSKTGSJ = ""
      MSKTGSJ.SetFocus
      Checked = False
      Exit Sub
   End If
End If
'测试转正时间
If MSKZZSJ = "" Then
   MSKZZSJ = "2000-01-01"
Else
   If Not IsDate(MSKZZSJ) Then
      MsgBox "转正日期输入不正确!", vbCritical + vbOKOnly, "错误"
      MSKZZSJ = ""
      MSKZZSJ.SetFocus
      Checked = False
      Exit Sub
   End If
End If
'测试转档时间
If MSKZDSJ = "" Then
   MSKZDSJ = "2000-01-01"
Else
   If Not IsDate(MSKZDSJ) Then
      MsgBox "转档日期输入不正确!", vbCritical + vbOKOnly, "错误"
      MSKZDSJ = ""
      MSKZDSJ.SetFocus
      Checked = False
      Exit Sub
   End If
End If
End Sub

Public Sub InitItem()
'初始化数据
On Error Resume Next
txtXH = ""
txtXM = ""
MSKCSNY = ""
cboMZ = ""
cboYX = ""
cboNJ = ""
cboSY = ""
cboXL = ""
MSKTGSJ = ""
MSKZZSJ = ""
MSKZDSJ = ""
txtZDDD = ""
txtXH.SetFocus
End Sub

Private Sub Command1_Click()
On Error Resume Next
Data1.Recordset.MoveFirst
End Sub

Private Sub Command2_Click()
On Error Resume Next
If txtXH.Text <> "" Then
Data1.Recordset.MoveLast
SBar1.Panels.Item(2).Text = "共有" & Data1.Recordset.RecordCount & "条记录"
End If

End Sub

Private Sub Command3_Click()
On Error Resume Next
Data1.Recordset.MovePrevious
If Data1.Recordset.BOF Then
Data1.Recordset.MoveFirst
MsgBox "这是第一条记录!", vbInformation + vbOKOnly, "消息提示框"
End If

End Sub
Private Sub Command4_Click()
On Error Resume Next
Data1.Recordset.MoveNext
If Data1.Recordset.EOF Then
Data1.Recordset.MoveLast
MsgBox "这是最后一条记录!", vbInformation + vbOKOnly, "信息提示"
Exit Sub
End If

End Sub

Private Sub Command5_Click()
On Error Resume Next
AddNew = True
InitItem
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Command6.Enabled = False
cmdExit.Enabled = False
End Sub

Private Sub Command6_Click()
On Error Resume Next
If txtXH.Text = "" Then
MsgBox "无记录供删除!", vbInformation + vbOKOnly, "提示框"
Exit Sub
End If
If MsgBox("确信要删除?", vbQuestion + vbYesNo, "删除前询问") = vbYes Then
Dim sqlDelete As String
sqlDelete = "delete from party where xh='" + txtXH + "'"
Dbstudent.Execute sqlDelete, 64
Data1.Refresh
Data1.Recordset.MoveFirst
Data1.Recordset.MoveLast
End If
SBar1.Panels.Item(1).Text = "删除了一条记录！"
SBar1.Panels.Item(2).Text = "还有" & (Data1.Recordset.RecordCount) & "条记录!"

End Sub

Private Sub Data1_Reposition()
On Error Resume Next

SBar1.Panels.Item(1).Text = "第" & Data1.Recordset.AbsolutePosition + 1 & "条"
SBar1.Panels.Item(2).Text = "共有" & Data1.Recordset.RecordCount & "条记录"
End Sub

Private Sub Form_Load()
On Error Resume Next
AddNew = False
ComboData
Dim rec As Recordset
Set rec = Dbstudent.OpenRecordset("select * from party", dbOpenDynaset)
Set Data1.Recordset = rec
Line1.X1 = 0
Line1.X2 = frmPartyInput.Width
rec.MoveLast
rec.MoveFirst
SBar1.Panels.Item(1).Text = "第" & Data1.Recordset.AbsolutePosition + 1 & "条"
SBar1.Panels.Item(2).Text = "共有" & Data1.Recordset.RecordCount & "条记录"
End Sub


Public Sub ComboData()
 On Error Resume Next
 With cboMZ
  .AddItem "汉族"
  .AddItem "回族"
  .AddItem "藏族"
  .AddItem "满族"
  .AddItem "壮族"
 End With
 With cboXL
  .AddItem "博士"
  .AddItem "硕士"
  .AddItem "本科"
  .AddItem "大专"
  .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 "体育系"
End With
With cboNJ
  .AddItem "94级"
  .AddItem "95级"
  .AddItem "96级"
  .AddItem "97级"
  .AddItem "98级"
  .AddItem "99级"
  .AddItem "2000级"
End With
End Sub
Public Function XHInZBQKB(ByVal XH As String) As Boolean
On Error Resume Next
Dim sqlFind As String
Dim recFind As Recordset
sqlFind = "select * from zbqkb where xh='" + Trim(txtXH) + "'"
Set recFind = Dbstudent.OpenRecordset(sqlFind, dbOpenSnapshot)
XHInZBQKB = True
If recFind.RecordCount = 0 Then
    XHInZBQKB = False
End If
End Function

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Unload Me
End Sub

Private Sub MNUADD_Click()
On Error Resume Next
Call Command5_Click
End Sub

Private Sub MNUDELE_Click()
On Error Resume Next
Call Command6_Click
End Sub

Private Sub MNUCOU_Click()
frmPartyCount.Show 1
End Sub

Private Sub MNUEXIT_Click()
On Error Resume Next
Call cmdExit_Click
End Sub

Private Sub MNULOC_Click()
FRMDW.Label1.Caption = "党员库学号定位"
FRMDW.Show 1
End Sub

Private Sub MNUNOTE_Click()
Dim TTT As String
Dim X
TTT = App.Path + "\help\partyin.txt"
X = Shell("Notepad " + TTT, 1)
End Sub

Private Sub mnurep_Click()
frmPartyModify.Show 1
End Sub

Private Sub MNUSQU_Click()
frmQueryParty.Show 1
End Sub

Private Sub txtXH_LostFocus()
On Error Resume Next
Dim sqlRepeat As String
Dim recRepeat As Recordset
Dim sqlOld As String
Dim recOld As Recordset
Dim Year0 As String
Dim Month0 As String
Dim Day0 As String
'学号未填

If Not AddNew Then
    Exit Sub
End If

If txtXH = "" Then
   MsgBox "学号未填写!", vbInformation + vbOKOnly, "错误"
   txtXH.SetFocus
   Exit Sub
End If

If Not XHInZBQKB(txtXH) Then
    MsgBox "基本库中未发现此学生信息!", vbQuestion + vbYesNo, "错误"
   txtXH = " "
   txtXH.SetFocus
   Exit Sub
End If

sqlRepeat = "select * from party where xh='" + Trim(txtXH) + "'"
Set recRepeat = Dbstudent.OpenRecordset(sqlRepeat, dbOpenSnapshot)
If recRepeat.RecordCount <> 0 Then
    MsgBox "学号有重复！", vbInformation + vbOKOnly, "提示"
    Dim s As String
    s = Trim(txtXH)
    Data1.Recordset.MoveFirst
    Data1.Refresh
    Data1.Recordset.FindFirst "xh='" + Trim(s) + "'"
    AddNew = False
    txtXH.SetFocus
    Command1.Enabled = True
    Command2.Enabled = True
    Command3.Enabled = True
    Command4.Enabled = True
    cmdExit.Enabled = True
    cmdYes.Enabled = False
    Command5.Enabled = True
    Command6.Enabled = True
    Exit Sub
Else
'End If
'测试出生日期
sqlOld = "select top 1  xh,xm,csny,sy,mz,yx,nj,xl from zbqkb where xh='" + Trim(txtXH) + "'"
Set recOld = Dbstudent.OpenRecordset(sqlOld, dbOpenSnapshot)
If Not IsNull(recOld!XH) Then txtXH = recOld!XH
If Not IsNull(recOld!XM) Then txtXM = recOld!XM
If Not IsNull(recOld!XL) Then cboXL = recOld!XL
If Not IsNull(recOld!YX) Then cboYX = recOld!YX
If Not IsNull(recOld!NJ) Then cboNJ = recOld!NJ
If Not IsNull(recOld!SY) Then cboSY = recOld!SY
If Not IsNull(recOld!MZ) Then cboMZ = recOld!MZ
If Not IsNull(recOld!CSNY) Then
    If Len(Year(recOld!CSNY)) = 2 Then
        Year0 = Right("19" & CStr(Year(recOld!CSNY)), 2)
    Else
        Year0 = Right(CStr(Year(recOld!CSNY)), 2)
    End If
    If Len(Month(recOld!CSNY)) = 1 Then
        Month0 = "0" & CStr(Month(recOld!CSNY))
    Else
        Month0 = CStr(Month(recOld!CSNY))
    End If
    If Len(Day(recOld!CSNY)) = 1 Then
        Day0 = "0" & CStr(Day(recOld!CSNY))
    Else
        Day0 = CStr(Day(recOld!CSNY))
    End If
    MSKCSNY = Year0 + "-" + Month0 + "-" + Day0
cmdYes.Enabled = True
End If
End If

End Sub