frmautopk.frm

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

Dim strJs0(200), strJs1(100), strJs2(100), strJs3(100), strJs4(100) As String * 4
Dim b, i, j, m, intjsRnd, jsIndex As Integer
Dim intRn0, intRn1, intRn2, intRn3, intRn4 As Integer
Dim intJs0, intJs1, intJs2, intJs3, intJs4 As Integer
'   R-教师名在册行数，C-教师名在册列数
'Dim RJs0(200), CJs0(200), RJs1(100), CJs1(100), RJs2(50), CJs2(50) As Integer
Dim jscolo(5) As Long
jscolo(0) = &HFF&   'red
jscolo(5) = &HC0C0C0 'gray
jscolo(4) = &HFFFF& 'yellow
jscolo(3) = &HFF00& 'green
jscolo(2) = &HFF0000 'dip blue
jscolo(1) = &HFF00FF 'pink

For b = 1 To ksbjs
frmpk.Combo1.ListIndex = b - 1 '展开各班考试表
frmpk.mnuok_Click '教师名册显色
'构造最轻量教师组
minJss = 0: intJs0 = 0: intJs1 = 0: intJs2 = 0
With frmpk.HFGd1
For i = 1 To .Rows - 1
For j = 1 To .Cols - 1
.Row = i
.Col = j
    Select Case .CellForeColor
        Case Is = jscolo(0)
        intJs0 = intJs0 + 1
        For m = 1 To intJs0
        If strJs0(m) = Trim(.Text) Then
        intJs0 = intJs0 - 1
        GoTo TM0
        End If
        Next m
        strJs0(intJs0) = Trim(.Text)
TM0:
        Case Is = jscolo(1)
        intJs1 = intJs1 + 1
        For m = 1 To intJs1
        If strJs1(m) = Trim(.Text) Then
        intJs1 = intJs1 - 1
        GoTo TM1
        End If
        Next m
        strJs1(intJs1) = Trim(.Text)
TM1:
        Case Is = jscolo(2)
        intJs2 = intJs2 + 1
        For m = 1 To intJs2
        If strJs2(m) = Trim(.Text) Then
        intJs2 = intJs2 - 1
        GoTo TM2
        End If
        Next m
        strJs2(intJs2) = Trim(.Text)
TM2:
        Case Is = jscolo(3)
        intJs3 = intJs3 + 1
        For m = 1 To intJs3
        If strJs3(m) = Trim(.Text) Then
        intJs3 = intJs3 - 1
        GoTo TM3
        End If
        Next m
        strJs3(intJs3) = Trim(.Text)
TM3:
        Case Is = jscolo(4)
        intJs4 = intJs4 + 1
        For m = 1 To intJs4
        If strJs4(m) = Trim(.Text) Then
        intJs4 = intJs4 - 1
        GoTo TM4
        End If
        Next m
        strJs4(intJs4) = Trim(.Text)
TM4:
   End Select
Next j
Next i
End With
'监考0、1、2\3\4次的教师已分别登入数组
'给班级表中有考试课程的节次分配监考教师一名
intRn0 = 0: intRn1 = 0: intRn2 = 0: intRn3 = 0: intRn4 = 0
For i = 0 To Class - 1
For j = 0 To Day - 1

intRn0 = 0: intRn1 = 0: intRn2 = 0: intRn3 = 0: intRn4 = 0

If Trim(bjarr(b).ksbiao(i, j)) <> "x" Then
'有考试课程
If Trim(frmpk.Labjkjs(Day * i + j).Caption) = "" Then
'尚无监考教师
    '选定一名教师
    If intJs0 <> 0 Then '在0组选
        
Rn0:    intjsRnd = Int(Rnd * intJs0 + 1)
        Gjsm = strJs0(intjsRnd)
        For m = intjsRnd To intJs0 - 1
        strJs0(m) = strJs0(m + 1)
        Next m
        intJs0 = intJs0 - 1
        '确定所选教师的序号
        jsIndex = MinToHao(Gjsm)
        
        If Trim(jsarr(jsIndex).jkbiao1(i, j)) = "x" Then
        frmpk.Labjkjs(Day * i + j).Caption = Gjsm
        Else '该教师在该节已有监考
        intRn0 = intRn0 + 1
        If intRn0 < 5 Then GoTo Rn0
        End If
           
     Else  '0组空，须在1组选
       If intJs1 <> 0 Then
    
Rn1:    intjsRnd = Int(Rnd * intJs1 + 1)
        Gjsm = strJs1(intjsRnd)
        For m = intjsRnd To intJs1 - 1
        strJs1(m) = strJs1(m + 1)
        Next m
        intJs1 = intJs1 - 1
        '确定所选教师的序号
        jsIndex = MinToHao(Gjsm)
        
        If Trim(jsarr(jsIndex).jkbiao1(i, j)) = "x" Then
        frmpk.Labjkjs(Day * i + j).Caption = Gjsm
        Else '该教师在该节已有监考
        intRn1 = intRn1 + 1
        If intRn1 < 5 Then GoTo Rn1
        End If
   
    
       Else '1组空，须在2组选
         If intJs2 <> 0 Then
         
Rn2:    intjsRnd = Int(Rnd * intJs2 + 1)
        Gjsm = strJs2(intjsRnd)
        For m = intjsRnd To intJs2 - 1
        strJs2(m) = strJs2(m + 1)
        Next m
        intJs2 = intJs2 - 1
        '确定所选教师的序号
        jsIndex = MinToHao(Gjsm)
        
        If Trim(jsarr(jsIndex).jkbiao1(i, j)) = "x" Then
        frmpk.Labjkjs(Day * i + j).Caption = Gjsm
        Else '该教师在该节已有监考
        intRn2 = intRn2 + 1
        If intRn2 < 5 Then GoTo Rn2
        End If
         
         
         Else '2组空，须在3组选
           If intJs3 <> 0 Then
           
Rn3:    intjsRnd = Int(Rnd * intJs3 + 1)
        Gjsm = strJs3(intjsRnd)
        For m = intjsRnd To intJs3 - 1
        strJs3(m) = strJs3(m + 1)
        Next m
        intJs3 = intJs3 - 1
        '确定所选教师的序号
        jsIndex = MinToHao(Gjsm)
        
        If Trim(jsarr(jsIndex).jkbiao1(i, j)) = "x" Then
        frmpk.Labjkjs(Day * i + j).Caption = Gjsm
        Else '该教师在该节已有监考
        intRn3 = intRn3 + 1
        If intRn3 < 5 Then GoTo Rn3
        End If
                     
           Else '3组空，须在4组选
             If intJs4 <> 0 Then
             
Rn4:    intjsRnd = Int(Rnd * intJs4 + 1)
        Gjsm = strJs4(intjsRnd)
        For m = intjsRnd To intJs4 - 1
        strJs4(m) = strJs4(m + 1)
        Next m
        intJs4 = intJs4 - 1
        '确定所选教师的序号
        jsIndex = MinToHao(Gjsm)
        
        If Trim(jsarr(jsIndex).jkbiao1(i, j)) = "x" Then
        frmpk.Labjkjs(Day * i + j).Caption = Gjsm
        Else '该教师在该节已有监考
        intRn4 = intRn4 + 1
        If intRn4 < 5 Then GoTo Rn4
        End If
             
             
             End If
           End If
         End If
       End If
     End If
End If
End If
Next j
Next i
frmpk.jkok_Click
PBar1.Value = b
Next b
'Timer1.Enabled = False
Me.MousePointer = 1
End Sub

Private Sub Command2_Click()
Unload Me

End Sub

Private Sub Form_Load()
PBar1.Max = ksbjs
PBar1.Min = 1
Dim intkss, intpkcs, intjks, b, i, j As Integer
intkss = 0: intpkcs = 0: intjks = 0

For b = 1 To ksbjs
intkss = bjarr(b).kskc.num + intkss
For i = 0 To Class - 1
For j = 0 To Day - 1

If bjarr(b).ksbiao(i, j) <> "x" Then
intpkcs = intpkcs + 1
End If

If bjarr(b).jsbiao1(i, j) <> "x" Then
intjks = intjks + 1
End If

Next j
Next i
Next b
Label1.Caption = Str(ksbjs)
Label2.Caption = Str(jkjss)
Label3.Caption = Str(intkss)
Label4.Caption = Str(intpkcs)
Label5.Caption = Str(intjks)
End Sub

Private Sub Option1_Click()
If Option1.Value = True Then
jkBenBan = False
End If

End Sub

Private Sub Option2_Click()
If Option2.Value = True Then
jkBenBan = True
End If

End Sub

Private Sub Option3_Click()
If Option3.Value = True Then
jkBenKe = False
End If

End Sub

Private Sub Option4_Click()
If Option4.Value = True Then
jkBenKe = True
End If

End Sub

Private Sub Option5_Click()
If Option5.Value = True Then
cenTime = False
End If

End Sub

Private Sub Option6_Click()
If Option6.Value = True Then
cenTime = True
End If

End Sub

Private Sub Option7_Click()
If Option7.Value = True Then
equWork = True
End If

End Sub

Private Sub Option8_Click()
If Option8.Value = True Then
equWork = False
End If

End Sub