main.frm

期末考试日程安排系统(VB+ACCESS) 系统解图也在压缩包里面了。挺漂亮的

      Top             =   6250
      Width           =   1005
      _ExtentX        =   1773
      _ExtentY        =   1773
      CustomPicture   =   "main.frx":8ED68
      MouseOverPicture=   "main.frx":93CFD
      Caption         =   ""
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BevelWidth      =   0
      MousePointer    =   99
      MouseIcon       =   "main.frx":98F81
      ScaleWidth      =   67
      ScaleMode       =   0
      ScaleHeight     =   67
      BackStyle       =   0
   End
   Begin as97Popup.asPopup asPopup10 
      Height          =   1005
      Left            =   8860
      Top             =   6250
      Width           =   1005
      _ExtentX        =   1773
      _ExtentY        =   1773
      CustomPicture   =   "main.frx":990E3
      MouseOverPicture=   "main.frx":9E2E5
      Caption         =   ""
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BevelWidth      =   0
      MousePointer    =   99
      MouseIcon       =   "main.frx":A36BE
      ScaleWidth      =   67
      ScaleMode       =   0
      ScaleHeight     =   67
      BackStyle       =   0
   End
   Begin as97Popup.asPopup asPopup11 
      Height          =   1005
      Left            =   10920
      Top             =   1200
      Width           =   1005
      _ExtentX        =   1773
      _ExtentY        =   1773
      CustomPicture   =   "main.frx":A3820
      MouseOverPicture=   "main.frx":A838F
      Caption         =   ""
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      BevelWidth      =   0
      MousePointer    =   99
      MouseIcon       =   "main.frx":ACE5C
      ScaleWidth      =   67
      ScaleMode       =   0
      ScaleHeight     =   67
      BackStyle       =   0
   End
   Begin VB.Label Label1 
      BackStyle       =   0  'Transparent
      Caption         =   "正在进行生成....."
      ForeColor       =   &H00FFFFFF&
      Height          =   255
      Left            =   4920
      TabIndex        =   1
      Top             =   8520
      Width           =   2055
   End
End
Attribute VB_Name = "frmmain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub asPopup1_Click(Cancel As Boolean)
'以下主要是显示system窗体，但中间使用了透明的API参数
'这样看起来窗体就像是半透明的，而.alpha中的93就是可以自调节的透明度
Dim fo2 As CTranslucentForm
Set fo2 = New CTranslucentForm
fo2.hWnd = system.hWnd
fo2.Alpha = 93 / 100 * 255
system.Show 1
End Sub

Private Sub asPopup10_Click(Cancel As Boolean)
End
End Sub

Private Sub asPopup11_Click(Cancel As Boolean)
formfind.Show 1
End Sub

Private Sub asPopup2_Click(Cancel As Boolean)
Dim fo2 As CTranslucentForm
Set fo2 = New CTranslucentForm
fo2.hWnd = setclass.hWnd
fo2.Alpha = 93 / 100 * 255
setclass.Show 1
End Sub

Private Sub asPopup3_Click(Cancel As Boolean)
Dim fo2 As CTranslucentForm
Set fo2 = New CTranslucentForm
fo2.hWnd = teacher.hWnd
fo2.Alpha = 93 / 100 * 255
teacher.Show 1
End Sub

Private Sub asPopup4_Click(Cancel As Boolean)
Dim fo2 As CTranslucentForm
Set fo2 = New CTranslucentForm
fo2.hWnd = kcmanage.hWnd
fo2.Alpha = 93 / 100 * 255
kcmanage.Show 1
End Sub

Private Sub asPopup5_Click(Cancel As Boolean)
'检查教室人数与考试人数的对比
Set ks1 = cnn.Execute("select count(*) from 日程设定")
Set ks2 = cnn.Execute("select sum(容纳人数) from 教室")
Set ks3 = cnn.Execute("select sum(考试人数) from 课程")
If ks3.Fields(0) > ks1.Fields(0) * ks2.Fields(0) Then
MsgBox "总考试人数大于教室所容纳的人数，请检查!", vbInformation, "提示"
Exit Sub
End If
'检查可用教师人数是否大于或等于监考人数
Set ks1 = cnn.Execute("select count(*) from 教师")
Set ks2 = cnn.Execute("select sum(监考人数) from 教室")
If ks2.Fields(0) > ks1.Fields(0) Then
MsgBox "教师可用人数小于教室监考人数需求，请检查!", vbInformation, "提示"
Exit Sub
End If
'检查课程的考试数目是否超出考试安排时间
Set ks1 = cnn.Execute("select count(*) from 日程设定")
Set ks2 = cnn.Execute("SELECT DISTINCT 系名 from 课程")
Do While Not ks2.EOF
 For i = 1 To 4
  Set ks3 = cnn.Execute("select count(*) from 课程 where 系名='" & ks2.Fields(0) & "' and 年级='" & i & "'")
  If ks3.Fields(0) > ks1.Fields(0) Then
   MsgBox ks2.Fields(0) & i & "年级的考试科目大出了日程安排数目，请检查!", vbInformation, "提示"
  Exit Sub
  End If
 Next
 ks2.MoveNext
 Loop
'开始执行教师与日期的配对
Set ks1 = cnn.Execute("select * from 日程设定")
Set ks2 = cnn.Execute("select * from 教师")
Do While Not ks2.EOF
 Do While Not ks1.EOF
  Set ks3 = cnn.Execute("insert into 安排 values('" & ks2.Fields(0) & "','" & ks1.Fields(0) & "','" & ks1.Fields(1) & "','0')")
  ks1.MoveNext
 Loop
  Set ks1 = cnn.Execute("select * from 日程设定") '因为采用了SQL语句方式，无法将指针指向第一位，所以必须在次读取数据库
  ks2.MoveNext
Loop
asPopup1.Enabled = False
asPopup2.Enabled = False
asPopup3.Enabled = False
asPopup4.Enabled = False
asPopup5.Enabled = False
asPopup6.Enabled = True
asPopup7.Enabled = False
asPopup8.Enabled = False
End Sub

Private Sub asPopup6_Click(Cancel As Boolean)
PBar1.Value = 0
Timer1.Interval = 100
asPopup6.Enabled = False
End Sub
Private Sub sc() '这里是生成的主代码
''''''''''''''''''''''''
' 主要思路: 在大部分学校，一个系的大部分课程都是一致的，这样一个系就是一个整体
'因此取每个系的人数在寻找对应的教室，以下大部分用于寻找教室，主要也是通来不断查询的方式
'寻找最接近于要求人数的教室，这里有可能需要一个教室，也有可能需要多个教室，这就需要循环
'来查询，直到条件允许后，将这些教室记录下来，并在数据库把这些教室作上已被使用的标记。
MsgBox "未授权作品,在源码中有对此代码的详细思路注解,请参照!", vbInformation, "提示"
End Sub
Private Sub asPopup7_Click(Cancel As Boolean)
formshow.Show 1
End Sub

Private Sub asPopup8_Click(Cancel As Boolean)
'这里就是对已经生成的记录进行清除，实现数据的在生成与在管理
Set ks1 = cnn.Execute("delete from 监考教师")
Set ks1 = cnn.Execute("delete from 安排")
Set ks1 = cnn.Execute("update 教室 set 已选='0'")
Set ks1 = cnn.Execute("delete from 生成")
MsgBox "清除完成！", vbInformation, "提示"
  asPopup1.Enabled = True
  asPopup2.Enabled = True
  asPopup3.Enabled = True
  asPopup4.Enabled = True
  asPopup5.Enabled = True
asPopup6.Enabled = False
asPopup7.Enabled = False
asPopup8.Enabled = False
End Sub

Private Sub asPopup9_Click(Cancel As Boolean)
Dim fo2 As CTranslucentForm
Set fo2 = New CTranslucentForm
fo2.hWnd = user.hWnd
fo2.Alpha = 93 / 100 * 255
user.Show 1
End Sub

Private Sub Form_Load()
PBar1.Max = 100 '设定进度条最大值为100
'以下是通过判断安排表和生成表是否为空，来确定用户是否还可以操作
'一些日程设定，教室管理等内容
Set ks1 = cnn.Execute("select count(*) from 安排")
If ks1.Fields(0) <> 0 Then
  asPopup1.Enabled = False
  asPopup2.Enabled = False
  asPopup3.Enabled = False
  asPopup4.Enabled = False
  asPopup5.Enabled = False
  Set ks2 = cnn.Execute("select count(*) from 生成")
  If ks2.Fields(0) <> 0 Then
  asPopup6.Enabled = False
  End If
Else
 asPopup7.Enabled = False
 asPopup8.Enabled = False
End If
Label1.Visible = False
End Sub

Private Sub Timer1_Timer()
If PBar1.Value < 95 Then
Label1.Visible = True
Label1.Caption = "正在进行生成....."
PBar1.Value = PBar1.Value + 5
Else
Timer1.Interval = 0
Call sc
End If
End Sub