mainfrm.frm

guan yu pai ke xi tong de ruan jian

End Sub

Private Sub MDIForm_Load()
    DispStartMode = False
    Me.WindowState = 2 '自动最大化.
    Me.Picture1.Height = Screen.Height
    MDIForm_Activate
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
    If MyDataSet.Updatable = True Then '表示数据已经修改。
        MyFile = MsgBox("数据已经修改！" & Chr(13) & "保存现有数据吗？", vbYesNoCancel + vbDefaultButton3, "退出...")
        Select Case MyFile
        Case vbCancel: '取消.
            Cancel = 1
            Exit Sub
        Case vbYes:
            Call MenuFile_Click(2) '保存数据.
        End Select
    End If
End Sub
Private Sub MenuData_Click(Index As Integer)
    Select Case Index
    Case 0: '课程设置。
        SetSys.Show 1
    Case 1: '课程计划。
        DataEditFrm.Show 1
    Case 2: '检测数据。
        If MsgBox("数据检测工作可能需要一些时间！" & Chr(13) & "需要耐心等待。" & Chr(13) & "现在就进行检测吗！", vbOKCancel + vbDefaultButton2, "检测...") <> vbOK Then Exit Sub
        Me.StatusBar1.Panels(3).Text = "正在检测数据..."
        Me.MousePointer = 11
        MyDataSet.DataTest '测试数据.
        Me.MousePointer = 0
        Me.StatusBar1.Panels(3).Text = "准备就绪"
    Case 3: '手动排课。
        DispFrm.Show 1
    End Select
End Sub
Private Sub MenuFile_Click(Index As Integer)
On Error Resume Next
    Dim MyFile As Long '文件对象。
    Dim myOfstruct As OFSTRUCT
    Dim TemStr As String
    Select Case Index
    Case 0: '新建数据库
        If MyDataSet.Updatable = True Then         '表示数据已经修改。
            MyFile = MsgBox("数据已经修改！" & Chr(13) & "保存现有数据吗？", vbYesNoCancel + vbDefaultButton3, "新建...")
            Select Case MyFile
            Case vbCancel:
                Exit Sub
            Case vbYes:
                Call MenuFile_Click(2)
            End Select
        End If
        Set MyDataSet = MyDataSet.CreatDataStructure
        SetSys.Show 1
        MenuEnabledSet True
    Case 1: '打开数据库
        If MyDataSet.Updatable = True Then '表示数据已经修改。
            MyFile = MsgBox("数据已经修改！" & Chr(13) & "保存现有数据吗？", vbYesNoCancel + vbDefaultButton3, "打开...")
            Select Case MyFile
            Case vbCancel:
                Exit Sub
            Case vbYes:
                Call MenuFile_Click(2)
            End Select
        End If
        CommonDialog1.DialogTitle = "打开数据库..."
        CommonDialog1.Filter = "排课助手文件(*.MDD)|*.MDD|Excel文件(*.XLS)|*.XLS|Access文件(*.MDB)|*.MDB|所有可用的文件|*.MDD;*.XLS;*.MDB"
        CommonDialog1.FileName = ""
        CommonDialog1.FilterIndex = 4 '默认情况下可打开所有支持的数据库文件.
        CommonDialog1.CancelError = True '如果用户选择"取消"则会出错(err.number>0).
        CommonDialog1.ShowOpen '显示打开文件对话框.
        If Err.Number > 0 Then Exit Sub '用户选择取消.
        Me.StatusBar1.Panels(3).Text = "正在打开文件..." '状态栏显示.
        Set MyDataSet = MyDataSet.CreatDataStructure '先设置数据结构,为打开文件作准备.
        Me.MousePointer = 11 '显示忙光标.
        MyDataSet.OpenDataFile CommonDialog1.FileName
        Me.MousePointer = 0 '恢复正常光标.
        MenuEnabledSet True '相应菜单可用.
   Case 2: '更新数据并保存文件。
        MyFile = OpenFile(MyDataSet.DataFileName, myOfstruct, OF_EXIST) '测试数据库文件是否实际存在.
        If MyFile < 0 Then '文件已经不存在，则另存为。
            Call MenuFile_Click(3)
        Else
            Me.MousePointer = 11
            Me.StatusBar1.Panels(3).Text = "正在保存文件..."
            MyDataSet.SaveDataFile MyDataSet.DataFileName
            Me.MousePointer = 0
        End If
    Case 3: '另存数据库
        CommonDialog1.DialogTitle = "数据库另存为..."
        CommonDialog1.Filter = "排课助手文件(*.MDD)|*.MDD|Excel文件(*.XLS)|*.XLS|Access文件(*.MDB)|*.MDB|所有可用的文件|*.MDD;*.XLS;*.MDB"
        CommonDialog1.FileName = ""
        CommonDialog1.FilterIndex = 4 '默认情况下可打开所有支持的数据库文件.
        CommonDialog1.CancelError = True
        CommonDialog1.ShowSave
        If Err.Number > 0 Then Exit Sub '用户选择取消
        MyFile = OpenFile(CommonDialog1.FileName, myOfstruct, OF_EXIST)
        If MyFile >= 0 Then
            If MsgBox("文件已经存在！用现有数据覆盖它吗？", vbYesNo + vbDefaultButton2, "保存...") <> vbYes Then
                Exit Sub
            Else
                DeleteFile FileName
            End If
        End If
        
        Me.StatusBar1.Panels(3).Text = "正在保存文件..."
        Me.MousePointer = 11
        MyDataSet.SaveDataFile CommonDialog1.FileName
        Me.MousePointer = 0
    Case 4: '打印预览。
        If MyDataSet.Tables(0).RowCount < 1 Then
            MsgBox "未设置班级，无法预览！", vbOKOnly, "错误..."
            Exit Sub
        End If
        If MyDataSet.Tables(1).RowCount < 1 Then
            MsgBox "未设置教师，无法预览！", vbOKOnly, "错误..."
            Exit Sub
        End If
        PrintFrm.Show 1
    Case 5: '页面设置。
        SetPage.Show 1
    Case 6: '关闭文件。
        If MyDataSet.Updatable = True Then '表示数据已经修改。
            MyFile = MsgBox("数据已经修改！" & Chr(13) & "保存现有数据吗？", vbYesNoCancel + vbDefaultButton3, "关闭...")
            Select Case MyFile
            Case vbCancel:
                Exit Sub
            Case vbYes:
                Call MenuFile_Click(2)
            End Select
        End If
        MyDataSet.Clear
        MenuEnabledSet False
    Case 8: '升级选项。
        TemStr = InputBox("请输入升级文件的URL地址:", "升级文件网络地址设置...", GetString(HKEY_CURRENT_USER, LOGON_REG_APPLY, "URL"))
        If TemStr <> "" Then
            '重设网络地址。
            SaveString HKEY_CURRENT_USER, LOGON_REG_APPLY, "URL", TemStr
        End If
        TemStr = InputBox("请输入临时文件夹路径:", "临时文件夹设置...", GetString(HKEY_CURRENT_USER, LOGON_REG_APPLY, "TempFolder"))
        If TemStr <> "" Then
            '重设临时文件夹。
            SaveString HKEY_CURRENT_USER, LOGON_REG_APPLY, "TempFolder", TemStr
        End If
    Case 9: '退出应用程序
        Unload Me
        Exit Sub
    End Select
    Me.StatusBar1.Panels(3).Text = "准备就绪"
End Sub
Private Sub MenuHelp_Click(Index As Integer)
    Dim TemNum As Long
    Select Case Index
    Case 0: '关于.
        MsgBox "名称：" & App.ProductName & Chr(13) & "版本：" & "Ver" & App.Major & "." & App.Minor & App.Revision & Chr(13) & "作者：李勇" & Chr(13) & "地址：中华人民共和国四川省遂宁市船山区永兴镇吉东小学校" & Chr(13) & "电话：[phone] " & Chr(13) & "Mail：[e-mail]" & vbCrLf & "版权所有，侵权必究！", vbOKOnly, "关于<" & App.ProductName & ">"
    Case 1: '注册.
        Apply.Show 1
    Case 2: '升级.
        If MyDataSet.Updatable = True Then
            TemNum = MsgBox("数据已经更改，是否保存？", vbDefaultButton1 + vbYesNoCancel, "退出...")
            If TemNum = vbCancel Then Exit Sub
            If TemNum = vbYes Then Call MenuFile_Click(2)
            MyDataSet.Updatable = False
        End If
        Unload Me
        Shell App.Path & "\FileUpdate.exe", vbNormalFocus
    Case 3: '帮助.
        Help
    End Select
End Sub

Private Sub SetName_Click(Index As Integer)
    Select Case Index
    Case 0: '密码设置.
        SetPass.Show 1
    Case 1: '注册.
        ComeProg.Show 1
    End Select
End Sub
Private Sub Timer1_Timer()
    If DispStartMode = False Then '启动1秒后再执行操作。
        DispStartMode = True
        '检查更新程序.exe_是否存在，如果存在，则将其改为.exe文件，删除原更新程序。
        Dim fso As New FileSystemObject
        Dim TemFolder As Folder
        Dim TemFile As File
        Dim TemStr As String
        Set TemFolder = fso.GetFolder(App.Path)
        For Each TemFile In TemFolder.Files
            If Right(TemFile.Name, 1) = "_" Then
                TemStr = Left(TemFile.Name, Len(TemFile.Name) - 1)
                If fso.FileExists(TemStr) = True Then fso.DeleteFile TemStr, True
                DoEvents
                fso.CopyFile App.Path & "\" & TemFile.Name, App.Path & "\" & TemStr, True
                fso.DeleteFile App.Path & "\" & TemFile.Name, True
            End If
        Next
    End If
    Me.StatusBar1.Panels(1).Text = Date '日期显示.
    Me.StatusBar1.Panels(2).Text = Time '时间显示.
End Sub