mdiform1.frm

成绩管理

    Form1.Text(14).FontName = "system"
    Form1.Text(15).FontName = "system"
End If
End Sub

Private Sub wft_Click(Index As Integer)
 If closeflag = False Then
    MsgBox "未打开成绩表", , "成绩管理系统V2.1"
 Else
On Error GoTo w1 'Resume Next

Dim i As Integer
dlgcmd1.FilterIndex = 1
dlgcmd1.CancelError = True
dlgcmd1.Flags = cdlCFScreenFonts
dlgcmd1.ShowFont
Select Case Index
   Case 0
    For i = 0 To 16
        Form1.Label(i).FontName = dlgcmd1.FontName
        Form1.Label(i).FontSize = dlgcmd1.FontSize
    Next i
   Case 1
    For i = 0 To 13
        Form1.Text(i).FontName = dlgcmd1.FontName
        Form1.Text(i).FontSize = dlgcmd1.FontSize
    Next i
        Form1.Text(14).FontName = dlgcmd1.FontName
        Form1.Text(15).FontSize = dlgcmd1.FontSize
End Select
w1:
   If Err <> 32755 Then         '用户取消了
    Exit Sub 'ShowError
   End If
End If
End Sub

Private Sub whabout_Click()
Form8.Show
End Sub

Private Sub whusage_Click()
    Dim i As Double
    'If Index = 0 Then
        i = Shell("winhelp " + App.Path + "\my2.hlp", 1)
   ' End If

End Sub

Private Sub wicon_Click()
Me.Arrange 3
End Sub

Private Sub wnew_Click()
 On Error GoTo NewAccErr
  'CloseCurrentDB
  'Dim sNewName As String
  'Dim db As Database
  dlgcmd1.DialogTitle = "新建数据库" 'MSG55
  dlgcmd1.FilterIndex = 1
  dlgcmd1.Filter = "Microsoft Access MDB (*.mdc)|*.mdc"
  dlgcmd1.filename = vbNullString
  dlgcmd1.CancelError = True
  dlgcmd1.Flags = FileOpenConstants.cdlOFNOverwritePrompt + FileOpenConstants.cdlOFNHideReadOnly
  dlgcmd1.ShowSave
  If Len(dlgcmd1.filename) > 0 Then
    sNewName = dlgcmd1.filename
    If InStr(sNewName, ".") = 0 Then
      '如果未使用扩展名，添加扩展名
      sNewName = sNewName & ".MDC"
    End If
    If Dir(sNewName) <> vbNullString Then
      Kill sNewName
    End If
  Else
    Exit Sub
  End If
  If Len(sNewName) = 0 Then Exit Sub
   Set db = CreateDatabase(sNewName, dbLangGeneral, dbVersion30)
  gsdbname = sNewName
  wclose_Click
  OpenorNew = False
  Form10.Show
' db.Close
NewAccErr:
  If Err <> 32755 Then '用户取消了
  Exit Sub
    'ShowError
  End If
'End Sub

End Sub

Private Sub wopen_Click()
'On Error Resume Next
  'gsdatatype = gsmsaccess
  'gsdbname = sNewName
  wclose_Click
  On Error GoTo qqq '''Resume Next
  'Dim sConnect As String
  'Dim sDatabaseName As String
  'Dim dbTemp As Database
  'Dim sTmp As String
    'If Not bSilent Then
    dlgcmd1.Filter = "Microsoft Access MDB (*.mdc)|*.mdc" ' MSG49 & MSG50
    dlgcmd1.DialogTitle = "打开数据库" ' MSG36
     
    dlgcmd1.FilterIndex = 1
    dlgcmd1.filename = gsdbname  '""
    dlgcmd1.CancelError = True
    dlgcmd1.Flags = FileOpenConstants.cdlOFNFileMustExist
    dlgcmd1.ShowOpen

    If Len(dlgcmd1.filename) > 0 Then
      gsdbname = dlgcmd1.filename
    Else
      Exit Sub
    End If

      '设置连接字符串
  'If gsdatatype = gsmsaccess Then
    'sConnect = vbNullString
  'Else
    'sConnect = gsdatatype
  'End If
  Set db = OpenDatabase(gsdbname) ''', False, gnReadOnly, sConnect)
  
'成功
  Set gdbCurrentDB = db
  gbDBOpenFlag = True
  OpenorNew = True
   '''''''''''''''''
  PB1.Visible = True
  Dim i
  For i = 0 To 100 Step 2
      PB1.Value = i
  Next i
  ''''''''''''''''''
  Form10.Show
 PB1.Visible = False
 Exit Sub
qqq:
  If Err <> 32755 And Err <> 3049 Then   '检查取消的公共对话框
      Exit Sub
  End If
End Sub

Private Sub wpaste_Click()
On Error Resume Next
If editflag = True Then
   Screen.ActiveControl.SelText = Clipboard.GetText()
End If
End Sub

Private Sub wpgrzn_Click()
 If closeflag = False Then
    MsgBox "未打开成绩表", , "成绩管理系统V2.1"
 Else
Dim k As Integer
For k = 0 To 13
    Form7.Label(k).Caption = Form1.Label(k).Caption
    Form7.Text(k).Text = Form1.Text(k).Text
Next k
Form7.Label(14).Caption = Form1.Label(14).Caption
Form7.Label(15).Caption = Form1.Text(14).Text
Form7.PrintForm
Printer.EndDoc
'Form7.Show
End If
End Sub

Private Sub wpjt_Click()
 wqty_Click
End Sub

Private Sub wpset_Click()
On Error Resume Next
  Dim i As Integer
  dlgcmd1.CancelError = True
  dlgcmd1.Flags = pd_printsetup
  dlgcmd1.Action = 5
End Sub

Private Sub wpywh_Click()
Form13.Show
End Sub

Private Sub wqno_Click(Index As Integer)
'On Error Resume Next
 If closeflag = False Then
    MsgBox "未打开成绩表", , "成绩管理系统V2.1"
 Else
 
Dim oldmark As String
Dim criteria As String
 Select Case Index
    Case 0
        Form3.Show vbModal
        If Len(gsnamestr) = 0 Then Exit Sub
           criteria = "[学号]= " & Chr$(34) & gsnamestr & Chr$(34)
        If Form1.Data1.Recordset.RecordCount <> 0 Then
           oldmark = Form1.Data1.Recordset.Bookmark
        End If
        Form1.Data1.Recordset.FindFirst criteria
        If Form1.Data1.Recordset.NoMatch And Len(oldmark) > 0 Then
           Beep
           MsgBox "无此学号", , "成绩管理系统V2.1" ', 48
           Form1.Data1.Recordset.Bookmark = oldmark
        End If
        
      Case 1
        Form4.Show vbModal
        If Len(gsnamestr) = 0 Then Exit Sub
           criteria = "[姓名]= " & Chr$(34) & gsnamestr & Chr$(34)
        If Form1.Data1.Recordset.RecordCount <> 0 Then
           oldmark = Form1.Data1.Recordset.Bookmark
        End If
        Form1.Data1.Recordset.FindFirst criteria
        If Form1.Data1.Recordset.NoMatch And Len(oldmark) > 0 Then
           Beep
           MsgBox "无此姓名", , "成绩管理系统V2.1"
           Form1.Data1.Recordset.Bookmark = oldmark
        End If
        
        Case 2
        Form12.Show vbModal
        If Len(gsnamestr) = 0 Then Exit Sub
           criteria = "[名次]= " & Val(gsnamestr)
        If Form1.Data1.Recordset.RecordCount <> 0 Then
           oldmark = Form1.Data1.Recordset.Bookmark
        End If
        Form1.Data1.Recordset.FindFirst criteria
        If Form1.Data1.Recordset.NoMatch And Len(oldmark) > 0 Then
           Beep
           MsgBox "无此名次", , "成绩管理系统V2.1"
           Form1.Data1.Recordset.Bookmark = oldmark
        End If
    End Select
    Form1.Command9.Visible = False
End If
End Sub

Private Sub wqty_Click()
On Error GoTo errwq

 
 If closeflag = False Then
    MsgBox "未打开成绩表", , "成绩管理系统V2.1"
 Else
'Form1.Hide
 Form6.Show
End If

Exit Sub
errwq:
     MsgBox "有文件被删除或被破坏", , "成绩管理系统V2.1"
End Sub

Private Sub wrepair_Click()
 On Error Resume Next

  Dim sNewName As String

  '获得要修复的文件名
  With dlgcmd1
    .Filter = "Microsoft Access MDB (*.mdc)|*.mdc" 'MSG9
    .DialogTitle = "打开要修复的数据库文件" ' MSG10
    .FilterIndex = 1
    .Flags = FileOpenConstants.cdlOFNHideReadOnly
    .ShowOpen
  End With
  If Len(dlgcmd1.filename) > 0 Then
    sNewName = dlgcmd1.filename
  Else
    Exit Sub
  End If

  Screen.MousePointer = vbHourglass
  'MsgBar MSG11 & sNewName, True
  DBEngine.RepairDatabase sNewName
  Screen.MousePointer = vbDefault
 ' MsgBar vbNullString, False

End Sub

Private Sub ws_Click(Index As Integer)
 'Dim SQL As String
  'SQL$ = "select * from xjgl21tab order by '学号'"
  ' Data1.RecordSource = SQL$
  'Data1.Refresh
  
 On Error GoTo SortErr
 If closeflag = False Then
    MsgBox "未打开成绩表", , "成绩管理系统V2.1"
 Else
  Dim recRecordset1 As Recordset, recRecordset2 As Recordset
  If Form1.Data1.RecordsetType = vbRSTypeTable Then
    Beep
    MsgBox MSG4, 48
    Exit Sub
  End If
  Set recRecordset1 = Form1.Data1.Recordset            '复制记录集
    Screen.MousePointer = 11
    
  Select Case Index
    Case 0
       recRecordset1.Sort = "学号" 'SortStr
       sortflag = 0
      
    Case 1
       recRecordset1.Sort = "姓名" 'SortStr
       sortflag = 1
       
    Case 2
       recRecordset1.Sort = "总分" 'SortStr
       sortflag = 2
       zfpxflag = True '''''''''
End Select
    '建立排序
  Set recRecordset2 = recRecordset1.OpenRecordset(recRecordset1.Type)
  Set Form1.Data1.Recordset = recRecordset2
  ''''''''''''''''''''
    Screen.MousePointer = 0
  ''''''''''''
  Form1.List1.Clear
Do While Form1.Data1.Recordset.EOF = False
         Form1.List1.AddItem Form1.Data1.Recordset.Fields("姓名").Value
         Form1.Data1.Recordset.MoveNext
Loop
         Form1.Data1.Recordset.MoveFirst
         Form1.List1.ListIndex = 0
'''''''''''''''''''''''''''''''''''''''''''''
Form1.Command9.Visible = False
Exit Sub
  
SortErr:
  Screen.MousePointer = 0
   'MsgBox "错误：" & Err & " " & Error$
  Exit Sub
End If
End Sub

Private Sub wtitle_Click()
Me.Arrange 2
End Sub

Private Sub wtoolbar_Click()
Toolbar1.Visible = Not (Toolbar1.Visible)
End Sub