frmputin.frm

我编的学分管理程序,安装包原代码都有!VB入门的好东西

 
  fenrecord.MoveNext
DoEvents
  Txthao.Text = fenrecord!学号
  Txtming.Text = fenrecord!姓名
DoEvents
  If VarType(fenrecord.Fields(Txtke.Text).Value) = vbNull Then
     Txtfen.Text = vbNullString
  Else
  DoEvents
    Txtfen.Text = fenrecord.Fields(Txtke.Text).Value
    DoEvents
  End If
'Else
Frmputinshow = 1
Exit Sub

ao:
 If Err.Number = 3021 Then
 MsgBox "先建好基本表！"
 Worktype = 12
 
End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
fenrecord.Close
Frmputinshow = 0
End Sub

Private Sub Tbar1_ButtonClick(ByVal Button As ComctlLib.Button)
Dim fang As Integer

On Error GoTo ao
Select Case Button.Key
Case "font"
  
 If fenrecord.AbsolutePosition = 1 Then
'fenrecord.MoveFirst
Beep
MsgBox "已达第一个记录!"
Else
fenrecord.MovePrevious
End If
 display '=子程序
Case "back"

 If fenrecord.EOF Then
   fenrecord.MoveLast
   Beep
   MsgBox "已达最后一个记录!"
  Else
  fenrecord.MoveNext
End If

 display '=子程序
Case "home"
       fenrecord.AbsolutePosition = 1
        display '=子程序
  '     display  ' 显示当前记录的内容
Case "end"
       fenrecord.MoveLast
        display '=子程序
    '   ' 显示当前记录的内容
Case "add"

'????????????????
 Call Txtfen_KeyPress(13)

 '???????????????
   
   
Case "del"

If fenrecord.EOF = False Then
' msg="删除"& txtming.text& "同学的"
fenrecord.Edit
fenrecord.Fields(Txtke.Text).Value = vbNullString
fenrecord.Update
Else
fenrecord.MovePrevious
fenrecord.Edit
fenrecord.Fields(Txtke.Text).Value = vbNullString
fenrecord.Update
'enrecord.AbsolutePosition = 12
'display
End If
 display '=子程序
Case "query"
'Dim MyBookMark As Variant
'MyBookMark = fenrecord.Bookmark
If Txthao.Enabled = False Then
MsgBox "请在学号框里输入欲查的学号，然后点击“查询”！"
Else
If scoretab.RecordCount >= 0 Then
     If CInt(Txthao.Text) > fenrecord.RecordCount Then
       Txthao.Text = " "
       Txtming.Text = "学号错！"
       Exit Sub
     End If
   If CLng(Txthao.Text) > 0 Then
   
       fenrecord.AbsolutePosition = CLng(Txthao.Text)
 
   
   Txtming.Text = fenrecord.Fields!姓名
      If VarType(fenrecord.Fields(Txtke.Text).Value) = vbNull Then
    
      Txtfen.Text = "无"
      Else
      Txtfen.Text = fenrecord.Fields(Txtke.Text).Value
      End If
   Else
   Txthao.Text = " "
   Txtming.Text = "学号错！"
   End If
 End If

End If
Txthao.Enabled = True
 display '=子程序
Case "exit"
 
 MSG = "真的要退出？请再确认！"
 style = vbDefaultButton1 + vbInformation + vbYesNo
  If MsgBox(MSG, style, TiShi) = vbYes Then
    fenrecord.Close
    Unload FrmPutIn
    Exit Sub
    
  End If
   display '=子程序
 End Select
 

 
Exit Sub
ao:
If Err.Number = 3021 Then
  Beep
 MsgBox "已达最后一个记录!"
 
End If
i = Err.Number
End Sub




Private Sub Txtfen_Change()

If Len(Trim(Txtfen.Text)) = 0 Then
 Tbar1.Buttons("del").Enabled = False
 Else
  Tbar1.Buttons("del").Enabled = True
 End If
End Sub
Private Sub Txtfen_KeyPress(KeyAscii As Integer)
 On Error GoTo am
 Dim Wei As Single
 If KeyAscii = 13 Then
  Worktype = 8
   If Len(Trim(Txthao.Text)) = 0 Or Len(Trim(Txtfen.Text)) = 0 _
     Then
    MSG = "信息不全！"
    style = vbRetryCancel
      Beep
      If MsgBox(MSG, style, TiShi) = vbRetry Then
        Exit Sub
     End If
    End If
   
   If fenrecord.EOF = False Then
'====================
   fenrecord.Edit

  Txthao.Text = fenrecord.Fields("学号").Value
  If VarType(fenrecord.Fields("姓名").Value) = vbNull Then
  Txtming.Text = vbNullString
  Else
  Txtming.Text = fenrecord.Fields("姓名").Value
  End If
  '====================
  Wei = Val(Trim(Txtfen.Text))
  If Trim(Txtke) <> "姓名" Then 'IFXX
   If Len(Trim(Txtfen.Text)) = Len(Trim(Wei)) Then
   fenrecord.Fields(Txtke.Text).Value = Trim(Txtfen.Text)
   Else
     'ii
     If InStr(Txtfen.Text, "/") = 2 Or InStr(Txtfen.Text, "/") = 3 Then
     fenrecord.Fields(Txtke.Text).Value = Trim(Txtfen.Text)
     Else
     MsgBox "请执行正确操作!"

     Exit Sub
     End If
   End If 'ii
  
  Else 'IFXX
   fenrecord.Fields(Txtke.Text).Value = Trim(Txtfen.Text)
    Txtming.Text = Txtfen.Text
  '================

  End If
  '===========
fenrecord.Update
Txtfen.SetFocus
fenrecord.MoveNext
'display  ' 显示当前记录的内容  ' 显示当前记录的内容 ' 显示当前记录的内容
  Else
    If Label5.Visible = True Then
      Label6.Visible = True
   
        
         Txtfen.SetFocus
         Txthao.Text = 1 + Txthao.Text
             Txtfen.Text = vbNullString
           Txtming.Text = vbNullString
       
         MSG = "还想添加新姓名吗? "
         style = vbYesNo + vbDefaultButton1
         If MsgBox(MSG, style, TiShi) = vbYes Then
         fenrecord.AddNew
           fenrecord.Fields("学号").Value = Trim(Txthao.Text)
         fenrecord.Update
          Txtfen.Text = vbNullString
           Txtming.Text = vbNullString
           End If
     'If CLng(Txthao.Text) <> scoretab.RecordCount Then
     'MsgBox "输入正确学号！"
     'Exit Sub
     'End If
    
      
     fenrecord.MoveLast
       
   
    Else
    fenrecord.MoveLast
    Beep
    MsgBox "已经全部输入完毕!"
    End If
   End If
 
  display
   
   End If
Exit Sub
am:
If Err.Number = 3021 Then
  Beep
 MsgBox "已达最后一个记录!"
 
End If
End Sub

 Sub display()        ' 显示当前记录的内容()
   On Error GoTo ao
   If fenrecord.AbsolutePosition = 0 Then _
   Exit Sub
   'fenrecord.AbsolutePosition = 42
   Txthao.Text = fenrecord.Fields("学号").Value
   If VarType(fenrecord.Fields("姓名").Value) = vbNull Then 'IFXX
   
    Txtming.Text = vbNullString
    Txtfen = Txtming
  fenrecord.Edit
  fenrecord.Fields("姓名").Value = vbNullString
  fenrecord.Update

  Else 'IFXX
  
  Txtming.Text = fenrecord.Fields("姓名").Value
  'If Trim(Txtke) = "姓名" Then
  'txt
  End If 'IFXX
  If VarType(fenrecord.Fields(Txtke.Text).Value) = vbNull Then
  
  Txtfen = vbNullString
  enrecord.Edit
  fenrecord.Fields(Txtke.Text).Value = 0
  fenrecord.Update
  
  Else
  Txtfen = fenrecord.Fields(Txtke.Text).Value
  End If
Exit Sub

ao:
If Err.Number = 3021 Then
i = Err.Number
  Beep
 MsgBox "已达最后一个记录!"
 If woktype = 8 Then _
 fenrecord.MoveLast
 End If
 If Err.Number = 3315 Then
 If Txtke.Text = "姓名" Then
 MsgBox "请输入新姓名"
 End If
 End If
End Sub