（能百度到这篇博客的，应该都是被数据结构课程设计搞得很烦躁的人吧哈哈哈）
先介绍一下这个系统，它是一个用VB和.NET开发的，能够实现新建，打开，保存教学计划编制文件（后缀名为.tms的文件）的，可以支持对Excel文件的导入以及导出的，并能根据均匀或者集中两种分配模式来对输入的课程进行教学安排的，还能实现动态拓扑排序演示的————软件！
为什么使用VB呢？我觉得有以下几点：
一是VB和windows相性非常好，
二是并且开发图形界面特别方便，
三是可以很方便地生成安装包（方便在其他windows机器上进行演示）。
好了话不多说，先上界面：
图1.1.1
系统主界面如图1.1.1，界面有三个大区域，左方的课程信息区为datagridview组件。右上的教学计划区为textbox组件和
radiobutton组件。右下的功能区是6个button组件。
图1.1.2
结果界面如图1.1.2，界面有两个大区域，左方的编排结果区为treeview组件。右方的结果详细区为datagirdview组件。
图1.1.3
图形化演示界面如图1.1.3，界面有两个大区域，左方为GDI+绘图区域。右方的结果区为treeview组件。
接下来是代码，注释写得差不多，就不另讲解了。
系统主界面的代码：
Imports System.IO
Public Class TeachingManagementSystem
Public RowsNum = 15
Public ImportFilePath = ""
Public AllData(399) As String
'ALLData数组中数据含义：0：文件地址，1：学期总数，千位/学分上限百位十位个位，2：分配方式，3：行数，4-399：数据
'所以一共可以存99种课程信息。
Private Sub TeachingManagementSystem_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'设置窗体不可最大化，不可更改大小
FormBorderStyle = BorderStyle.FixedSingle
MaximizeBox = False
'课程信息初始设定为15行
For a = 0 To 15
CourseTable.Rows.Add()
Next
'设定data数组的初始值
AllData(1) = ""
AllData(2) = "0"
AllData(3) = CStr(RowsNum)
For a = 4 To 399
AllData(a) = ""
Next
EnableItems(False)
End Sub
'关闭窗体之前弹出是否保存的消息框
Private Sub TeachingManagementSystem_Closed(sender As Object, e As EventArgs) Handles MyBase.Closed
Dim buttom = vbYesNo + vbDefaultButton2
Dim response = MsgBox("您想在退出之前保存所做的更改吗？", buttom)
If response = vbYes Then
If AllData(0) <> "" Then
File.WriteAllLines(AllData(0), AllData, System.Text.Encoding.Default)
MsgBox("保存成功")
Else
MsgBox("保存失败")
End If
End If
End Sub
'右键datagridview，添加一行
Private Sub AddRowToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles AddRowToolStripMenuItem.Click
CourseTable.Rows.Add()
RowsNum = RowsNum + 1
AllData(3) = CStr(RowsNum)
End Sub
'右键datagridview，删除一行
Private Sub DeleteRowToolStripMenuItem_Click(sender As Object, e As EventArgs) Handles DeleteRowToolStripMenuItem.Click
For Each row As DataGridViewCell In CourseTable.SelectedCells
If row.RowIndex < 0 Then
RowsNum = 0
AllData(3) = CStr(RowsNum)
Else
RowsNum = RowsNum - 1
AllData(3) = CStr(RowsNum)
AllData(row.RowIndex * 4 + 4) = ""
AllData(row.RowIndex * 4 + 5) = ""
AllData(row.RowIndex * 4 + 6) = ""
AllData(row.RowIndex * 4 + 7) = ""
CourseTable.Rows.RemoveAt(row.RowIndex)
End If
Next
End Sub
'新建教学计划编制文件
Private Sub NewTeaching_Click(sender As Object, e As EventArgs) Handles NewTeaching.Click
Dim newProjectPath = FolderBrowserDialog1.ShowDialog()
If newProjectPath = DialogResult.OK Then
AllData(0) = FolderBrowserDialog1.SelectedPath
Else
Exit Sub
End If
Dim projectName = InputBox("请输入教学计划编制名称：", "输入框", "")
If projectName = "" Then
MsgBox("输入名不能为空")
Exit Sub
End If
'判断文件是否存在,若不存在，则新建文件并写入数据
If Dir(AllData(0) + "\" + projectName) = "" Then
AllData(0) = AllData(0) + "\" + projectName + ".tms"
File.WriteAllLines(AllData(0), AllData, System.Text.Encoding.Default)
EnableItems(True)
Else
MsgBox("已有同名文件！")
End If
End Sub
'打开教学计划编制文件
Private Sub OpenTeaching_Click(sender As Object, e As EventArgs) Handles OpenTeaching.Click
OpenFileDialog1.Filter = "Teaching Management System Files (*.tms)|*.tms"
If Not OpenFileDialog1.ShowDialog(Me) = vbOK Then
Exit Sub
End If
AllData = File.ReadAllLines(OpenFileDialog1.FileName, System.Text.Encoding.Default)
'打开后赋值
Terms.Text = CInt(AllData(1)) \ 1000
MaxCredit.Text = CInt(AllData(1)) Mod 1000
If (AllData(2) = "1") Then
RadioButton2.Checked = True
Else
RadioButton1.Checked = True
End If
CourseTable.Rows.Clear()
RowsNum = CInt(AllData(3))
For a = 1 To RowsNum
CourseTable.Rows.Add()
For b = 0 To 3
CourseTable(b, a - 1).Value = AllData(4 * a + b)
Next
Next
EnableItems(True)
MsgBox("打开成功！")
End Sub
'保存教学计划编制文件
Private Sub SaveTeaching_Click(sender As Object, e As EventArgs) Handles SaveTeaching.Click
Try
AllData(1) = CStr(CInt(MaxCredit.Text) + CInt(Terms.Text) * 1000)
File.WriteAllLines(AllData(0), AllData, System.Text.Encoding.Default)
MsgBox("保存成功！")
Catch ex As Exception
MsgBox("保存失败！数据不符合规范")
End Try
End Sub
'选择集中分配or均匀分配课程
Private Sub RadioButton1_CheckedChanged(sender As Object, e As EventArgs) Handles RadioButton1.CheckedChanged
If (RadioButton1.Checked) Then
AllData(2) = "0"
Else
AllData(2) = "1"
End If
End Sub
'选择集中分配or均匀分配课程
Private Sub RadioButton2_CheckedChanged(sender As Object, e As EventArgs) Handles RadioButton2.CheckedChanged
If (RadioButton1.Checked) Then
AllData(2) = "0"
Else
AllData(2) = "1"
End If
End Sub
Private Sub CourseTable_CellEndEdit(sender As Object, e As DataGridViewCellEventArgs) Handles CourseTable.CellEndEdit
For Each cell As DataGridViewCell In CourseTable.SelectedCells
If CourseTable(cell.ColumnIndex, cell.RowIndex).Value <> "" Then
AllData(cell.RowIndex * 4 + cell.ColumnIndex + 4) = CourseTable(cell.ColumnIndex, cell.RowIndex).Value.ToString
Else
AllData(cell.RowIndex * 4 + cell.ColumnIndex + 4) = ""
CourseTable(cell.ColumnIndex, cell.RowIndex).Value = ""
End If
Next
End Sub
'导入Excel数据
Private Sub ImportData_Click(sender As Object, e As EventArgs) Handles ImportData.Click
OpenFileDialog1.Filter = "Excel Files (*.xls;*.xlsx)|*.xls;*.xlsx"
If Not OpenFileDialog1.ShowDialog(Me) = vbOK Then
Exit Sub
End If
ImportFilePath = OpenFileDialog1.FileName
Try
Dim xlApp = CreateObject("Excel.Application")
Dim xlBook = xlApp.Workbooks.Open(ImportFilePath)
Dim xlSheet = xlBook.worksheets(1)
Dim excelRow = 0
xlSheet.Activate() '激活工作表
CourseTable.Rows.Clear()
While xlSheet.Cells(excelRow + 2, 1).Text.ToString <> ""
CourseTable.Rows.Add()
excelRow = excelRow + 1
End While
For a = 1 To excelRow
For b = 1 To 4
CourseTable(b - 1, a - 1).Value = xlSheet.Cells(a + 1, b).Text
AllData(4 * a + b - 1) = xlSheet.Cells(a + 1, b).Text
Next
Next
MsgBox("导入完成")
Runtime.InteropServices.Marshal.ReleaseComObject(xlSheet)
xlSheet = Nothing
xlBook.Close()
Runtime.InteropServices.Marshal.ReleaseComObject(xlBook)
xlBook = Nothing
xlApp.Quit()
Runtime.InteropServices.Marshal.ReleaseComObject(xlApp)
xlApp = Nothing
Catch ex As Exception
MessageBox.Show(ex.Message, "出错啦！", MessageBoxButtons.OK)
End Try
End Sub
'开始计算
Private Sub Output_Click(sender As Object, e As EventArgs) Handles Output.Click
If IsNumeric(Terms.Text) And InStr(Terms.Text, " ") = 0 And Terms.Text <> "" And IsNumeric(MaxCredit.Text) And InStr(MaxCredit.Text, " ") = 0 And MaxCredit.Text <> "" And CheckData() Then
Consequence.Show()
Else
MsgBox("您有未填写或填写不正确的数据哦")
End If
End Sub
'软件信息
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
SoftwareInfo.Show()
End Sub
'使组件可用or不可用
Function EnableItems(flag)
Terms.Enabled = flag
MaxCredit.Enabled = flag
RadioButton1.Enabled = flag
RadioButton2.Enabled = flag
CourseTable.Enabled = flag
SaveTeaching.Enabled = flag
ImportData.Enabled = flag
Output.Enabled = flag
Return Nothing
End Function
'检查输入的数据是否合法，主要判别是否有空值，是否有课序号重复的值，是否有先修课不合法的值。
Function CheckData()
Dim dataRow = 0
Dim target() As String
For a = 0 To CourseTable.RowCount - 1
If CourseTable(0, a).Value <> "" Then
dataRow = dataRow + 1
End If
Next
For a = 0 To dataRow - 1
For b = a + 1 To dataRow - 1
If CourseTable(0, b).Value = CourseTable(0, a).Value Then
Return False
Exit Function
End If
Next
Next
Dim flag = 0
For a = 0 To dataRow - 1
target = Split(CourseTable(3, a).Value, "&")
For c = 0 To target.Length - 1
flag = 0
For b = 0 To dataRow - 1
If target(c) <> CourseTable(0, b).Value And CourseTable(3, a).Value <> "" Then
flag = flag + 1
End If
Next
If flag = dataRow Then
Return False
Exit Function
End If
Next
Next
Return True
End Function
End Class
Public Class Consequence
Dim Terms = CInt(TeachingManagementSystem.Terms.Text)
Public CredictLimitFinal As Integer
Private Sub Consequence_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim CreditLimit = 0
Dim NowCredit = 0
Dim NowTerms = 0
Dim CoursesNum = 0
'设置窗体不可最大化，不可更改大小
FormBorderStyle = BorderStyle.FixedSingle
MaximizeBox = False
'获取课程总数和学分限制
While CoursesNum < TeachingManagementSystem.CourseTable.RowCount
If TeachingManagementSystem.CourseTable(0, CoursesNum).Value <> "" Then
CreditLimit = CreditLimit + CInt(TeachingManagementSystem.CourseTable(2, CoursesNum).Value)
CoursesNum = CoursesNum + 1
Else
Exit While
End If
End While
If CoursesNum <= 0 Then
MsgBox("数据不足，无法生成结果")
Exit Sub
End If
'若为均匀分配，则每学期的学分限制的初始值为总学分/学期数+1，若不能分配，则学分限制变为总学分/学期数+2,以此类推，直至学分限制=学分上限。
'若为集中分配，则为学分上限
If TeachingManagementSystem.RadioButton1.Checked Then
Dim AllCredit = CInt(TeachingManagementSystem.MaxCredit.Text)
Calculate2(CoursesNum, NowCredit, AllCredit, NowTerms) '判断能否分配，若连集中分配方式都无法正常分配的话，均匀方式更无法分配
CreditLimit = CInt(CreditLimit / Terms + 1)
While CreditLimit < AllCredit
If Calculate1(CoursesNum, NowCredit, CreditLimit, NowTerms) Then
Exit While
Else
CreditLimit = CreditLimit + 1
End If
End While
CredictLimitFinal = CreditLimit
Else
CreditLimit = CInt(TeachingManagementSystem.MaxCredit.Text)
CredictLimitFinal = CreditLimit
Calculate2(CoursesNum, NowCredit, CreditLimit, NowTerms)
End If
End Sub
'导出结果至Excel
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim SavePath = ""
Dim NewExcel = FolderBrowserDialog1.ShowDialog()
If NewExcel = DialogResult.OK Then
SavePath = FolderBrowserDialog1.SelectedPath()
Else
Exit Sub
End If
Dim ExportName = InputBox("请输入文件名称：", "输入框", "")
If ExportName = "" Then
MsgBox("输入文件名不能为空")
Exit Sub
End If
If Dir(FolderBrowserDialog1.SelectedPath + "\" + ExportName) = "" Then '判断文件夹是否存在
SavePath = SavePath + "\" + ExportName + ".xlsx"
Else
MsgBox("已有同名文件夹！")
Exit Sub
End If
Try
Dim xlApp = CreateObject("Excel.Application")
Dim xlBook = xlApp.Workbooks.Add()
Dim xlSheet = xlBook.Worksheets(1)
xlSheet.Activate()
Dim ExcelRow = 1
For a = 0 To TreeView1.Nodes.Count - 1
xlSheet.Cells(ExcelRow, 1) = TreeView1.Nodes(a).Text
ExcelRow = ExcelRow + 1
xlSheet.Cells(ExcelRow, 1) = "课程号"
xlSheet.Cells(ExcelRow, 2) = "课程名称"
xlSheet.Cells(ExcelRow, 3) = "学分"
xlSheet.Cells(ExcelRow, 4) = "先修课"
ExcelRow = ExcelRow + 1
For Each ChildNode In TreeView1.Nodes(a).Nodes
Dim RealTag = ChildNode.Tag Mod 100
For c = 0 To 3
xlSheet.Cells(ExcelRow, c + 1) = TeachingManagementSystem.CourseTable(c, RealTag).Value
Next
ExcelRow = ExcelRow + 1
Next
ExcelRow = ExcelRow + 1
Next
xlBook.SaveAs(SavePath)
MsgBox("导出完成")
Runtime.InteropServices.Marshal.ReleaseComObject(xlSheet)
xlSheet = Nothing
xlBook.Close()
Runtime.InteropServices.Marshal.ReleaseComObject(xlBook)
xlBook = Nothing
xlApp.Quit()
Runtime.InteropServices.Marshal.ReleaseComObject(xlApp)
xlApp = Nothing
Catch ex As Exception
MessageBox.Show(ex.Message, "出错啦！", MessageBoxButtons.OK)
End Try
End Sub
'选择TreeView上的一个节点，在右面的datagridview中显示课程的具体信息
Private Sub TreeView1_AfterSelect(sender As Object, e As TreeViewEventArgs) Handles TreeView1.AfterSelect
OutputTable.Rows.Clear()
Dim RootTag = CInt(TreeView1.SelectedNode.Tag / 100) * 100
For a = 0 To Terms - 1
Dim Rows = 0
If TreeView1.Nodes(a).Tag = RootTag Then
For Each ChildNode In TreeView1.Nodes(a).Nodes
OutputTable.Rows.Add()
Rows = Rows + 1
Next
Dim b = 0
For Each ChildNode In TreeView1.Nodes(a).Nodes
Dim RealTag = ChildNode.Tag Mod 100
For c = 0 To 3
OutputTable(c, b).Value = TeachingManagementSystem.CourseTable(c, RealTag).Value
Next
b = b + 1
Next
End If
Next
End Sub
'拓扑排序功能函数，根据邻接矩阵选择入度为0的节点
Private Function FindRoot(CourseMatrix, CoursesNum)
Dim temp = 0
Dim output = -1
For a = 0 To CoursesNum - 1
For b = 0 To CoursesNum - 1
temp = temp + CourseMatrix(b, a)
Next
If temp = 0 Then
output = a
For b = 0 To CoursesNum - 1
If CourseMatrix(a, b) > 0 Then
CourseMatrix(a, b) = CourseMatrix(a, b) - 1
End If
Next
For b = 0 To CoursesNum - 1
CourseMatrix(b, a) = -1
Next
Exit For
End If
temp = 0
Next
Return output
End Function
'在控制台输出邻接矩阵（调试用函数）
Private Function ShowMatrix(CourseMatrix, CoursesNum)
'输出邻接矩阵
For a = 0 To CoursesNum - 1
For b = 0 To CoursesNum - 1
Console.Write(CourseMatrix(a, b))
Console.Write(" ")
Next
Console.WriteLine()
Next
Console.WriteLine()
Return Nothing
End Function
'拓扑排序功能函数，根据均匀分配课程的学分限制进行拓扑排序
Private Function Calculate1(CoursesNum, NowCredit, CreditLimit, NowTerms)
'构建学期树
TreeView1.Nodes.Clear()
For a = 1 To Terms
Dim nodes As New TreeNode With {
.Text = "第" + CStr(a) + "学期",
.Tag = (a - 1) * 100
}
TreeView1.Nodes.Add(nodes)
Next
'构建邻接矩阵
Dim CourseMatrix(CoursesNum - 1, CoursesNum - 1) As Integer
For a = 0 To CoursesNum - 1
For b = 0 To CoursesNum - 1
'遍历查找（3，a）中的字符串有无（0，b）的数据
If InStr(TeachingManagementSystem.CourseTable(3, a).Value, TeachingManagementSystem.CourseTable(0, b).Value) > 0 Then
CourseMatrix(b, a) = 1
End If
Next
Next
ShowMatrix(CourseMatrix, CoursesNum)
For a = 1 To CoursesNum
Dim root = FindRoot(CourseMatrix, CoursesNum)
If root >= 0 Then
NowCredit = NowCredit + CInt(TeachingManagementSystem.CourseTable(2, root).Value)
While NowCredit > CreditLimit
NowCredit = 0
NowCredit = NowCredit + CInt(TeachingManagementSystem.CourseTable(2, root).Value)
NowTerms = NowTerms + 1
If NowTerms >= Terms Then
TreeView1.Nodes.Clear()
OutputTable.Rows.Clear()
Return False
Exit Function
End If
End While
If NowCredit <= CreditLimit Then
Dim nodes As New TreeNode With {
.Text = TeachingManagementSystem.CourseTable(1, root).Value,
.Tag = NowTerms * 100 + root
}
TreeView1.Nodes(NowTerms).Nodes.Add(nodes)
ShowMatrix(CourseMatrix, CoursesNum)
End If
End If
Next
TreeView1.ExpandAll()
Return True
End Function
'拓扑排序功能函数，根据集中分配课程的学分限制进行拓扑排序
Private Function Calculate2(CoursesNum, NowCredit, CreditLimit, NowTerms)
'构建学期树
TreeView1.Nodes.Clear()
For a = 1 To Terms
Dim nodes As New TreeNode With {
.Text = "第" + CStr(a) + "学期",
.Tag = (a - 1) * 100
}
TreeView1.Nodes.Add(nodes)
Next
'构建邻接矩阵
Dim CourseMatrix(CoursesNum - 1, CoursesNum - 1) As Integer
For a = 0 To CoursesNum - 1
For b = 0 To CoursesNum - 1
'遍历查找（3，a）中的字符串有无（0，b）的数据
If InStr(TeachingManagementSystem.CourseTable(3, a).Value, TeachingManagementSystem.CourseTable(0, b).Value) > 0 Then
CourseMatrix(b, a) = 1
End If
Next
Next
ShowMatrix(CourseMatrix, CoursesNum)
For a = 1 To CoursesNum
Dim root = FindRoot(CourseMatrix, CoursesNum)
If root >= 0 Then
NowCredit = NowCredit + CInt(TeachingManagementSystem.CourseTable(2, root).Value)
While NowCredit > CreditLimit
NowCredit = 0
NowCredit = NowCredit + CInt(TeachingManagementSystem.CourseTable(2, root).Value)
NowTerms = NowTerms + 1
If NowTerms >= Terms Then
MsgBox("课程太多，无法分配")
TreeView1.Nodes.Clear()
OutputTable.Rows.Clear()
Close()
Return False
Exit Function
End If
End While
If NowCredit <= CreditLimit Then
Dim nodes As New TreeNode With {
.Text = TeachingManagementSystem.CourseTable(1, root).Value,
.Tag = NowTerms * 100 + root
}
TreeView1.Nodes(NowTerms).Nodes.Add(nodes)
ShowMatrix(CourseMatrix, CoursesNum)
End If
End If
Next
TreeView1.ExpandAll()
Return True
End Function
'进入图形化演示拓扑排序
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim CoursesNum = 0
While CoursesNum < TeachingManagementSystem.CourseTable.RowCount
If TeachingManagementSystem.CourseTable(0, CoursesNum).Value <> "" Then
CoursesNum = CoursesNum + 1
Else
Exit While
End If
End While
If CoursesNum > 8 Then
MsgBox("数据超过8个，演示效果过差，无法进行图形化演示")
Else
PictureShow.Show()
End If
End Sub
End Class图形化演示界面代码（利用GDI+）：
Public Class PictureShow
Dim Terms = CInt(TeachingManagementSystem.Terms.Text)
Dim CoursesText() As String = {"a", "b", "c", "d", "e", "f", "g", "h"}
Dim Matrix(,) As Integer = {
{-1, -1, -1, -1, -1, -1, -1, -1},
{-1, -1, -1, -1, -1, -1, -1, -1},
{-1, -1, -1, -1, -1, -1, -1, -1},
{-1, -1, -1, -1, -1, -1, -1, -1},
{-1, -1, -1, -1, -1, -1, -1, -1},
{-1, -1, -1, -1, -1, -1, -1, -1},
{-1, -1, -1, -1, -1, -1, -1, -1},
{-1, -1, -1, -1, -1, -1, -1, -1}
}
Private Sub PictureShow_Load(sender As Object, e As EventArgs) Handles MyBase.Load
'设置窗体不可最大化，不可更改大小
FormBorderStyle = BorderStyle.FixedSingle
MaximizeBox = False
End Sub
'初始化面板，根据邻接矩阵和课程信息，在界面上画N个圆圈代表N种要排序的课程
Private Sub getMatrixPictuer(Matrix(,) As Integer, Text() As String, Panel As Panel, drawWindow As Graphics)
Dim drawPenRed As New Pen(Color.FromArgb(253, 121, 35), 6)
Dim drawPenBlue As New Pen(Color.FromArgb(249, 178, 113), 3)
Dim Xarray() = {250, 120, 380, 80, 420, 120, 380, 250}
Dim Yarray() = {20, 70, 70, 180, 180, 290, 290, 340}
If Matrix(0, 0) <> -1 Then
drawWindow.DrawEllipse(drawPenRed, 250, 20, 20, 20)
Label1.Location = New Point(Xarray(0) - Label1.Size.Width / 2 + 12, (Yarray(0) - 30 + 12))
Label1.Text = Text(0)
Label1.Visible = True
Else
Label1.Visible = False
End If
If Matrix(0, 1) <> -1 Then
drawWindow.DrawEllipse(drawPenRed, 120, 70, 20, 20)
Label2.Location = New Point(Xarray(1) - Label1.Size.Width / 2 + 12, (Yarray(1) - 30 + 12))
Label2.Text = Text(1)
Label2.Visible = True
Else
Label2.Visible = False
End If
If Matrix(0, 2) <> -1 Then
drawWindow.DrawEllipse(drawPenRed, 380, 70, 20, 20)
Label3.Location = New Point(Xarray(2) - Label1.Size.Width / 2 + 12, (Yarray(2) - 30 + 12))
Label3.Text = Text(2)
Label3.Visible = True
Else
Label3.Visible = False
End If
If Matrix(0, 3) <> -1 Then
drawWindow.DrawEllipse(drawPenRed, 80, 180, 20, 20)
Label4.Location = New Point(Xarray(3) - Label1.Size.Width - 25 + 12, (Yarray(3) + 12 - Label1.Size.Height / 2))
Label4.Text = Text(3)
Label4.Visible = True
Else
Label4.Visible = False
End If
If Matrix(0, 4) <> -1 Then
drawWindow.DrawEllipse(drawPenRed, 420, 180, 20, 20)
Label5.Location = New Point(Xarray(4) + 25 + 12, (Yarray(4) + 12 - Label1.Size.Height / 2))
Label5.Text = Text(4)
Label5.Visible = True
Else
Label5.Visible = False
End If
If Matrix(0, 5) <> -1 Then
drawWindow.DrawEllipse(drawPenRed, 120, 290, 20, 20)
Label6.Location = New Point(Xarray(5) - Label1.Size.Width / 2 + 12, (Yarray(5) + 15 + 12))
Label6.Text = Text(5)
Label6.Visible = True
Else
Label6.Visible = False
End If
If Matrix(0, 6) <> -1 Then
drawWindow.DrawEllipse(drawPenRed, 380, 290, 20, 20)
Label7.Location = New Point(Xarray(6) - Label1.Size.Width / 2 + 12, (Yarray(6) + 15 + 12))
Label7.Text = Text(6)
Label7.Visible = True
Else
Label7.Visible = False
End If
If Matrix(0, 7) <> -1 Then
drawWindow.DrawEllipse(drawPenRed, 250, 340, 20, 20)
Label8.Location = New Point(Xarray(7) - Label1.Size.Width / 2 + 12, (Yarray(7) + 15 + 12))
Label8.Text = Text(7)
Label8.Visible = True
Else
Label8.Visible = False
End If
For a = 0 To 7
For b = 0 To 7
If Matrix(a, b) = 1 Then
Arrow(drawWindow, drawPenBlue, Xarray(a) + 10, Yarray(a) + 10, Xarray(b) + 10, Yarray(b) + 10, 15)
End If
Next
Next
End Sub
'画箭头
Private Sub Arrow(drawWindow As Graphics, drawPen As Pen, X0 As Single, Y0 As Single, x1 As Single, y1 As Single, ArrowLen As Single)
Dim Xa As Single, Ya As Single, Xb As Single, Yb As Single, D As Double
D = Math.Sqrt((y1 - Y0) * (y1 - Y0) + (x1 - X0) * (x1 - X0))
If D > 0.0000000001 Then
Xa = x1 + ArrowLen * ((X0 - x1) + (Y0 - y1) / 2) / D
Ya = y1 + ArrowLen * ((Y0 - y1) - (X0 - x1) / 2) / D
Xb = x1 + ArrowLen * ((X0 - x1) - (Y0 - y1) / 2) / D
Yb = y1 + ArrowLen * ((Y0 - y1) + (X0 - x1) / 2) / D
drawWindow.DrawLine(drawPen, Xa, Ya, x1, y1)
drawWindow.DrawLine(drawPen, Xb, Yb, x1, y1)
drawWindow.DrawLine(drawPen, X0, Y0, x1, y1)
End If
End Sub
'拓扑排序功能函数，找到入度为0的节点
Private Function FindRoot(CourseMatrix, CoursesNum)
Dim temp = 0
Dim output = -1
For a = 0 To CoursesNum - 1
For b = 0 To CoursesNum - 1
temp = temp + CourseMatrix(b, a)
Next
If temp = 0 Then
output = a
For b = 0 To CoursesNum - 1
If CourseMatrix(a, b) > 0 Then
CourseMatrix(a, b) = CourseMatrix(a, b) - 1
End If
Next
For b = 0 To CoursesNum - 1
CourseMatrix(b, a) = -1
Next
Exit For
End If
temp = 0
Next
Return output
End Function
'输出邻接矩阵
Private Function ShowMatrix(CourseMatrix, CoursesNum)
For a = 0 To CoursesNum - 1
For b = 0 To CoursesNum - 1
Matrix(a, b) = CourseMatrix(a, b)
Console.Write(CourseMatrix(a, b))
Console.Write(" ")
Next
Console.WriteLine()
Next
Console.WriteLine()
Return Nothing
End Function
'刷新界面
Private Function getPicture()
Refresh()
Dim MyGraphics As Graphics = Panel1.CreateGraphics() '声明一个Graphics类的对象并实例化
getMatrixPictuer(Matrix, CoursesText, Panel1, MyGraphics)
TreeView1.ExpandAll()
Return Nothing
End Function
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim CreditLimit = 0
Dim NowCredit = 0
Dim NowTerms = 0
Dim CoursesNum = 0
'获取课程总数和学分限制
While CoursesNum < TeachingManagementSystem.CourseTable.RowCount
If TeachingManagementSystem.CourseTable(0, CoursesNum).Value <> "" Then
CreditLimit = CreditLimit + CInt(TeachingManagementSystem.CourseTable(2, CoursesNum).Value)
CoursesText(CoursesNum) = TeachingManagementSystem.CourseTable(1, CoursesNum).Value
CoursesNum = CoursesNum + 1
Else
Exit While
End If
End While
CreditLimit = Consequence.CredictLimitFinal
'构建学期树
TreeView1.Nodes.Clear()
For a = 1 To Terms
Dim nodes As New TreeNode With {
.Text = "第" + CStr(a) + "学期",
.Tag = (a - 1) * 100
}
TreeView1.Nodes.Add(nodes)
Next
'构建邻接矩阵
Dim CourseMatrix(CoursesNum - 1, CoursesNum - 1) As Integer
For a = 0 To CoursesNum - 1
For b = 0 To CoursesNum - 1
If InStr(TeachingManagementSystem.CourseTable(3, a).Value, TeachingManagementSystem.CourseTable(0, b).Value) > 0 Then
CourseMatrix(b, a) = 1
End If
Matrix(b, a) = CourseMatrix(b, a)
Next
Next
ShowMatrix(Matrix, CoursesNum)
getPicture()
MsgBox("点击确定进行下一步")
For a = 1 To CoursesNum
Dim root = FindRoot(CourseMatrix, CoursesNum)
If root >= 0 Then
NowCredit = NowCredit + CInt(TeachingManagementSystem.CourseTable(2, root).Value)
While NowCredit > CreditLimit
NowCredit = 0
NowCredit = NowCredit + CInt(TeachingManagementSystem.CourseTable(2, root).Value)
NowTerms = NowTerms + 1
End While
If NowCredit <= CreditLimit Then
Dim nodes As New TreeNode With {
.Text = TeachingManagementSystem.CourseTable(1, root).Value,
.Tag = NowTerms * 100 + root
}
TreeView1.Nodes(NowTerms).Nodes.Add(nodes)
ShowMatrix(CourseMatrix, CoursesNum)
getPicture()
MsgBox("点击确定进行下一步")
End If
End If
Next
TreeView1.ExpandAll()
End Sub
End Class以上~
如果有什么问题还请多多指教哦~
GitHub传送门：
https://github.com/shadowings-zy/TeachingManagementSystem
我的个人网站：