mdiform1.frm

成绩管理

      Begin VB.Menu wcor 
         Caption         =   "编辑字颜色"
         Index           =   2
         Shortcut        =   ^B
      End
      Begin VB.Menu wcor 
         Caption         =   "编辑框颜色"
         Index           =   3
         Shortcut        =   ^K
      End
      Begin VB.Menu wsp6 
         Caption         =   "-"
      End
      Begin VB.Menu wcres 
         Caption         =   "恢复原设置"
         Shortcut        =   ^R
      End
   End
   Begin VB.Menu wfont 
      Caption         =   "字体设置[&F]"
      Begin VB.Menu wft 
         Caption         =   "标注字字体"
         Index           =   0
         Shortcut        =   ^M
      End
      Begin VB.Menu wft 
         Caption         =   "编辑字字体"
         Index           =   1
         Shortcut        =   ^D
      End
      Begin VB.Menu wsp7 
         Caption         =   "-"
      End
      Begin VB.Menu wfres 
         Caption         =   "恢复原设置"
         Shortcut        =   ^W
      End
   End
   Begin VB.Menu wprint 
      Caption         =   "打印输出[&P]"
      Begin VB.Menu wpset 
         Caption         =   "打印设置"
         Shortcut        =   ^P
      End
      Begin VB.Menu wsp8 
         Caption         =   "-"
      End
      Begin VB.Menu wpjt 
         Caption         =   "集体查询打印"
         Shortcut        =   ^J
      End
      Begin VB.Menu wpgrzn 
         Caption         =   "成绩单打印"
         Shortcut        =   ^Z
      End
   End
   Begin VB.Menu ww 
      Caption         =   "窗口[&W]"
      Begin VB.Menu wtitle 
         Caption         =   "平铺[&T]"
      End
      Begin VB.Menu wcasd 
         Caption         =   "层叠[&C]"
      End
      Begin VB.Menu wicon 
         Caption         =   "排列图标[&A]"
      End
      Begin VB.Menu wsp12 
         Caption         =   "-"
      End
      Begin VB.Menu wtoolbar 
         Caption         =   "工具栏[&S]"
         Checked         =   -1  'True
      End
   End
   Begin VB.Menu whelp 
      Caption         =   "帮助[&H]"
      Begin VB.Menu whusage 
         Caption         =   "使用说明"
         Shortcut        =   ^U
      End
      Begin VB.Menu wsp20 
         Caption         =   "-"
      End
      Begin VB.Menu wpywh 
         Caption         =   "评语维护"
         Shortcut        =   ^Y
      End
      Begin VB.Menu NANO 
         Caption         =   "姓名.学号维护"
         Shortcut        =   ^N
      End
      Begin VB.Menu cale 
         Caption         =   "计算器[&C]"
         Shortcut        =   ^C
      End
      Begin VB.Menu wsp9 
         Caption         =   "-"
      End
      Begin VB.Menu whabout 
         Caption         =   "关于版本"
         Shortcut        =   ^A
      End
   End
End
Attribute VB_Name = "MDIForm1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
  Const swp_nomove = 2
  Const SWP_NOSIZE = 1
  Const Flags = swp_nomove Or SWP_NOSIZE
  Const hwnd_topmost = -1
  Private Declare Sub SetWindowPos Lib "User" Alias "setwindowpos" (ByVal hwnd As Integer, ByVal hwndinsterafter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer)

Private Sub cale_Click()
Dim i As Double
Dim winpath1 As String
winpath1 = WindowsDirectory()
   i = Shell(winpath1 + "\calc.exe", 1)
   'i = Shell("c:\windows\calc.exe", 1)
End Sub
Private Sub NANO_Click()
Form15.Show
End Sub
Private Sub Timer1_Timer()
'Timer1.Enabled = False
'Unload Form5
'Screen.MousePointer = 0
End Sub

Private Sub sdxq_Click()
If gbDBOpenFlag = True Then
   Form17.Show
Else
   MsgBox "未打开数据库", , "成绩管理系统V2.1"
End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As ComctlLib.Button)
Select Case Button.Key
       Case "new"
            wnew_Click
       Case "open"
            wopen_Click
       Case "close"
            wclose_Click
       Case "print"
            wpset_Click
       Case "find"
            wqno_Click (2)
       Case "help"
            whusage_Click
       Case "list"
            wqty_Click
       Case "allow"
            weditstart_Click
       Case "stopedit"
            weditend_Click
       Case "cut"
            wcut_Click
       Case "copy"
            wcopy_Click
       Case "paste"
            wpaste_Click
       Case "pywh"
            wpywh_Click
       Case "exit"
            wexit_Click
            
End Select
End Sub

Private Sub wcasd_Click()
Me.Arrange 0
End Sub

Private Sub wclose_Click()
On Error Resume Next
'Unload Form1
'Unload Form10
'Unload Form17
closeflag = False
sortflag = 0
editflag = False
OpenorNew = False
CloseCurrentDB
End Sub

Private Sub wcompact_Click()
CloseCurrentDB
  On Error Resume Next

  Dim sOldName As String
  Dim sNewName As String

  '获得要压缩的文件名
  dlgcmd1.Filter = "Microsoft Access MDB (*.mdc)|*.mdc" ' MSG49
  dlgcmd1.DialogTitle = "选择要压缩的数据库" 'MSG48
  dlgcmd1.FilterIndex = 1
  dlgcmd1.Flags = FileOpenConstants.cdlOFNHideReadOnly
  dlgcmd1.ShowOpen
  If Len(dlgcmd1.filename) > 0 Then
    sOldName = dlgcmd1.filename
  Else
    Exit Sub
  End If
  sNewName = "newdb1w.mdc"
  DBEngine.CompactDatabase sOldName, sNewName
  Kill sOldName
  Name sNewName As sOldName
  CloseCurrentDB
End Sub

Private Sub wcopy_Click()
On Error Resume Next
Clipboard.SetText Screen.ActiveControl.SelText
End Sub

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

  dlgcmd1.DialogTitle = "请选择合适的颜色"
  dlgcmd1.FilterIndex = 1
  dlgcmd1.CancelError = True
  'dlgcmd1.Flags = ColorConstants.cdlcclfullopen + ColorConstants.cdlccshowopen
  'dlgcmd1.Flags = cc_fullopen Or cc_rgbinit Or cc_showhelp
  dlgcmd1.ShowColor
''''''''''''''''''''''''''''''''''''''''''
Select Case Index
   Case 0
   Form1.BackColor = dlgcmd1.Color
    For i = 0 To 16
        Form1.Label(i).BackColor = dlgcmd1.Color
    Next i
   Case 1
    For i = 0 To 16
        Form1.Label(i).ForeColor = dlgcmd1.Color
    Next i
   Case 3
     For i = 0 To 13
        Form1.Text(i).BackColor = dlgcmd1.Color
    Next i
        Form1.Text(14).BackColor = dlgcmd1.Color
        Form1.Text(15).BackColor = dlgcmd1.Color
   Case 2
    For i = 0 To 13
        Form1.Text(i).ForeColor = dlgcmd1.Color
    Next i
        Form1.Text(14).ForeColor = dlgcmd1.Color
        Form1.Text(15).ForeColor = dlgcmd1.Color
   End Select
w0:
   If Err <> 32755 Then         '用户取消了
    Exit Sub 'ShowError
   End If
End If
End Sub

Private Sub wcres_Click()
 If closeflag = False Then
    MsgBox "未打开成绩表", , "成绩管理系统V2.1"
 Else
On Error Resume Next
Dim i As Integer
    For i = 0 To 13
        Form1.Text(i).BackColor = &H80000005 'dlgcmd1.color
    Next i
    Form1.Text(14).BackColor = &H80000005
    Form1.Text(15).BackColor = &H80000005
       
    For i = 0 To 13
        Form1.Text(i).ForeColor = &H80000008 ' dlgcmd1.Color
    Next i
    Form1.Text(14).ForeColor = &H80000008
    Form1.Text(15).ForeColor = &H80000008
    For i = 0 To 16
        Form1.Label(i).ForeColor = &HFF&      'dlgcmd1.Color
    Next i
   
       Form1.BackColor = &HC0C0C0   'dlgcmd1.Color
    For i = 0 To 16
        Form1.Label(i).BackColor = &HC0C0C0   ' dlgcmd1.Color
    Next i
End If
End Sub

Private Sub wcut_Click()
On Error Resume Next
If editflag = True Then
Clipboard.SetText Screen.ActiveControl.SelText
Screen.ActiveControl.SelText = ""
End If
End Sub

Private Sub wedit_click()
If editflag = True Then
Const cf = 1
If Screen.ActiveControl.SelLength > 0 Then
wcopy.Enabled = True
wcut.Enabled = True
Else
  wcopy.Enabled = False
  wcut.Enabled = False
End If
  wpaste.Enabled = Clipboard.GetFormat(cf)
End If
End Sub

Private Sub weditend_Click()
 If closeflag = False Then
    MsgBox "未打开成绩表", , "成绩管理系统V2.1"
 Else
Form1.Command5.Enabled = False
Form1.Command6.Enabled = False
Form1.Command7.Visible = False
Form1.Command8.Visible = False
Form1.Command9.Visible = False
Form1.Command10.Enabled = False
editflag = False
End If
End Sub

Private Sub weditstart_Click()
 If closeflag = False Then
    MsgBox "未打开成绩表", , "成绩管理系统V2.1"
 Else
Form2.Show
End If
End Sub

Private Sub wexit_Click()
Unload Me
End
End Sub

Private Sub wfres_Click()
 If closeflag = False Then
    MsgBox "未打开成绩表", , "成绩管理系统V2.1"
 Else
 Dim i As Integer
    For i = 0 To 16
       Form1.Label(i).FontName = "system"
      ' Form1.Label(i).FontSize = 9 '""
    Next i
    For i = 0 To 13
       Form1.Text(i).FontName = "system"
    Next i