frmin.frm

VB编写的中小学监考老师排表软件

l1:
Next i
Close #8

If k > jkjsS Then
jkjsS = k
ReDim jsarr(jkjsS + 3)
End If

'MsgBox jkjsS

Dim kcs As Integer
Dim kcsS As Integer
'Dim oneList As numlist
Open pkDir + "\kcshu.bin" For Binary As #8
Open pkDir + "\kc.ran" For Random As #9 Len = 18
kcsS = 0: kcs = 0
Dim bjM As String
Dim kM As String
Dim jM As String

For m = 1 To jkjsS
jsarr(m).jsm = Left(minghao(m), 3) '以新覆旧并初始化
'MsgBox jsarr(m).jsm

jsarr(m).rjbj.num = 0
jsarr(m).rkm = ""
For u = 0 To Class - 1
For v = 0 To Day - 1
jsarr(m).jkbiao1(u, v) = "x"
jsarr(m).jkbiao2(u, v) = "x"
Next v
Next u

    For i = 1 To ksbjS
    bjM = Trim(bjarr(i).njm) & Trim(bjarr(i).bjh)
    kcsS = kcsS + kcs
    'MsgBox bjM
    Get #8, i * 2 - 1, kcs
      For k = 1 To kcs
      Get #9, kcsS + k, kcexp
     kM = Left(kcexp.kckcm, 2)
     jM = Left(kcexp.kcjsm, 3)

      
       If InStr(jsarr(m).jsm, jM) <> 0 Then '有任本班课
       jsarr(m).rjbj.num = jsarr(m).rjbj.num + 1
       jsarr(m).rjbj.list(jsarr(m).rjbj.num) = bjM
       
                If InStr("语文数学英语", kM) Then
                jsarr(m).rkm = kM ' Trim(kcexp.kckcm)
                Else
                    If Trim(jsarr(m).rkm) = "" Or Trim(jsarr(m).rkm) = "x" Then
                    jsarr(m).rkm = kM 'Trim(kcexp.kckcm)
                    End If

                End If

            
       Exit For
       End If
      
      Next k
   
    Next i
    kcsS = 0
    kcs = 0
Next m

Close #8
Close #9

'显示教师表

With HFGd2

.Rows = jkjsS + 1 + 1
    For i = 1 To jkjsS
    .Row = i
    .Col = 1
    .Text = Str(i)
    .Col = 2
    .Text = Trim(jsarr(i).jsm)
    .Col = 3
    .Text = Trim(jsarr(i).rkm)
    Next i
.Row = jkjsS + 1
End With

'重置处理kcmlist() njmlist()
k = 0                            'set js-minghao()
For i = 1 To zkcs             'array ,it's total
For j = 1 To i - 1               'start from No:1
If Left(kcArr(i).kckcm, 2) = Left(kcmOneArr(j), 2) Then
 GoTo l2
End If
Next j
k = k + 1
kcmOneArr(k) = kcArr(i).kckcm '形成不同名的课程名数组
'MsgBox kcmOneArr(k)
l2:
Next i
'MsgBox "不同课程数"
'MsgBox k

Open App.Path + "\numlist.ran" For Random As #2 Len = Len(njmnl)
kcmnl.num = k
For i = 1 To kcmnl.num
kcmnl.list(i) = kcmOneArr(i)
Next i
Put #2, 3, kcmnl
Close #2
'-----------------------------------------------------------------------------------
Dim njs As Integer
njs = 0
For i = 1 To ksbjS
njmnl.list(i) = ""
Next i

For i = 1 To ksbjS '导出班级
For j = 1 To i - 1
If Left(bjarr(i).njm, 2) = Left(njmnl.list(j), 2) Then
GoTo l3
End If
Next j
njs = njs + 1
njmnl.list(njs) = bjarr(i).njm
l3:
Next i
'MsgBox "njs" & Str(njs)
Open App.Path + "\numlist.ran" For Random As #2 Len = Len(njmnl)
njmnl.num = njs
Put #2, 1, njmnl
Close #2

Me.MousePointer = 0

End Sub

Private Sub Command6_Click()

List3.Clear
Dim i As Integer

For i = 1 To ksbjS
List3.AddItem Left(bjarr(i).njm, 2) + Trim(bjarr(i).bjh)
Next i

End Sub

Private Sub Command7_Click()
If (HFGd2.Row > 0) Then
List4.Clear
List4.AddItem "不定"

jsarr(HFGd2.Row).rjbj.list(1) = "不定" ' List4.list(i - 1)

jsarr(HFGd2.Row).rjbj.num = 1 ' List3.SelCount

Else

MsgBox "请先指定当前教师！"
End If


End Sub

Private Sub Form_Load()
'MsgBox jkjss

'fill list1
List1.Clear
For i = 1 To kcmnl.num
List1.AddItem kcmnl.list(i)
Next i
'初始HFGD1
'MsgBox jkjss
With HFGd1
.RowHeightMin = Cmbnjm.Height + 50
.FixedRows = 1
.ColWidth(0) = 150
.ColWidth(1) = 150
.Rows = ksbjS + 2
.CellAlignment = 4
.ColAlignment(3) = 1
.Row = 0
.Col = 2
.Text = "年级名"
.Col = 3
.Text = "班级号"
    For i = 1 To ksbjS
    .Row = i
    .Col = 2
    .Text = Trim(bjarr(i).njm)
    .Col = 3
    .Text = Trim(bjarr(i).bjh)
    Next i
'.Refresh
End With

'填年级们
With Cmbnjm
For i = 1 To njmnl.num
.AddItem njmnl.list(i)
Next i
End With
'填bjh
With Cmbbjh
For i = 1 To bjhnl.num
.AddItem bjhnl.list(i)
Next i
End With
'以上设班级，以下设教师
'初始hfgd2
With HFGd2

.RowHeightMin = Cmbkcm.Height + 50
.FixedRows = 1
.ColWidth(0) = 150
.ColWidth(1) = 450
.Rows = jkjsS + 3
.CellAlignment = 4
.ColAlignment(3) = 1
.Row = 0
.Col = 2
.Text = "教师名"
.Col = 3
.Text = "主要任课名"
    For i = 1 To jkjsS
    .Row = i
    .Col = 1
    .Text = Str(i)
    .Col = 2
    .Text = Trim(jsarr(i).jsm)
    .Col = 3
    .Text = Trim(jsarr(i).rkm)
    Next i
.Row = jkjsS + 1
End With
'jsOk = True

'填课程
With Cmbkcm
For i = 1 To kcmnl.num
.AddItem kcmnl.list(i)
Next i
End With

'填bjlist
List3.Clear

For i = 1 To ksbjS
List3.AddItem Left(bjarr(i).njm, 2) + Trim(bjarr(i).bjh) 'bjarr(i).njm + bjarr(i).bjh
Next i

List4.Clear
End Sub

Private Sub Form_Unload(Cancel As Integer)
Mycarr.carr(4) = ksbjS
Mycarr.carr(5) = jkjsS
'MsgBox ksbjs
'MsgBox jkjss

Open App.Path + "\bjarr.ran" For Random As #2 Len = Len(newbjitem)
For i = 1 To ksbjS
Put #2, i, bjarr(i)
Next
Close #2
'ReDim jsarr(jkjsS)
Open App.Path + "\jsarr.ran" For Random As #2 Len = Len(newjsitem)
For i = 1 To jkjsS
Put #2, i, jsarr(i)
Next
Close #2


'For i = 1 To jkjss
'MsgBox jsarr(i).jsm
'Next i

End Sub

Private Sub HFGd1_EnterCell()
Cmbkcm.Visible = False
textjsm.Visible = False
On Error Resume Next

If HFGd1.Row > 0 And hfd1.Row <= ksbjS + 1 Then
List2.Clear
For i = 1 To bjarr(HFGd1.Row).kskc.num
List2.AddItem bjarr(HFGd1.Row).kskc.list(i)
Next i
End If

If HFGd1.Row < ksbjS + 1 And (HFGd1.Col = 2 Or HFGd1.Col = 3) Then
Exit Sub
End If

Select Case HFGd1.Col
Case Is = 2

    Cmbbjh.Visible = False
    With Cmbnjm
    .Visible = True
    .Left = HFGd1.Left + 200 + 150
    .Top = HFGd1.Top + HFGd1.RowPos(HFGd1.Row) + 50 '(HFGd1.Row + 1) * 300
    End With
    
    Cmbnjm.Text = HFGd1.Text
Case Is = 3
    Cmbnjm.Visible = False
    With Cmbbjh
    .Visible = True
    .Left = HFGd1.Left + 1200 + 150 ' HFGd1.ColWidth(1)
    .Top = HFGd1.Top + HFGd1.RowPos(HFGd1.Row) + 50 '(HFGd1.Row + 1) * 300
    End With
    Cmbbjh.Text = HFGd1.Text
Case Is = 1
    Cmbnjm.Visible = False
    Cmbbjh.Visible = False
End Select
End Sub

Private Sub HFGd1_LeaveCell()
If HFGd1.Row < ksbjS + 1 And (HFGd1.Col = 2 Or HFGd1.Col = 3) Then
Exit Sub
End If

With HFGd1
Select Case .Col
Case Is = 2
.Text = Cmbnjm.Text
Case Is = 3
.Text = Cmbbjh.Text
End Select
End With
End Sub

Private Sub HFGd1_RowColChange()
'MsgBox "now change" + Str(HFGd1.Col)
End Sub


Private Sub HFGd2_EnterCell()
'Cmbbjh.Visible = False
'Cmbnjm.Visible = False

If HFGd2.Row > 0 Then
List4.Clear
For i = 1 To jsarr(HFGd2.Row).rjbj.num
List4.AddItem jsarr(HFGd2.Row).rjbj.list(i)
Next i

Select Case HFGd2.Col
Case Is = 2
    If HFGd2.Row = jkjsS + 1 Then
    Cmbkcm.Visible = False
    With textjsm
   .Visible = True
    .Left = HFGd2.Left + 200 + 450
    .Top = HFGd2.Top + HFGd2.RowPos(HFGd2.Row) + 50 '(HFGd1.Row + 1) * 300
    End With
    textjsm.Text = HFGd2.Text
    End If
Case Is = 3
    textjsm.Visible = False
    With Cmbkcm
    .Visible = True
    .Left = HFGd2.Left + 1200 + 450 ' HFGd1.ColWidth(1)
    .Top = HFGd2.Top + HFGd2.RowPos(HFGd2.Row) + 50 '(HFGd1.Row + 1) * 300
    .Text = HFGd2.Text
    End With
    
Case Else
    textjsm.Visible = False
    Cmbkcm.Visible = False
End Select

End If
'为当前行记录显示班级

If (HFGd2.Row > 0) And (HFGd2.Row <= jkjsS) Then
'MsgBox jsarr(HFGd2.Row).rjbj.num
List4.Clear
For i = 1 To jsarr(HFGd2.Row).rjbj.num
List4.AddItem jsarr(HFGd2.Row).rjbj.list(i)
Next i
End If

End Sub

Private Sub HFGd2_LeaveCell()

Cmbbjh.Visible = False
Cmbnjm.Visible = False

'If HFGd1.Row < ksbjs + 1 And (HFGd1.Col = 2 Or HFGd1.Col = 3) Then
'Exit Sub
'End If

With HFGd2
Select Case .Col
Case Is = 2
    If HFGd2.Row = jkjsS + 1 Then
        If Len(Trim(textjsm.Text)) > 4 Then
        MsgBox "教师名过长"
        Else
        .Text = Trim(textjsm.Text)
        End If
    End If
    
Case Is = 3
.Text = Cmbkcm.Text
' 添加当前教师的rkm
jsarr(.Row).rkm = .Text
End Select

End With

End Sub

Private Sub Image1_Click()
List2.Clear
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then
List2.AddItem List1.list(i)
End If
Next i
End Sub
Private Sub Image10_Click()
Dim strnjm, strbjh, nowstr As String
Dim r, i As Integer
If Cmbbjh.Visible = True And (HFGd1.RowPos(HFGd1.Row) - Cmbbjh.Top) < 100 Then
HFGd1.Text = Cmbbjh.Text
Cmbbjh.Visible = False
End If

If Cmbnjm.Visible = True And (HFGd1.RowPos(HFGd1.Row) - Cmbnjm.Top < 100) Then
HFGd1.Text = Cmbnjm.Text
Cmbnjm.Visible = False
End If

'check edited item
HFGd1.Row = ksbjS + 1
For i = 2 To 3
HFGd1.Col = i
If HFGd1.Text = "" Then
MsgBox Mid("年级名班级号", (i - 2) * 3 + 1, 3) + " 不能为空"
Exit Sub
End If
Next
'是否已有同名班
HFGd1.Col = 2
strnjm = Trim(HFGd1.Text)
HFGd1.Col = 3
strbjh = Trim(HFGd1.Text)

For i = 1 To ksbjS

HFGd1.Row = i
HFGd1.Col = 2
nowstr = Trim(HFGd1.Text) ' = strnjm Then
HFGd1.Col = 3
nowstr = nowstr + Trim(HFGd1.Text)
If nowstr = strnjm + strbjh Then
MsgBox "已有同名班级，请重输！"
HFGd1.Text = ""
Exit Sub
End If