frmmain.frm

学生信息系统 采用VB作为程序设计语言 SQL SERVER2000为数据库

      Caption         =   "帮助(&H)"
      Begin VB.Menu m_about 
         Caption         =   "关于(&A)..."
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim mSQL As String

Private Sub Adodc1_MoveComplete(ByVal adReason As ADODB.EventReasonEnum, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
On Error Resume Next
Adodc1.Caption = Adodc1.Recordset(2)
End Sub

Private Sub ADODC1_WillMove(ByVal adReason As ADODB.EventReasonEnum, adStatus As ADODB.EventStatusEnum, ByVal pRecordset As ADODB.Recordset)
labADO.Caption = "共有记录 " & Adodc1.Recordset.RecordCount & " 条记录。"
End Sub

Private Sub Command1_Click()
On Error Resume Next
Adodc1.Recordset.Update
End Sub

Private Sub Command2_Click()
frmEdit.LoadEdit Adodc1.Recordset("学生ID")
frmEdit.Show 1
Sleep 500
Adodc1.Refresh
DG.Refresh
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode Then End
If MsgBox("你真的要退出本软件吗？", vbYesNo, "退出确认") = vbYes Then
    End
Else
    Cancel = True
End If
End Sub
Sub ResizeDG()
With DG.Columns
    Dim i As Integer, ini As New IniClass
    ini.INIFileName = App.Path & "\ini.ini"
    For i = 0 To .Count - 1
        With DG.Columns(i)
           If ini.GetIniKey("ItemWidth", .Caption) <> "" Then
                .Width = ini.GetIniKey("ItemWidth", .Caption)
            End If
            If ini.GetIniKey("ItemAlign", .Caption) <> "" Then
                .Alignment = ini.GetIniKey("ItemAlign", .Caption)
            End If
            Debug.Print .Alignment
        End With
     Next
End With
End Sub
Sub FindInfo(ByVal sql As String)
Adodc1.RecordSource = sql
Adodc1.Refresh
End Sub
Private Sub Form_Resize()
On Error Resume Next
Adodc1.Move 0, ScaleHeight - SB.Height - Adodc1.Height
labADO.Move Adodc1.Width + 100, Adodc1.Top + (Adodc1.Height - labADO.Height) / 2
DG.Move 0, TB.Top + TB.Height, ScaleWidth, Adodc1.Top - DG.Top
Command1.Top = labADO.Top
Command2.Top = Command1.Top
End Sub

Private Sub labADO_Change()
Command1.Move labADO.Left + labADO.Width + 100, labADO.Top
Command2.Move Command1.Left + Command1.Width + 100
End Sub

Private Sub m_about_Click()
frmAbout.Show 1
End Sub
Sub InitDB()
Adodc1.ConnectionString = "Driver={Microsoft Access Driver (*.Mdb)};Dbq=" & frmDBSet.txtPath.Text
If Con.State <> 0 Then Con.Close
Con.ConnectionString = Adodc1.ConnectionString
Con.Open
End Sub
Private Sub m_ach_Click()
m_sinfo.Checked = False
m_ach.Checked = True
DG.Caption = "成绩"
m_mwb_Click
TB.Buttons(1).ButtonMenus(2).Visible = False
ViewAch
End Sub

Private Sub m_dbset_Click()
frmDBSet.Show 1
End Sub

Private Sub m_exit_Click()
Unload Me
End Sub

Private Sub m_find_Click()
frmFind.Show
End Sub

Private Sub m_medit_Click()
If UserRight = 0 Then
    MsgBox "对不起只有管理员才能开启编辑模式！"
    Exit Sub
End If
If Not m_medit.Checked Then
    Command1.Enabled = True
    DG.AllowUpdate = True
    m_mwb.Checked = False
    m_medit.Checked = True
    If m_ach.Checked Then
        Command2.Visible = True
    End If
    TB.Buttons(3).Enabled = True
    TB.Buttons(4).Enabled = True
End If
End Sub

Private Sub m_mwb_Click()
If Not m_mwb.Checked Then
    Command1.Enabled = False
    DG.AllowUpdate = False
    m_mwb.Checked = True
    m_medit.Checked = False
    TB.Buttons(3).Enabled = False
    TB.Buttons(4).Enabled = False
End If
End Sub

Private Sub m_reload_Click()

End Sub

Private Sub m_output_Click()
On Error GoTo er
frmDBSet.CDL.CancelError = True
frmDBSet.CDL.Filter = "文本文档(*.txt)|*.txt"
frmDBSet.CDL.DialogTitle = "导出当前表"
frmDBSet.CDL.ShowSave
If Dir(frmDBSet.CDL.FileName) <> "" Then
    If MsgBox("目标文件已存在，你要覆盖吗？", vbYesNo, "OverWrite?") = vbNo Then
        Exit Sub
    Else
        Kill frmDBSet.CDL.FileName
    End If
End If
If Not Out(frmDBSet.CDL.FileName) Then
    MsgBox Err.Description, , "导出失败"
End If
er:
End Sub
Function Out(ByVal File As String) As Boolean
ShowInSB "导出..."
Out = False
Dim i As Integer, tmpStr As String, i2 As Integer, i3 As Integer
i = FreeFile
ShowInSB "导出...", "打开文件"
Open File For Binary As i
ShowInSB "导出...", "导出标题"
If m_sinfo.Checked Then
    Put i, , "学生信息"
Else
    Put i, , "学生成绩"
End If
Put i, , vbCrLf
For i2 = 0 To DG.Columns.Count - 1
    With DG.Columns(i2)
    tmpStr = tmpStr & .Caption
    If Not i2 = DG.Columns.Count - 1 Then tmpStr = tmpStr & Space((.Width - Me.TextWidth(.Caption)) / 100)
    End With
Next
Put i, , tmpStr & vbCrLf
ShowInSB "导出...", "导出条目..."
tmpStr = ""
Dim rec As New ADODB.Recordset
rec.Open Adodc1.RecordSource, Con
    Do While Not (rec.EOF Or rec.BOF)
        tmpStr = ""
        For i3 = 0 To rec.Fields.Count - 1
            tmpStr = tmpStr & rec(i3)
            If Not i3 = rec.Fields.Count - 1 Then
                tmpStr = tmpStr & Space((DG.Columns(i3).Width - Me.TextWidth(rec(i3))) / 100)
            End If
        Next
        Put i, , tmpStr & vbCrLf
        rec.MoveNext
    Loop
Debug.Print tmpStr
Put i, , tmpStr
Close i
Out = True
End Function

Private Sub m_sinfo_Click()
m_sinfo.Checked = True
m_ach.Checked = False
DG.Caption = "信息"
TB.Buttons(1).ButtonMenus(2).Visible = True
Command2.Visible = False
ViewInfo
End Sub
Sub ViewInfo()
ShowInSB "加载信息...", ""
Adodc1.RecordSource = "select " & frmDBSet.txtItem & " from [tblInfos]"
Adodc1.Refresh
ResizeDG
ShowInSB "就绪。", ""
End Sub
Sub ViewAch()
ShowInSB "查找信息...", """"
Dim rec As New ADODB.Recordset, ini As New IniClass
Adodc1.RecordSource = "select A.ID as 学生ID,A.Number as 学号,A.Name as 姓名,B.Math as 数学,B.Chinese as 语文,B.English as 英语,B.IT as 计算机 from [tblInfos] as A,[tblMarks] as B Where A.ID=B.ID"
Adodc1.Refresh
ShowInSB "就绪。", ""
End Sub

Private Sub TB_ButtonClick(ByVal Button As MSComctlLib.Button)
On Error Resume Next
Select Case LCase(Button.Key)
Case "view"
    If m_sinfo.Checked Then
        ViewInfo
    Else
        ViewAch
    End If
Case "add"
    If m_sinfo.Checked Then
        Adodc1.Recordset.AddNew
    Else
        frmNewMark.Show 1
        Sleep 500
        Adodc1.Refresh
    End If
Case "del"
    If m_sinfo.Checked Then
        Adodc1.Recordset.Delete
    Else
        Con.Execute "delete * from [tblmarks] where ID=" & Adodc1.Recordset(1)
        Sleep 500
        ViewAch
    End If
End Select
End Sub

Private Sub TB_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
With ButtonMenu
Select Case LCase(ButtonMenu.Key)
Case "all"
    If m_sinfo.Checked Then
        ViewInfo
    Else
        ViewAch
    End If
Case "condition"
    frmCon.Show 1
End Select
End With
End Sub