time table automation

[kasthurirangan]

Friends i suppose to develop a s/w.. which automatically generates a timetable for the entire college.. on all possible classes..so plz help me in developing the coding in vb.net...

[kvprajapati]

Welcome kasthurirangan,
Of course we will help you. Please post your problem along with the code work.
Read
1.Homework policy
2.How to post source code?
Source code must be surrounded with code tags.
For example,

[CODE=VB.NET] ... statements..

[/code]

[Piya27]

Friends i suppose to develop a s/w.. which automatically generates a timetable for the entire college.. on all possible classes..so plz help me in developing the coding in vb.net...

first start extracting information about all the class schedules,intervals and faculty available. retrieve all this from the database query. and then generate a time table based on the result of those queries.
more Specifically, put your code here.. and help us to help you.. :)

[kasthurirangan]

first start extracting information about all the class schedules,intervals and faculty available. retrieve all this from the database query. and then generate a time table based on the result of those queries.
more Specifically, put your code here.. and help us to help you.. :)

i u don mind plz download the timetable s/w on www.asc2008.com and generate code on facilities only on the time table automation..

[kasthurirangan]

first start extracting information about all the class schedules,intervals and faculty available. retrieve all this from the database query. and then generate a time table based on the result of those queries.
more Specifically, put your code here.. and help us to help you.. :)

Option Strict Off
Option Explicit On
Friend Class frmTimeTable
Inherits System.Windows.Forms.Form

Dim Collect_Period, Collect_Teach_Sub As Collection
Dim to_Add, Added As Boolean
Dim lstR, lstC As Short

Private Sub cmdAdd_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdAdd.Click
Me.lstN.Items.Add(Me.cmbTeacher.Text)
Me.lstS.Items.Add(Me.cmbSub.Text)
Me.lstCl.Items.Add(Me.txtCls.Text)
Me.lstP.Items.Add(Me.txtPeriods.Text)
'Me.lstD.AddItem Me.txtdays.Text
If Me.Label7.Text = "-" Then
Me.Label7.Text = Me.txtPeriods.Text
Else
Me.Label7.Text = CStr(CShort(Me.Label7.Text) + CShort(Me.txtPeriods.Text))
End If
End Sub

Private Sub cmdClear_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdClear.Click
Me.lst_Temp_Per_No.Items.Clear()
Me.lst_Temp_Teach_Sub.Items.Clear()
Me.lstCl.Items.Clear()
Me.lstN.Items.Clear()
Me.lstP.Items.Clear()
Me.lstS.Items.Clear()
Me.MSFlxGrd_TT.Clear()
Me.Label7.Text = "-"
Me.txttot_periods.Text = ""
End Sub

Private Sub cmdDelete_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdDelete.Click
Dim ind As Short
ind = Me.lstN.SelectedIndex
Me.lstN.Items.RemoveAt(ind)
Me.lstCl.Items.RemoveAt(ind)
Me.lstP.Items.RemoveAt(ind)
Me.lstS.Items.RemoveAt(ind)
If Me.Label7.Text = "-" Then
Me.Label7.Text = Me.txtPeriods.Text
Else
Me.Label7.Text = CStr(CShort(Me.Label7.Text) - CShort(Me.txtPeriods.Text))
End If

End Sub

Private Sub cmdExcl_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdExcl.Click
'Define the required variable
Dim Data_Row, Data_Col As Short

Dim Excel As Excel.Application ' This is the excel program
'UPGRADE_ISSUE: Excel.Workbook object was not upgraded. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2068"'
Dim ExcelWBk As Excel.Workbook ' This is the work book
'UPGRADE_ISSUE: Excel.Worksheet object was not upgraded. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2068"'
Dim ExcelWS As Excel.Worksheet ' This is the sheet

'UPGRADE_NOTE: Object Excel may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
If Not Excel Is Nothing Then Excel = Nothing
Excel = CreateObject("Excel.Application") 'Create Excel Object.

ExcelWBk = ExcelGlobal_definst.Workbooks.Add 'Add this Workbook to Excel.
'UPGRADE_WARNING: Couldn't resolve default property of object ExcelWBk.Worksheets. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
ExcelWS = ExcelWBk.Worksheets(1) ' Add this sheet to this Workbook

'Fill the Excel Sheet
For Data_Row = 0 To Me.MSFlxGrd_TT.Rows - 1
For Data_Col = 1 To Me.MSFlxGrd_TT.Cols - 1
Me.MSFlxGrd_TT.Row = Data_Row
Me.MSFlxGrd_TT.Col = Data_Col
'UPGRADE_WARNING: Couldn't resolve default property of object ExcelWS.Cells. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
ExcelWS.Cells(Data_Row + 1, Data_Col) = Me.MSFlxGrd_TT.Text
Next
Next
Me.CommonDialog1.ShowSave()
'UPGRADE_WARNING: Couldn't resolve default property of object ExcelWBk.SaveAs. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
If Len(Me.CommonDialog1.FileName) > 0 Then ExcelWBk.SaveAs(Me.CommonDialog1.FileName)
' Close the WorkBook
'UPGRADE_WARNING: Couldn't resolve default property of object ExcelWBk.Close. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
ExcelWBk.Close()
' Quit Excel app
Excel.Quit()
'UPGRADE_NOTE: Object Excel may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
Excel = Nothing
End Sub

Private Sub cmdGen_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdGen.Click
Dim start_Val, tot_peri_dys As Short
Dim no_peri, filler As Short

Me.lst_Temp_Per_No.Items.Clear()
Me.lst_Temp_Teach_Sub.Items.Clear()

Collect_Period = New Collection
Collect_Teach_Sub = New Collection

If Len(Me.txttot_periods.Text) > 0 Then
tot_peri_dys = CShort(Me.txttot_periods.Text)
Else
Exit Sub
End If

If CShort(Me.Label7.Text) > ((tot_peri_dys * 6)) * ((Me.lstN.Items.Count - 1) / (Me.cmbTeacher.Items.Count - 1)) Then
If MsgBox("The machine may hang while designing," & vbCrLf & "Do you want to continue?", MsgBoxStyle.Critical + MsgBoxStyle.OKCancel, "Problem...") = MsgBoxResult.OK Then
'Nothing much to do
'Try to design the Time-table
'If mach. hangs its not the prog. problem.
Else
MsgBox("Try increasing the no of periods in a week, and click again.", , "Problem...")
Exit Sub
End If
End If

'Start Enumerating through the list
For start_Val = 0 To lstN.Items.Count - 1
lstN.SelectedIndex = start_Val
lstCl.SelectedIndex = start_Val
lstS.SelectedIndex = start_Val
lstP.SelectedIndex = start_Val

Fill_Collection(tot_peri_dys, lstN.Text & " " & lstCl.Text & " " & lstS.Text, CShort(lstP.Text))
Next

Dim c, t As Short

Me.MSFlxGrd_TT.Clear()
Me.MSFlxGrd_TT.Rows = tot_peri_dys + 1
Me.MSFlxGrd_TT.Cols = 7
'Marks the Periods
For c = 1 To tot_peri_dys
Me.MSFlxGrd_TT.Row = c
Me.MSFlxGrd_TT.Col = 0
Me.MSFlxGrd_TT.Text = "# " & c
Next
'Fill the FlexGrid with the Weekdays.
'Monday
Me.MSFlxGrd_TT.Row = 0
Me.MSFlxGrd_TT.Col = 1
Me.MSFlxGrd_TT.Text = "Monday"
'Tuesday
Me.MSFlxGrd_TT.Row = 0
Me.MSFlxGrd_TT.Col = 2
Me.MSFlxGrd_TT.Text = "Tuesday"
'Wednesday
Me.MSFlxGrd_TT.Row = 0
Me.MSFlxGrd_TT.Col = 3
Me.MSFlxGrd_TT.Text = "Wednesday"
'Thursday
Me.MSFlxGrd_TT.Row = 0
Me.MSFlxGrd_TT.Col = 4
Me.MSFlxGrd_TT.Text = "Thursday"
'Friday
Me.MSFlxGrd_TT.Row = 0
Me.MSFlxGrd_TT.Col = 5
Me.MSFlxGrd_TT.Text = "Friday"
'Saturday
Me.MSFlxGrd_TT.Row = 0
Me.MSFlxGrd_TT.Col = 6
Me.MSFlxGrd_TT.Text = "Saturday"

For filler = 0 To CShort(Me.lst_Temp_Per_No.Items.Count) - 1
For c = 1 To (tot_peri_dys * 6) Step 6
If CShort(VB6.GetItemString(Me.lst_Temp_Per_No, filler)) >= c And CShort(VB6.GetItemString(Me.lst_Temp_Per_No, filler)) <= (c + 5) Then
Me.MSFlxGrd_TT.Row = (c + 5) \ 6
Me.MSFlxGrd_TT.Col = CShort(VB6.GetItemString(Me.lst_Temp_Per_No, filler)) Mod 6 + 1
Me.MSFlxGrd_TT.Text = VB6.GetItemString(Me.lst_Temp_Teach_Sub, filler)
End If
Next
Next

'UPGRADE_NOTE: Object Collect_Period may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
Collect_Period = Nothing
'UPGRADE_NOTE: Object Collect_Teach_Sub may not be destroyed until it is garbage collected. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1029"'
Collect_Teach_Sub = Nothing
End Sub

'Creates the Collection and list.

Private Sub Fill_Collection(ByRef tot_peri_dys As Short, ByRef s As String, ByRef no_peri As Short)
Dim Tot_Periods, i, pos As Short
Dim flag As Boolean
Dim j As Short
Tot_Periods = 6 * tot_peri_dys
to_Add = True

For i = 0 To no_peri - 1
If Collect_Period.Count() > 0 Then
pos = GetPos(Tot_Periods)
Do While 1
If NoDuplicate(pos, s) Then
Collect_Period.Add(pos)
Collect_Teach_Sub.Add(s)
If Added = False Then
If to_Add = True Then
Me.lst_Temp_Per_No.Items.Add(CStr(pos))
Me.lst_Temp_Teach_Sub.Items.Add(s)
to_Add = False
End If
End If
Exit Do
Else
If Added = True Then Exit Do
pos = GetPos(Tot_Periods)
End If
Loop
Else
pos = GetPos(Tot_Periods)
If pos <> 0 Then
Collect_Period.Add(pos)
Collect_Teach_Sub.Add(s)
Me.lst_Temp_Per_No.Items.Add(CStr(pos))
Me.lst_Temp_Teach_Sub.Items.Add(s)
End If
End If
Added = False
Next

End Sub

Private Function NoDuplicate(ByRef N As Short, ByRef CL_Sub As String) As Boolean
Dim i, temp As Short
Dim flag As Boolean
Dim garb As String
Dim ext, a As Object
Dim X, Y As Short
Dim s1, s2 As String
Dim e, d As Object
flag = True
For i = 1 To Collect_Period.Count()
'UPGRADE_WARNING: Couldn't resolve default property of object Collect_Period.Item(). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
temp = Collect_Period.Item(i)
If N = 0 Then
flag = False
Exit For
End If
If N = temp Then
garb = VB6.GetItemString(Me.lst_Temp_Teach_Sub, i - 1)
'UPGRADE_WARNING: Couldn't resolve default property of object ext. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
ext = Split(garb, " ")
'UPGRADE_WARNING: Couldn't resolve default property of object a. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
a = Split(CL_Sub, " ")

'Checks if a teacher/ other teacher or class gets repeated for the same period.
For Each d In a
For Each e In ext
'UPGRADE_WARNING: Couldn't resolve default property of object d. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
'UPGRADE_WARNING: Couldn't resolve default property of object e. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
If e = d Then
X = 0
flag = False
to_Add = False
NoDuplicate = False
Exit Function
Else
X = 1
End If
Next e
Next d

For Each e In ext
'UPGRADE_WARNING: Couldn't resolve default property of object a(1). Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
'UPGRADE_WARNING: Couldn't resolve default property of object e. Click for more: 'ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"'
If e = a(1) Then
Y = 0
flag = False
to_Add = False
NoDuplicate = False
Exit Function
Else
Y = 1
End If
Next e

If X > 0 And Y > 0 Then
VB6.SetItemString(Me.lst_Temp_Teach_Sub, i - 1, VB6.GetItemString(Me.lst_Temp_Teach_Sub, i - 1) & " " & CL_Sub)
flag = False
Added = True
Exit For
End If
Else
flag = True
End If
Next
If flag = True And X = 0 Then to_Add = True
NoDuplicate = flag
End Function

(this wt my code is )
i don want backend mam and i m getting the output as just printing the timetable in the excel sheet but.. i m not getting it in a proper manner..i m proper sheduling in o/p and with good design so plz help me as soon as possible..

[nellairahul]

iam having the software one which is generate the timetable for entire college with in a minits. if you need means contact us: [e-mail]