frmprint.frm

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

Printer.ScaleWidth = 100: Printer.ScaleHeight = 200
Printer.CurrentX = 35: Printer.CurrentY = 10: Printer.FontSize = 16
Printer.Print "教师名单（按课程分组）"
Printer.CurrentX = 5: Printer.CurrentY = 20:
Printer.FontSize = 12
xx = 5: yy = 20
For j = 1 To jend - 1
Printer.CurrentX = xx: Printer.CurrentY = yy
Printer.Print Left$(kcm(j), 2) + "："
xx = 5
yy = yy + 6
Printer.CurrentX = xx: Printer.CurrentY = yy
'Printer.CurrentY = Printer.CurrentY + 10: Printer.CurrentX = 5
If Printer.CurrentY >= 195 Then Call drawpkcjsm
strtemp = "/"
For i = 1 To zks
Get #2, i, kcexp(i)
'Text1.Text = kcexp(i).kckcm: Text2.Text = kcexp(i).kcjsm
If kcm(j) = kcexp(i).kckcm And InStr(strtemp, kcexp(i).kcjsm) = 0 Then
strtemp = strtemp + kcexp(i).kcjsm
Printer.Print Left$(kcexp(i).kcjsm, 5)
xx = xx + 10
If xx >= 90 Then xx = 5: yy = yy + 6
Printer.CurrentX = xx: Printer.CurrentY = yy
If Printer.CurrentY >= 195 Then Call drawpkcjsm
End If
Next i
xx = 5
yy = yy + 6
Next j
Close #2
Printer.EndDoc

End Sub

Sub pnjjsm()
Dim pjsm As String * 8
Dim sold As Integer
Open App.Path + "\njjsm.bin" For Binary As #1
Open App.Path + "\njjsshu.bin" For Binary As #2
Open App.Path + "\njm.bin" For Binary As #3
Open App.Path + "\njshu.bin" For Binary As #4
Get #4, 1, njs%: Close #4
ReDim njm(njs%)
ReDim njjsshu(njs%)
For i = 1 To njs%
Get #2, (i - 1) * 2 + 1, njjsshu(i)
Get #3, (i - 1) * 8 + 1, njm(i)
Next i
Close #3
Close #2
Call drawnjjsm: Printer.FontSize = 12
x0 = 15: y0 = 25
sold = 0: njjsshu(0) = 0
For i = 1 To njs%
sold = sold + njjsshu(i - 1)
Printer.CurrentX = 15: Printer.CurrentY = y0
'FontSize = 12
Printer.Print Left$(njm(i), 6) + "年级："
y0 = y0 + 8: x0 = 15
For j = 1 To njjsshu(i)
Get #1, (sold + j - 1) * 8 + 1, pjsm
Printer.CurrentX = x0: Printer.CurrentY = y0
Printer.Print Left$(pjsm, 6)
x0 = x0 + 10
If x0 > 85 Then x0 = 15: y0 = y0 + 8
If y0 > 205 Then Printer.NewPage: Call drawnjjsm: Printer.FontSize = 12: x0 = 15: y0 = 25
Next j
y0 = y0 + 10
If y0 > 205 Then Call drawnjjsm: Printer.FontSize = 12: y0 = 25: x0 = 15
Next i

Close #1
Printer.EndDoc
End Sub

Private Sub Chkpbj_Click()
If Chkpbj.Value = 0 Then
'Chkpbj.Value = 1

For i = 0 To Lstpbj.ListCount - 1
Lstpbj.Selected(i) = False
Next i

Else
'Chkpbj.Value = 0
For i = 0 To Lstpbj.ListCount - 1
Lstpbj.Selected(i) = True
Next i
End If

End Sub

Private Sub Cmdpbjcut_Click()
Unload frmprint
Load frmchax0
frmchax0.Show

End Sub

Private Sub Cmdpjscut_Click()
'MsgBox CStr(Printer.FontSize): MsgBox Printer.FontName
End Sub


Private Sub cmdpjsmcut_Click()
Call drawbzmbiao
Printer.EndDoc
End Sub


Private Sub cmdbjok_Click()
Load frmbjoption
frmbjoption.Show
frmbjoption.Visible = True
End Sub

Private Sub Cmdjsok_Click()
Load frmjsoption
frmjsoption.Show
frmjsoption.Visible = True



'Printer.FontName = Gzt
'MsgBox Gstrbshu + "bshu"
'MsgBox Gstrbt + "biaoti"
'MsgBox Gzt + "zi ti"
'MsgBox Gbtcolor + "+" + Gttcolor + "+" + Gzwcolor
'MsgBox Printer.Width
'MsgBox Printer.Height
'MsgBox Printer.ScaleWidth
'MsgBox Printer.ScaleHeight
End Sub

Private Sub cmdjsoption_Click()
'frmjsoption.Visible = False

End Sub

Private Sub Cmdlsb_Click()
 Load frmlsb
 frmlsb.Visible = True
 
End Sub

Private Sub cmdpbjok_Click()
Dim ans As Integer
ans = MsgBox("是否将第五节课打印在上午？", vbYesNo + vbDefaultButton2)
sheadbj = "班  级  课  程  表"

For k = 0 To Lstpbj.ListCount - 1
If Lstpbj.Selected(k) = False Then GoTo newitem
bjhao = k + 1

Open App.Path + "\bjkcbiao.ran" For Random As #12 Len = Len(newbiao)
Get #12, bjhao, newbiao
Close #12

Printer.CurrentX = 5000
Printer.CurrentY = 4300
Printer.FontSize = 16
Printer.Print sheadbj

sname = Mid$(newbiao.bj, 1, 8) + "   班" '"初一 8  班"

'sheadjs = "教  师  课  程  表"
'Printer.DrawWidth = 4
Printer.FontSize = 13
'Printer.Line (4600, 4600)-(6000, 4600)
x0 = 3025
y0 = 5000
For i = 1 To 9
Printer.Line (3025, y0)-(9775, y0)
y0 = y0 + 675
Next i
x0 = 3025 + 1125
For i = 1 To 6
Printer.Line (x0, 5000)-(x0, 10400)
x0 = x0 + 1125
Next i
Printer.Line (3025, 5675)-(3025, 10400)
Printer.Line (2000, 5000)-(2000, 10400) 'first |
Printer.Line (2000, 5000)-(3025, 5000)
Printer.Line (2000, 5675)-(3025, 5675)

If ans = 7 Then   'middle time line
Printer.Line (2000, 8375)-(3025, 8375)
Else
Printer.Line (2000, 9050)-(3050, 9050)
End If

Printer.Line (2000, 10400)-(3025, 10400)
Printer.CurrentX = 2400: Printer.CurrentY = 6300
Printer.Print "上"
If ans = 7 Then
Printer.CurrentX = 2400: Printer.CurrentY = 7400
Printer.Print "午"
Else
Printer.CurrentX = 2400: Printer.CurrentY = 7400 + 675
Printer.Print "午"
End If

If ans = 7 Then
Printer.CurrentY = 8975: Printer.CurrentX = 2400
Printer.Print "下"
Printer.CurrentY = 9650: Printer.CurrentX = 2400
Printer.Print "午"
Else
Printer.CurrentY = 9400: Printer.CurrentX = 2400
Printer.Print "下"
Printer.CurrentY = 10040: Printer.CurrentX = 2400
Printer.Print "午"
End If

Printer.CurrentY = 5200
Printer.CurrentX = 2300
Printer.Print sname

x0 = 4300
Dim xh(5) As String
xh(1) = "星期一": xh(2) = "星期二": xh(3) = "星期三": xh(4) = "星期四": xh(5) = "星期五"
Printer.CurrentX = x0: Printer.CurrentY = 5200
For i = 1 To 5
Printer.CurrentX = x0: Printer.CurrentY = 5200
Printer.Print xh(i)
x0 = x0 + 1125
Next i


x0 = 3480
y0 = 5900
For i = 1 To 7
Printer.CurrentX = x0
Printer.CurrentY = y0
Printer.Print i
y0 = y0 + 675
Next i

'Printer.FontSize = 14
y0 = 5890
For i = 0 To Class - 1
x0 = 4320
For j = 0 To Day - 1
If Trim$(newbiao.kcbiao(i, j)) = "x" Then GoTo no
Printer.CurrentX = x0: Printer.CurrentY = y0
Printer.Print Mid$(newbiao.kcbiao(i, j), 1, 1) + "   " + Mid$(newbiao.kcbiao(i, j), 2, 1)
no:
x0 = x0 + 1125
Next j
y0 = y0 + 670
Next i


Printer.NewPage
newitem: Next k

Printer.EndDoc


End Sub

Private Sub Cmdpcut_Click()
Unload frmprint
Load frmchax0
frmchax0.Show
End Sub

Private Sub Cmdphelp_Click()
MsgBox "提示：*选定教师名后，点击[开始打印]即可打印该教师的课程表。" + Chr$(13) + Chr$(10) _
      + "      *选定班级名后，点击[开始打印]即可打印该班级的课程表。" + Chr$(13) + Chr$(10) _
      + "      *选定星期几后，点击[开始打印]即可打印全校的总课程表。" + Chr$(13) + Chr$(10) _
      + "      *输入要打印的页数后，点击[开始打印]即可打印课程时间表。" + Chr$(13) + Chr$(10) _
      + "      * 选定要求后，点击[开始打印]即可打印班主任名单.按年级分组的或按课程分组的教师名单"
End Sub



Private Sub cmdpsjbcut_Click()
Dim pjsm As String * 8
Dim sold As Integer
Open App.Path + "\njjsm.bin" For Binary As #1
Open App.Path + "\njjsshu.bin" For Binary As #2
Open App.Path + "\njm.bin" For Binary As #3
Open App.Path + "\njshu.bin" For Binary As #4
Get #4, 1, njs%: Close #4
ReDim njm(njs%)
ReDim njjsshu(njs%)
For i = 1 To njs%
Get #2, (i - 1) * 2 + 1, njjsshu(i) ': MsgBox CStr(njjsshu(i))
Get #3, (i - 1) * 8 + 1, njm(i)
Next i
Close #3
Close #2
Call drawnjjsm
x0 = 5: y0 = 15
sold = 0: njjsshu(0) = 0
For i = 1 To njs%
sold = sold + njjsshu(i - 1)
Printer.CurrentX = 5: Printer.CurrentY = y0
FontSize = 12
'Printer.Print njm(i)
'MsgBox njm(i)
y0 = y0 + 10: x0 = 5: For k = 1 To njjsshu(1): Get #1, (k - 1) * 8 + 1, pjsm: Next k
For j = 1 To njjsshu(i)
Get #1, (sold + j - 1) * 8 + 1, pjsm
Printer.CurrentX = x0: Printer.CurrentY = y0
'Printer.Print pjsm
x0 = x0 + 15
If x0 > 96 Then x0 = 5: y0 = y0 + 10
If y0 > 205 Then Printer.NewPage:  x0 = 5: y0 = 15
Next j
y0 = y0 + 10
If y0 > 205 Then y0 = 15: x0 = 5
Next i

Close #1
'Printer.EndDoc
End Sub

Private Sub cmdpjsmok_Click()
If Optbzm.Value = True Then Call pbzm: Exit Sub
If Optnjjsm.Value = True Then Call pnjjsm: Exit Sub
If Optkcjsm.Value = True Then Call pkcjsm: Exit Sub
MsgBox "请指定打印要求！"


End Sub

Private Sub Cmdpjsok_Click()
Dim ans As Integer
ans = MsgBox("是否将第五节课打印在上午？", vbYesNo + vbDefaultButton2)

If Lstpjs.ListIndex = -1 And Chkpjs.Value = False Then MsgBox "请先指定要打印的教师！": Exit Sub
If Chkpjs.Value = True Then
For i = 0 To Lstpjs.ListCount - 1
Lstpjs.Selected(i) = True
Next i
End If

For k = 0 To Lstpjs.ListCount - 1
If Lstpjs.Selected(k) = False Then GoTo newitem
jshao = k + 1

'Open App.Path + "\jsrkbiao.ran" For Random As #12 Len = Len(nowbiao)
'Get #12, jshao, nowbiao
'Close #12
'‘------------------
Call drawjskb(0, 50, ans)
Printer.CurrentX = 5: Printer.CurrentY = 78
Printer.Print Trim$(Left$(nowbiao.js, 4)) + " 老师"

y0 = 88
For i = 0 To Class - 1
x0 = 23
For j = 0 To Day - 1
Printer.CurrentX = x0: Printer.CurrentY = y0
If Trim$(nowbiao.rkbiao(i, j)) = "0" Then GoTo no
Printer.Print Mid$(nowbiao.rkbiao(i, j), 1, 2) + Trim$(Mid$(nowbiao.rkbiao(i, j), 7, 5))
no:
x0 = x0 + 16
Next j
y0 = y0 + 10
Next i


Printer.NewPage
newitem: Next k

Printer.EndDoc

End Sub

Private Sub Cmdpsjbok_Click()
Dim ys As Integer
If text5.Text Like "###" = fasle Then MsgBox "页数不合法，请按“###”三位数格式重输！": Exit Sub
ys = Val(text5.Text)
ans = MsgBox("确认要打印  " + CStr(ys) + "页，共 " + CStr(ys * 4) + " 份时间表吗？", vbYesNo)
If ans = vbNo Then Exit Sub
Printer.FontSize = 12
For i = 1 To ys
Printer.ScaleWidth = 110: Printer.ScaleHeight = 200

Call drawsj(1, 1)
Call drawsj(1, 101)
Call drawsj(58, 1)
Call drawsj(58, 101)
Printer.NewPage
Next i
Printer.EndDoc

End Sub

Private Sub Cmdpzkbok_Click()
Dim zkbhead As String
Dim bjs As Integer
Dim xqj As Integer
Open App.Path + "\bjshu.bin" For Binary As #3
Get #3, 1, bjs
Close #3

If Lstpzkb.ListIndex = -1 Then
MsgBox "没有指定打印范围！"
Exit Sub
End If
xqj = Lstpzkb.ListIndex + 1
zkbhead = Lstpzkb.List(xqj - 1) + "总课表"


Open App.Path + "\bjkcbiao.ran" For Random As #1 Len = Len(newbiao)
'Printer.FontSize = 12
For i = 1 To bjs
If i = 1 Or i = 21 Or i = 41 Then drawbiao (zkbhead): y0 = 33
Get #1, i, newbiao
Printer.CurrentX = 7: Printer.CurrentY = y0
Printer.Print Mid$(newbiao.bj, 1, 8)
x0 = 20
For j = 0 To Class - 1
Printer.CurrentX = x0: Printer.CurrentY = y0
If Trim$(newbiao.kcbiao(j, xqj - 1)) = "x" Then GoTo nw
'print here
If Gdaijsm = True Then
'print jsm and kcm

End If

Printer.Print Mid$(newbiao.kcbiao(j, xqj - 1), 1, 1) + "    " + Mid$(newbiao.kcbiao(j, xqj - 1), 2, 1)
nw: x0 = x0 + 10
Next j

y0 = y0 + 10
If i = 20 Or i = 40 Then Printer.NewPage
Next i
Close #1

Printer.EndDoc

End Sub

Private Sub Command1_Click()
End Sub

Private Sub Command2_Click()
End Sub


Private Sub Form_Load()
Option1.Value = 1
Ghebin = 0
text5.Text = ""
Text1.Text = "": Text2.Text = ""
Text1.Enabled = False: Text2.Enabled = False
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)
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).kcjsm = minghao(j) Then
 GoTo l1
End If
Next j
k = k + 1
minghao(k) = kcexp(i).kcjsm
l1:
Next i
jss% = k
Close #8



'Open App.Path + "\jsrkbiao.ran" For Random As #13 Len = Len(nowbiao)
For i = 1 To jss%: Lstpjs.List(i - 1) = minghao(i): Next i
'Close #13


Open App.Path + "\bjshu.bin" For Binary As #7
Get #7, 1, bjs
Close #7
Open App.Path + "\bj.ran" For Random As #6 Len = 18
For i = 1 To bjs
Get #6, i, nowbj
Text3.Text = nowbj.bjnjm: Text4.Text = nowbj.bjbjm
Lstpbj.List(i - 1) = Text3.Text + Text4.Text 'nowbj.bjnjm + nowbj.bjbjm
Next i
Close #6
Lstpbj.ListIndex = -1: Lstpjs.ListIndex = -1
End Sub

Private Sub Option1_Click()
Ghebin = False
End Sub

Private Sub Option2_Click()
Dim hebins, i As Integer
hebins = 0
For i = 0 To Lstpjs.ListCount - 1
If Lstpjs.Selected(i) = True Then
hebins = hebins + 1
End If
Next i
If hebins = 2 Then
Ghebin = True
Else
MsgBox "一次只能选定两位教师进行合并！"
Option2.Value = 0
Option1.Value = 1
Ghebin = False
End If
End Sub