?? frmchax0.frm
字號:
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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -