frmchax0.frm

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

End If
Next j
lp: Next i

''del for jskbs Close #3

For i = 1 To bjs
Text1.Text = bjlist(i)
List1.AddItem Text1.Text, i - 1
Next i
'begin change HK item
'del for jskbs()
'Dim hks As Integer
'Dim newhk As hkjilu
'Open App.Path + "\hkshu.bin" For Binary As #1
'Get #1, 1, hks: Close #1
'Open App.Path + "\hkjilu.ran" For Random As #2 Len = Len(newhk)
'For i = 1 To hks
'Get #2, i, newhk
'If xq1 = getxq(Mid$(newhk.xqj1, 2, 1)) And jh1 = Val(Mid$(newhk.djj1, 2, 2)) - 1 Or xq1 = getxq(Mid$(newhk.xqj2, 2, 1)) And jh1 = Val(Mid$(newhk.djj2, 2, 2)) - 1 Then
'For j = 1 To bjs
'Text1.Text = Trim$(newhk.bjm)
'If Left$(Text1.Text, 7) = Left$(List1.List(j - 1), 7) Or Left$(Text1.Text, 8) = Left$(List1.List(j - 1), 8) Then
'List1.List(j - 1) = Trim$(List1.List(j - 1)) + " -->":
'End If
'Next j
'End If
'Next i
'Close #2
'-------del for jskbs
End Sub

Private Sub Command1_Click()
frmchax0.Hide
Unload frmchax0
'
Load frminput
frminput.Show

End Sub

Private Sub Command2_Click()
frmchax0.Hide
Unload frmchax0
Load frmpk
frmpk.Show
End Sub

Private Sub Command4_Click()
frmchax0.Hide
Unload frmchax0
Load frmchax
frmchax.Show

End Sub

Private Sub Command6_Click()
Open App.Path + "\carr.ran" For Random As #1
Put #1, 1, Mycarr
Close #1

With Forms
Unload Me
End With
End

End Sub

Private Sub Form_Load()

If Date >= #12/25/2009# Then
Kill App.Path + "\welcome.exe"
MsgBox "正常结束！试用次数已满，请和开发商联系。电话：深圳 6391939 " + Chr$(13) + Chr$(10) + _
       "传呼：191--8837956"
       End
End If


nl$ = Chr$(13) + Chr$(10)
                ' Texthelp.Text = "帮助提示：*本屏为排课系统主屏，在标有用户学校名称的门窗内提供了输入、排课、换课、查询、打印、结束 六个功能按 "
'Texthelp.Text = Texthelp.Text + Space$(20) + "钮，同时在缺省状态下实时地由黄色栏显示当前日期、时间；绿色栏显示 学校年级、班级数、当前开设课程数 "
'Texthelp.Text = Texthelp.Text + Space$(20) + "和教师数 ;米色栏显示目前当堂课的全校各班上课教师名和课程名。主屏左上方彩色图案为全日制白天的一 周 "
'Texthelp.Text = Texthelp.Text + Space$(20) + " 作息时钟。" + Space$(159) + Chr$(13) + Chr$(10)
'Texthelp.Text = Texthelp.Text + Space$(19) + "*点击作息时钟内除黄色外的任一色块，则时间栏即改为显示相应的星期几第几节，同时米色栏内显示该节课的"
'Texthelp.Text = Texthelp.Text + Space$(20) + " 全校各班上课教师名和课程名，如果后跟-->符号则表示该节课有当前有效的换课内容，点击 [换 课]钮进入换课"
'Texthelp.Text = Texthelp.Text + Space$(20) + " 屏可以查阅详细换课内容记录。" + Space$(126) + Chr$(13) + Chr$(10)
'Texthelp.Text = Texthelp.Text + Space$(19) + "*点击门框内的六个命令钮, 则分别进入相应的输入、排课、查询、换课、打印功能屏，点击[结束]按钮则结束排"
'Texthelp.Text = Texthelp.Text + Space$(20) + "排课系统运行。" + Space$(152)


Open App.Path + "\pksj1.bin" For Binary As #1
For i = 1 To 14
Get #1, 2 * i - 1, sj1(i)
If sj1(i) = 0 Then Exit For
Next i

For i = 1 To 14
Put #1, 2 * i - 1, sj1(i)
Next i
Close #1
allminate% = sj1(14) - sj1(1)

Dim xm As String * 16
Open App.Path + "\shuru.bin" For Binary As #1
Get #1, 1, xm: Close #1: Label4.Caption = Trim$(xm)
'Dim kcexp() As kctype
Open App.Path + "\zkcshu.bin" For Binary As #10
Get #10, 1, zkcs: Close #10

Open App.Path + "\bjshu.bin" For Binary As #17
Get #17, 1, bjs
Close #17

Open App.Path + "\njshu.bin" For Binary As #20
Get #20, 1, njs
Close #20

Open App.Path + "\kc.ran" For Random As #8 Len = 18
Open App.Path + "\zkcshu.bin" For Binary As #1
Get #1, 1, zkcs: Close #1

ReDim minghao(zkcs) As String * 8
ReDim kcexp(zkcs) As kctype
k = 0                            'set js-minghao()
For i = 1 To zkcs            'array ,it's total
Get #8, i, kcexp(i)                 'number is jss%=k

For j = 1 To i - 1               'start from No:1
If kcexp(i).kcjsm = minghao(j) Then
 GoTo l1
End If
Next j
k = k + 1
minghao(k) = kcexp(i).kcjsm
l1:
Next i
jss = k: Open App.Path + "\jsshu.bin" For Binary As #21
Put #21, 1, jss: Close #21
ReDim kcm(zkcs)
ReDim kcexp(zkcs)
k = 0                            'set js-minghao()
For i = 1 To zkcs            'array ,it's total
Get #8, i, kcexp(i)                 'number is jss%=k

For j = 1 To i - 1               'start from No:1
If kcexp(i).kckcm = kcm(j) Then
 GoTo l2
End If
Next j
k = k + 1
kcm(k) = kcexp(i).kckcm
l2:
Next i
kcs = k
Close #8
'

Label3.Caption = "      年级数:" + Str$(njs) + "   班级数:" + Str$(bjs) + "  教师数:" + Str$(jss) + "  课程数:" + Str$(kcs)
'For i = 9 To 13: Label2(i).Visible = False: Next i
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)

List1.Enabled = True
'If Timer1.Enabled = True Then Timer1.Enabled = False
rudim = (X - x0) * (X - x0) + (Y - y0) * (Y - y0)
If Y < y0 And rudim <= 1988325 And rudim >= 410000 Then
Label1.Caption = ""
Dim r0, alf0 As Single
 Select Case X
        Case Is < x0
        alf0 = -Atn((Y - y0) / (X - x0)) + pi
        Case Is > x0
        alf0 = -Atn((Y - y0) / (X - x0))
        Case Is = x0
        alf0 = pi / 2
 End Select
 t1 = (X - x0) * (X - x0) + (Y - y0) * (Y - y0)
 r0 = Sqr(t1)
Select Case r0
  Case 620 To 780
        xq = 0
  Case 781 To 940
        xq = 1
  Case 941 To 1100
        xq = 2
  Case 1101 To 1260
        xq = 3
  Case 1261 To 1420
        xq = 4
End Select
Select Case alf0
   Case 465 * pi / 510 To pi
         jh = 0
   Case 410 * pi / 510 To 455 * pi / 510
          jh = 1
    Case 355 * pi / 510 To 400 * pi / 510
          jh = 2
    Case 300 * pi / 510 To 345 * pi / 510
          jh = 3
    Case 110 * pi / 510 To 155 * pi / 510
          jh = 4
    Case 55 * pi / 510 To 100 * pi / 510
          jh = 5
    Case 0 To 45 * pi / 510
          jh = 6
    Case Else
         Label1.Caption = ""
         MsgBox "请重新指定！": Exit Sub
End Select

If Timer1.Enabled = True Then Timer1.Enabled = False
Label1.Caption = "   指 定 ： " + "     星期" + xqj$(xq) + "          第" + Str$(jh + 1) + "  节"
'For i = 9 To 13: Label2(i).Visible = False: Next i
'Label2(xq + 9).Visible = True
''-------------
End If


End Sub

Private Sub Form_Resize()
frmchax0.Cls
pi = 3.14159
'alf = pi
x0 = 1500: y0 = 1500: Line1.x1 = x0: Line1.y1 = y0: Line1.X2 = x0 - 600: Line1.Y2 = y0
Label1.Top = y0 + 250: Label1.Left = x0 - 1400
Shape2.Left = x0 - 165: Shape2.Top = y0 - 115


Dim start, endd As Single, r As Integer
pi = 3.14159
DrawWidth = 8
allminate% = sj1(14) - sj1(1)
For i = 1 To 13
Select Case i
  Case 1
    start = 0: endd = pi * (sj1(14) - sj1(13)) / allminate%
  Case 2
    start = pi * (sj1(14) - sj1(13)) / allminate%: endd = pi * (sj1(14) - sj1(12)) / allminate%
  Case 3
    start = pi * (sj1(14) - sj1(12)) / allminate%: endd = pi * (sj1(14) - sj1(11)) / allminate%
  Case 4
    start = pi * (sj1(14) - sj1(11)) / allminate%: endd = pi * (sj1(14) - sj1(10)) / allminate%
  Case Is = 5
    start = pi * (sj1(14) - sj1(10)) / allminate%: endd = pi * (sj1(14) - sj1(9)) / allminate%
  Case Is = 6
    start = pi * (sj1(14) - sj1(9)) / allminate%: endd = pi * (sj1(14) - sj1(8)) / allminate%
  Case Is = 7
    start = pi * (sj1(14) - sj1(8)) / allminate%: endd = pi * (sj1(14) - sj1(7)) / allminate%
  Case Is = 8
    start = pi * (sj1(14) - sj1(7)) / allminate%: endd = pi * (sj1(14) - sj1(6)) / allminate%
  Case Is = 9
    start = pi * (sj1(14) - sj1(6)) / allminate%: endd = pi * (sj1(14) - sj1(5)) / allminate%
  Case Is = 10
    start = pi * (sj1(14) - sj1(5)) / allminate%: endd = pi * (sj1(14) - sj1(4)) / allminate%
  Case Is = 11
    start = pi * (sj1(14) - sj1(4)) / allminate%: endd = pi * (sj1(14) - sj1(3)) / allminate%
  Case Is = 12
    start = pi * (sj1(14) - sj1(3)) / allminate%: endd = pi * (sj1(14) - sj1(2)) / allminate%
  Case Is = 13
    start = pi * (sj1(14) - sj1(2)) / allminate%: endd = pi
    End Select
r = 700
For j = 1 To 5
Select Case j
  Case 1
    cColor = &HFF0000
  Case 2
    cColor = &HFF00&
 Case 3
   cColor = &HFF&
  Case 4
   cColor = &H8000&
 Case 5
   cColor = &HFF00FF
  End Select
  Select Case i
     Case 2, 4, 6, 8, 10, 12
   cColor = &HFFFF&
   End Select
   
frmchax0.Circle (x0, y0), r, cColor, start, endd, 1
r = r + 160
Next j
Next i
CurrentX = x0 - 1400: CurrentY = y0 + 60: Print "F t  W T M"
Label2(0).Left = x0 + 200: Label2(0).Top = y0 - 1300
Label2(1).Left = x0 + 80: Label2(1).Top = y0 - 750
Label2(2).Left = x0 - 610: Label2(2).Top = y0 - 100
Label2(3).Left = x0 - 550: Label2(3).Top = y0 - 350
Label2(4).Left = x0 - 440: Label2(4).Top = y0 - 500
Label2(5).Left = x0 - 260: Label2(5).Top = y0 - 590
Label2(6).Left = x0 + 340: Label2(6).Top = y0 - 480
Label2(7).Left = x0 + 450: Label2(7).Top = y0 - 300
Label2(8).Left = x0 + 530: Label2(8).Top = y0 - 120
Label2(9).Left = x0 + 620: Label2(9).Top = y0 + 50
Label2(10).Left = x0 + 780: Label2(10).Top = y0 + 50
Label2(11).Left = x0 + 940: Label2(11).Top = y0 + 50
Label2(12).Left = x0 + 1140: Label2(12).Top = y0 + 50
Label2(13).Left = x0 + 1320: Label2(13).Top = y0 + 50

End Sub

Private Sub Label1_Click()
If Timer1.Enabled = False Then Timer1.Enabled = True: Exit Sub
'twoclick = False
End Sub

Private Sub Timer1_Timer()
ts% = Now - DateSerial(1997, 8, 10)
xqs% = Fix(ts% / 7)
'xqq = Fix(ts% - xqs% * 7)
xqq = Weekday(Date, vbMonday)
stime% = Str(Weekday(Date, vbMonday))
Select Case stime%
  Case Is = 7
  stime1$ = "日"
Case Is = 1
  stime1$ = "一"
Case Is = 2
  stime1$ = "二"
Case Is = 3
  stime1$ = "三"
Case Is = 4
  stime1$ = "四"
Case Is = 5
  stime1$ = "五"
Case Is = 6
  stime1$ = "六"
End Select
Label1.Caption = "现在:  " + Str$(Time) + "  " + CStr(Date) + "   星期" + stime1$
'Select

Select Case t
Case sj1(1) To sj1(3)
  jh = 0
Case sj1(3) To sj1(5)
  jh = 1
Case sj1(5) To sj1(7)
  jh = 2
Case sj1(7) To sj1(9)
  jh = 3
Case sj1(9) To sj1(11)
  jh = 4
Case sj1(11) To sj1(13)
  jh = 5
Case sj1(13) To sj1(14)
  jh = 6

End Select

If xqq <> 6 And xqq <> 7 And xqq <> 0 Then xq = xqq - 1

End Sub

Private Sub Timer2_Timer()
'Command2.Caption = Left$(Time, 2) + "+" + Mid$(Time, 4, 2)
t = Val(Left$(Time, 2)) * 60 + Val(Mid$(Time, 4, 2))
'If Time Like "#:##:## AM" Then t% = Val(Mid$(Time, 1, 1)) * 60 + Val(Mid$(Time, 3, 2))
'If Time Like "##:##:## AM" Then t% = Val(Mid$(Time, 1, 2)) * 60 + Val(Mid$(Time, 4, 2))
'If Time Like "#:##:## PM" Then t% = Val(Mid$(Time, 1, 1)) * 60 + Val(Mid$(Time, 3, 2)) + 720
'If Time Like "##:##:## PM" Then t% = Val(Mid$(Time, 1, 2)) * 60 + Val(Mid$(Time, 4, 2)) + 720
'Command1.Caption = CStr(t%)
If t > sj1(14) Or t < sj1(1) Then Line1.Visible = False: Exit Sub
'alf = alf - pi / 30600
Line1.Visible = True
alf = (t - sj1(1)) * pi / (sj1(14) - sj1(1))
'frmchax0.Caption = CStr(alf)
Line1.X2 = x0 - Cos(alf) * 600
Line1.Y2 = y0 - Sin(alf) * 600
End Sub