form2.frm

排课管理系统,使用Visual Basic 编写的程序。若需要

      BorderColor     =   &H00FFFF80&
      FillColor       =   &H00FFFFC0&
      FillStyle       =   2  'Horizontal Line
      Height          =   735
      Index           =   1
      Left            =   0
      Shape           =   3  'Circle
      Top             =   3240
      Width           =   735
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H00FFFFC0&
      BackStyle       =   1  'Opaque
      BorderColor     =   &H00FFFF80&
      FillColor       =   &H00FFFFC0&
      FillStyle       =   2  'Horizontal Line
      Height          =   735
      Index           =   0
      Left            =   6480
      Shape           =   3  'Circle
      Top             =   3240
      Width           =   855
   End
End
Attribute VB_Name = "Form2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim conn As ADODB.Connection
Dim rsTr As ADODB.Recordset
Dim rsSj As ADODB.Recordset
Dim i, j, sjCnt As Integer
Dim ClassCode As String
Dim TrChanged, ClassChanged As Boolean
Dim strSql As String

Dim rsTrAry As ADODB.Recordset
Dim rsClassAry As ADODB.Recordset
Dim StrTr(9) As String
Dim strSj(49) As String

Dim minht, maxHt As Integer

Private Sub EnableSave(ok As Boolean)
Dim k As Integer
For k = 0 To 3
    If k < 2 Then
        cb(k).Enabled = Not ok
    Else
        cb(k).Enabled = ok
    End If
Next k
Frame7.Enabled = Not ok
Frame2.Enabled = ok
Frame3.Enabled = ok

End Sub

Private Sub cb_Click(Index As Integer)
Me.MousePointer = 11

On Error GoTo errDeal
Select Case Index
Case 0:
    ClassCode = Trim(Combo1(0).Text) & "." & Trim(Combo1(1).Text)
    If Len(Trim(Combo1(0).Text)) > 0 And Len(ClassCode) > 1 Then
        Call displayInfo
        cb(1).Enabled = True
        
    End If
Case 1:
    cb_Click (0)
    
    EnableSave (True)
    cb(1).Enabled = False
    
Case 2:
    If TrChanged Then
        strSql = "delete * from trclass where cclasscode='" & ClassCode & "'"
        conn.Execute strSql
        Dim strTrName As String
        For i = 0 To sjCnt - 1
            
            strTrName = Trim(Combo2(i).Text)
            If Len(strTrName) > 0 Then
            
                strSql = "insert into trclass values('" & ClassCode & "' ," + "'" + Trim(Label2(i).Caption) + "' ," + "'" + Trim(Combo2(i).Text) + "' )"
                'me.caption = strSql
                conn.Execute strSql
            End If
            
        Next i
        TrChanged = False
        rsTrAry.Requery
        cb(1).Enabled = False

    End If
    If ClassChanged Then
        conn.Execute "delete * from classarray where cclasscode='" & ClassCode & "'"
        Dim X, Y As Integer
        
        For i = 0 To 49
            Y = i Mod 5 + 1
            X = Int(i / 5) + 1
            If Len(Trim(Combo3(i).Text)) > 0 Then
                strSql = "insert into classarray values('" & ClassCode & "' ," & Y & "," & X & ", '" & Trim(Combo3(i).Text) & "')"
                'me.caption = strSql
                conn.Execute strSql
                
            End If
        Next i
        ClassChanged = False
        rsClassAry.Requery
    End If
    EnableSave (False)
    
Case 3:
    For i = 0 To sjCnt - 1
        Combo2(i).Text = Combo2(i).Tag
    Next i
    For i = 0 To 49
        Combo3(i).Text = Combo3(i).Tag
    Next i
    EnableSave (False)
    cb(1).Enabled = False
    
End Select

        
    
GoTo ok
errDeal:
MsgBox "Error Unknown"

ok:
Me.MousePointer = 0

End Sub
Private Sub displayInfo()

For j = 0 To sjCnt - 1
    strSql = "select cteacher from trclass where cclasscode='" & ClassCode & "' and csubject='" & Trim(Label2(j).Caption) & "'"
    'Text1.Text = strSql
    'me.caption = strSql
    Set rsTrAry = conn.Execute(strSql)
    
    'Dim tpRs As ADODB.Recordset
    'Set tpRs = conn.Execute("select cteacher from trclass where cclasscode='" & ClassCode & "' and csubject='" & Trim(Label2(j).Caption) & "'")
    'Text1.Text = "####" & strSql & "####"
    'While Not tpRs.EOF
    
    '    Text1.Text = Text1.Text + tpRs.Fields(0)
    '    tpRs.MoveNext
    'Wend
    
    
    
    
    '这里用另一种方法创建 recordset
    
    'rsTrAry.
    
    
    If Not rsTrAry.EOF Then
        'rsTrAry.MoveFirst
        
        Combo2(j).Text = rsTrAry.Fields(0) 'rsTrAry!cteacher
        Combo2(j).Tag = rsTrAry.Fields(0) ' rsTrAry!cteacher
        'EnableSave (False)
    Else
       ' MsgBox "nodata", vbOKOnly
        
        Combo2(j).Text = ""
        Combo2(j).Tag = ""
        'EnableSave (True)
        '''''''''''''''''''''''''''这里语句可能出错
    End If

Next j

For i = 0 To 49
    Dim X, Y As Integer
    X = Int(i / 5 + 1)
    Y = i Mod 5 + 1
    strSql = "select csjname from classarray where cclasscode='" & ClassCode & "' and itimew=" & Y & " and itimen=" & X
    'me.caption = strSql
    
'    rsClassAry.Open strSql, conn, adOpenStatic, adLockOptimistic
    Set rsClassAry = conn.Execute(strSql)
    
    If Not rsClassAry.EOF Then
        Combo3(i).Text = rsClassAry.Fields(0)
        Combo3(i).Tag = rsClassAry.Fields(0)
        'EnableSave (False)
    Else
        Combo3(i).Text = ""
        Combo3(i).Tag = ""
        'EnableSave (True)
    End If
Next i

        

End Sub
Private Function Trim(str As String) As String
Trim = LTrim$(RTrim$(str))

End Function

Private Sub Combo2_Change(Index As Integer)
TrChanged = True

End Sub

Private Sub Combo3_Change(Index As Integer)
    ClassChanged = True
    
End Sub

Private Sub Command1_Click()


Timer1.Enabled = True

End Sub

Private Sub Form_Load()
Me.MousePointer = 11

Set conn = New ADODB.Connection
Set rsTr = New ADODB.Recordset
Set rsSj = New ADODB.Recordset
Set rsTrAry = New ADODB.Recordset
Set rsClassAry = New ADODB.Recordset

'"Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=C:\WINDOWS\Desktop\dataUse.mdb"
conn.Open "provider=Microsoft.Jet.OLEDB.4.0; data source= " & App.Path & "\dataUse.mdb"
rsTr.Open "select * from teacher", conn, adOpenStatic, adLockOptimistic
rsSj.Open "select * from subject", conn, adOpenStatic, adLockOptimistic
minht = 4090
maxHt = 9000

sjCnt = rsSj.RecordCount
Call comboInit

EnableSave (False)
cb(1).Enabled = False
'Command1.Tag = "<<"

Me.Height = minht


Me.MousePointer = 0

End Sub
Private Sub comboInit()
rsSj.MoveFirst
Dim trCnt As Integer
trCnt = rsTr.RecordCount
rsTr.MoveFirst
Combo1(0).Text = ""
Combo1(1).Text = ""

For i = 1 To 12
    Combo1(0).AddItem (i)
    
Next i
For i = 1 To 20
    Combo1(1).AddItem (i)
Next i

For i = 0 To 9
    Combo2(i).Text = ""
    
    If i < sjCnt Then
        Label2(i).Caption = rsSj!csjname
        
        
        rsSj.MoveNext
        
    Else
        Label2(i).Visible = False
        Combo2(i).Visible = False
    End If
Label3(i).Caption = i + 1

Next i
For i = 0 To sjCnt - 1
    
    If i > 0 Then
        For j = 0 To trCnt - 1
        'the last modified here....................
        
            Combo2(i).List(j) = Combo2(0).List(j)
        Next j
        
    Else
        rsTr.MoveFirst
        While Not rsTr.EOF
            Combo2(i).AddItem (rsTr.Fields(0))
            rsTr.MoveNext
            
        Wend
    End If
Next i
For i = 0 To 49
    Combo3(i).Text = ""
    
    For j = 0 To sjCnt - 1
        Combo3(i).AddItem (Label2(j).Caption)
    Next j
Next i

            
End Sub

Private Sub Form_Resize()
    Frame3.Top = Me.Height - Frame3.Height - 520
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Err:
rsTr.Close
rsSj.Close
rsTrAry.Close
rsClassAry.Close
Set rsTr = Nothing
Set rsSj = Nothing
Set rsTrAry = Nothing
Set rsClassAry = Nothing
conn.Close
Set conn = Nothing
Err:

End Sub

Private Sub Timer1_Timer()
If Command1.Caption = ">>" Then
    If Me.Height < maxHt Then
        Me.Height = Me.Height + 150
    Else
        Timer1.Enabled = False
        Command1.Caption = "<<"
        Command1.ToolTipText = "收起课程表!"
        Me.Height = maxHt
        Timer2.Enabled = False
        Command1.BackColor = RGB(255, 255, 255)
        Shape2.BackColor = RGB(0, 100, 200)
        
    End If
Else
    If Me.Height > minht Then
        Me.Height = Me.Height - 150
    Else
        Timer1.Enabled = False
        Command1.Caption = ">>"
        Command1.ToolTipText = "课程表在这里!"
        Me.Height = minht
        Timer2.Enabled = True
        
    End If
End If

    
    
End Sub

Private Sub Timer2_Timer()
Static r, g, b As Integer
'r = 100
'g = 50
'b = 20
Command1.BackColor = RGB(r, g, b)
Shape2.BackColor = RGB(255 - r, 255 - g, 255 - b)

r = r + 15
g = g + 39
b = b + 87
If r > 255 Then
    r = 0
End If
If g > 255 Then
    g = 0
End If
If b > 255 Then
 b = 0
End If
 

End Sub