开始.frm

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

         Caption         =   "退出&E"
      End
   End
   Begin VB.Menu mnufile1 
      Caption         =   "2"
      Visible         =   0   'False
      Begin VB.Menu mnudisplay 
         Caption         =   "显示&S"
      End
      Begin VB.Menu mnudesign 
         Caption         =   "修改&G"
      End
      Begin VB.Menu mnut 
         Caption         =   "统计&T"
         Begin VB.Menu mnutj 
            Caption         =   "统计学分&X"
         End
         Begin VB.Menu TJSP 
            Caption         =   "统计算术平均分&S"
         End
         Begin VB.Menu mnutjz 
            Caption         =   "统计总分&Z"
         End
         Begin VB.Menu MNupb 
            Caption         =   "期末排榜&QP"
         End
         Begin VB.Menu tjbye 
            Caption         =   "毕业操作&B"
            Begin VB.Menu tjby 
               Caption         =   "统计全班成绩表"
            End
            Begin VB.Menu MNUbyPrint 
               Caption         =   "统计某毕业生学分"
               Visible         =   0   'False
            End
            Begin VB.Menu MNUlstB 
               Caption         =   "本专业毕业生排榜"
               Visible         =   0   'False
            End
         End
      End
      Begin VB.Menu mnudel2 
         Caption         =   "删除&C"
      End
      Begin VB.Menu mnushemi 
         Caption         =   "设置密码&S"
      End
   End
End
Attribute VB_Name = "kaishifrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Dim namegood1 As String
Dim waystring As String
Dim namefile As String
Dim selectorder As Integer
Dim fenrecord1 As Recordset
Dim XDname As String '选定的表名
Dim xuanzhe As Integer '排毕业榜(1) ,还是排期末榜(else)

Private Sub Cbo1_KeyDown(KeyCode As Integer, Shift As Integer)
Dim WW As String
If Len(Trim(Cbo1.Text)) = 0 Then
If KeyCode = 46 Then
MSG = "是否要删除" & List1.List(List1.ListIndex) & "?"
style = vbOKCancel
If MsgBox(MSG, style, TiShi) = vbOK Then
dbname.Close
WW = File1.Path & "\" & (File1.List(List1.ListIndex))
Kill (WW)
List2.Clear
showlist '子
End If
End If
End If

End Sub



Private Sub cbo2_Click()
Text2(0) = cbo2.Text
End Sub

Private Sub cmdhistory_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim xd As String


 On Error GoTo s0


If kaishifrm.Width <= 5400 Then 'gai
     Label2.Visible = True
     
    
     
     Do Until kaishifrm.Width > 7440
   kaishifrm.Width = 5340 + I1
   I1 = I1 + 0.8
   DoEvents
   Loop
   ' Reset
    Else
 
        Label2.Visible = False
        kaishifrm.Width = 5330
         'Reset
End If

showlist '子

Exit Sub
s0:
If Err.Number = 76 Then
 MsgBox "无任何班级!"
 Else
 MsgBox "操做错误!"
 
 End If

End Sub

Private Sub CmdSee_Click()

'钢院学分库
'1.选专业
'2.收索班级



Worktype = 2
BuildName  '子
Putin (2) '子
End Sub
Private Sub CmdIN_Click()
Worktype = 1
BuildName  '子
Putin (1) '子
Exit Sub
End Sub

Private Sub Form_Resize()
If Me.Width < 5000 Then
Label2.Visible = False
End If
If Me.Width > 6700 Then
Label2.Visible = False
End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub




Private Sub MNUbyPrint_Click()

Form1.Show
End Sub

Private Sub mnuexit_Click()

Set frm = kaishifrm
ExitGame  '子程序

End Sub


 

Private Sub list1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
     Dim namefile2 As String
     Dim n As Long

     Cbo1.Text = vbNullString
     Cbo1.SetFocus
  If List1.SelCount = 0 Then     '子程序
      
     MsgBox "请选定班级！"
       Exit Sub
                
  End If
    
     namefile = List1.List(List1.ListIndex)
     For i = 0 To 2
     n = InStr(namefile, "-")
     Text2(i).Text = Left(namefile, n - 1)
     namefile = Mid(namefile, n + 1)
     Next i
    
   '==========================
     Worktype = 3
    BuildName  '子
    Putin (3) '子
  '============================
     
    
   '==========以下暂时不用?????????????????
    'If Button = 2 Then
    'kaishifrm.PopupMenu mnufile
    'End If
  
End Sub

Private Sub Form_Load()

kaishifrm.Left = 20
kaishifrm.Top = 20
  If Left(Trim(Trim(Trim(Text1))), 2) = "材料" Then
'===每一各系不一样!'
'机械系
cbo2.AddItem "机械"
cbo2.AddItem "机制"
cbo2.AddItem "机电"
'==============
Else
 If Left(Trim(Trim(Trim(Text1))), 2) = "化学" Then
'化工系
cbo2.AddItem "化工工艺"
cbo2.AddItem "煤化工"
cbo2.AddItem "精细化工"
cbo2.AddItem "应用化学"
cbo2.AddItem "环境工程"
End If
End If
namegood
File1.Path = "钢院学分库\"
End Sub

Private Sub MNUlstB_Click() '毕业排榜
Dim longzy As Integer '专业的字长

Dim BMING(30) As String

Dim A As Integer, B1 As Integer
Dim FLDMING As String
Dim TB(4) As String '进入SQL的 表名
Dim TBZ As String '进入SQL的 班名


Varzy = Trim(Text2(0))
longzy = Len(Varzy)
Xn = Trim(Text2(1))

'要加一些变化,CMDSEE 在 "班级框" 空缺时也好使.
A = 0
For B1 = 0 To List1.ListCount

 If Left(List1.List(B1), longzy + 3) = Varzy & "-" & Xn Then
 A = A + 1
 BMING(A) = "[钢院学分库\" & List1.List(B1) & "]" & ".MDB"

 End If
 Next B1

  SminG = TqB
TBZ = vbNullString
Xq = Varzy & "-专业-" & Xn & "-级毕业"
For B1 = 1 To A
TB(B1) = " SELECT " & TqP & "  FROM " & SminG & " IN " & BMING(B1)
',德育,加分,总分
TBZ = TBZ & TB(B1)
Next B1
 
 FLDMING = TB(1)
For B1 = 2 To A
FLDMING = FLDMING & " UNION ALL" & TB(B1)
Next B1

Gnm = FLDMING
'Text3 = Gnm
frmDataGrid.Show
End Sub

Private Sub MNupb_Click()
'On Error GoTo ssf
Dim longzy As Integer '专业的字长

Dim BMING(30) As String

Dim A As Integer, B1 As Integer
Dim FLDMING As String
Dim TB(4) As String '进入SQL的 表名
Dim TBZ As String '进入SQL的 班名


Varzy = Trim(Text2(0))
longzy = Len(Varzy)
Xn = Trim(Text2(1))




'要加一些变化,CMDSEE 在 "班级框" 空缺时也好使.
A = 0
For B1 = 0 To List1.ListCount

 If Left(List1.List(B1), longzy + 3) = Varzy & "-" & Xn Then
 A = A + 1
 BMING(A) = "[钢院学分库\" & List1.List(B1) & "].MDB"

 End If
Next B1

SminG = List2.List(List2.ListIndex)
Xq = Xn & "级-" & Varzy & "-专业" & Left(SminG, 4) & "期末"
If MsgBox("你是想进行-" & Xq & "期末排榜吗?", vbOKCancel, TiShi) = vbCancel Then
Exit Sub
End If
'For B = 1 To A
'TB = " " & BMING
'Next B
TBZ = vbNullString
For B1 = 1 To A
TB(B1) = " SELECT " & Tq1 & "  FROM " & SminG & " IN " & BMING(B1)
',德育,加分,总分
TBZ = TBZ & TB(B1)
Next B1
 
 
 
 FLDMING = TB(1)
For B1 = 2 To A
FLDMING = FLDMING & " UNION ALL" & TB(B1)
Next B1
Gnm = FLDMING
Text3 = Gnm
frmDataGrid.Show
Exit Sub
ssf:
   MsgBox "错误：" & Err & "，" & Err.Description
End Sub

Private Sub mnushemi_Click()
frmchangpasswd.Show
End Sub

'Private Sub mnutj2_Click()
'On Error GoTo as1

'dbname.Execute " CREATE TABLE 毕业表([学号] text(3),[姓名]text(4),[总分1]text(4),[总分2]text(4),[总分3]text(4),[总分4]text(4),[总分5]text(4),[总分6]text(4),[总分7]text(4),[平均]text(4))"
'worktype = 3
'BuildName  '子
'Putin (3) '子



'Exit Sub
'as1:
'MsgBox "///////?????"
'End Sub
'==================
Private Sub Text2_Change(Index As Integer)
namegood
End Sub
Private Sub Cbo1_Change()
namegood
End Sub
Private Sub CmdExit_Click()
ExitGame
If exit1 = 1 Then
End
End If
End Sub





Private Sub namegood()
Dim f As Integer

For f = 0 To 2

  If Len(Trim(Text2(f).Text)) = 0 Or Len(Trim(Cbo1.Text)) = 0 Then
   GoTo ao
   End If
   Next f
 CmdIN.Enabled = True
 CmdSee.Enabled = True

  Exit Sub
ao:
 CmdIN.Enabled = False
 CmdSee.Enabled = False
 
End Sub
Private Sub BuildName()
Dim f As Integer
GY = vbNullString
Name1 = vbNullString

GY = Trim(Text2(0).Text) & "-" & Trim(Text2(1).Text) & "-" & _
    Trim(Text2(2).Text) & "-班" '祛除空格

Name1 = "第" & Trim(Cbo1.Text) & "学期学分记录表"
End Sub

  Sub showlist()
List1.Clear
File1.Refresh
For i = 0 To File1.ListCount - 1
xd = File1.List(i)
If Right(xd, 3) = "mdb" Then
xd = Mid(xd, 1, Len(xd) - 4)
List1.AddItem xd
End If
Next i

End Sub
  
'=============???????????????以下为fatherfrm的移民程序
Private Sub list2_Click()
On Error GoTo sd1

Dim have As Integer
 
  If List2.SelCount = 0 Then  '子程序
      MsgBox "请选定表！"
       Exit Sub
       
    End If
 
 If List2.ListCount >= 5 Then
    tjbye.Enabled = True
Else
tjbye.Enabled = False
End If

Name1 = List2.List(List2.ListIndex) 'gai

 
renew '子
Set scoretab = dbname.TableDefs(Name1)  'gai
 If scoretab.Fields.Count < 4 Then
     mnut.Enabled = False
     Else
     mnut.Enabled = True
  End If
show_up (Name1) 'gai
XQhave = List2.ListCount - 1
Exit Sub
sd1:
End Sub


Private Sub list2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
 If List2.SelCount > 0 Then
 
 
 
If Button = 2 Then
    
Select Case Name1
 
 Case "基本表"
 mnut.Enabled = False
 mnudel2.Enabled = False
mnudesign.Enabled = True
 Case "毕业表"
 mnut.Enabled = False
  mnudel2.Enabled = True
 mnudesign.Enabled = False
 Case Else
 mnut.Enabled = True
 mnudesign.Enabled = True
 mnudel2.Enabled = True
End Select
 
 '==================以下备用
 'If name1 = "" Then    'gai
  '  mnut.Enabled = False
    'mnutjz.Enabled = False
   ' mnudel2.Enabled = False
    'tjbye.Enabled = False
    
    'Else
     ' mnut.Enabled = True
     ' mnudel2.Enabled = True
      'mnutjz.Enabled = True
 '  End If
   
   'If name1 = "毕业表" Then
   
  ' mnut.Enabled = False
  'mnudesign.Enabled = False
'Else
'mnut.Enabled = True
'  mnudesign.Enabled = True
'End If
   
   
kaishifrm.PopupMenu mnufile1
 
 End If
End If
End Sub
Private Sub MNUDEL2_Click()
On Error GoTo asl
 MSG = " 请再确认! "

style = vbOKCancel
   If MsgBox(MSG, style, TiShi) = vbOK Then
     dbname.TableDefs.Delete (Name1) 'gai
     List2.Refresh
     List2.RemoveItem (List2.ListIndex)
     If List2.ListCount = o Then
      mnudesign.Enabled = False
      mnudel2.Enabled = False
      mnudisplay.Enabled = False
     End If
    End If
asl:
End Sub

Private Sub MNUDESIGN_Click()


  If List2.SelCount <= 0 Then  '子程序
  MsgBox "请选定表！"
  Exit Sub
  End If
  
  If List2.List(List2.ListIndex) = "毕业表" Then
  MsgBox "毕业表由微机自动统计,您无权修改!如想修改,请进入各学期表修改后再统计!"
  Exit Sub
  End If
Set scoretab = dbname.TableDefs(Name1) 'gai
frmTblStruct.Show