frmbjoption.frm

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

'chkhavebjsj = False
Gstrsj = ""
End If

If Chkhavebt.Value = 1 Then
'chkhavebjbt = True
Gstrbt = Trim$(Texbt.Text)
Else
'chkhavebjbt = False
Gstrbt = ""
End If

If frmprint.Lstpbj.ListIndex = -1 Then MsgBox "请先指定要打印的班级！": Exit Sub

Open App.Path + "\bjkcbiao.ran" For Random As #12 Len = Len(newbiao)
  Dim bjhao, i, j, b As Integer
  Dim xx, yy, ww, hh As Single
  Dim firstpage, upperbiao As Boolean
  Printer.ScaleMode = 6
'Gstrbt = Gstrbjbt
'Gstrbz = Gstrbjbz
Printer.FontName = Gbjzt

Select Case Trim$(Gstrbshu)
  Case Is = "bj1b"
  Printer.Orientation = 2
  Gsizebt = 30
  Gsize = 20
ww = Printer.ScaleWidth * 90 / 100
hh = Printer.ScaleHeight * 95 / 100
xx = (Printer.ScaleWidth - ww) * 2 / 3
yy = (Printer.ScaleHeight - hh) / 2
firstpage = True
For b = 0 To frmprint.Lstpbj.ListCount - 1
If frmprint.Lstpbj.Selected(b) = True Then
Get #12, b + 1, newbiao
workb.name = Left$(newbiao.bj, 8) + "班"
For i = 0 To Class - 1
For j = 0 To Day - 1
workb.biao(i, j) = Left$(newbiao.kcbiao(i, j), 10)
If Trim$(workb.biao(i, j)) = "x" Then workb.biao(i, j) = " "
Next j
Next i
If Not firstpage Then Printer.NewPage
Call printb(xx, yy, ww, hh)
firstpage = False
End If
Next b
Printer.EndDoc

  Case Is = "bj2b"
  Printer.Orientation = 1
  Gsizebt = 26
  Gsize = 16
  firstpage = True
  upperbiao = True
 
For b = 0 To frmprint.Lstpbj.ListCount - 1
If frmprint.Lstpbj.Selected(b) = True Then
Get #12, b + 1, newbiao
workb.name = Left$(newbiao.bj, 8) + "班"
For i = 0 To Class - 1
For j = 0 To Day - 1
workb.biao(i, j) = Left$(newbiao.kcbiao(i, j), 10)
If Trim$(workb.biao(i, j)) = "x" Then workb.biao(i, j) = " "
Next j
Next i
If Not firstpage And upperbiao = True Then Printer.NewPage
ww = Printer.ScaleWidth * 95 / 100
hh = Printer.ScaleHeight * 45 / 100
xx = (Printer.ScaleWidth - ww) / 2

If upperbiao Then
yy = (Printer.ScaleHeight - 2 * hh) / 4 '(Printer.ScaleHeight - hh)
Else
yy = hh + (Printer.ScaleHeight - 2 * hh) * 3 / 4 '(Printer.ScaleHeight - hh)
End If

Call printb(xx, yy, ww, hh)
firstpage = False

If upperbiao Then
upperbiao = False
Else
upperbiao = True
End If

End If
Next b
Printer.EndDoc

  Case Is = "bjkd4b"
'  MsgBox "bjkd2b"
  Printer.Orientation = 1
  Gsizebt = 26
  Gsize = 16
  ww = Printer.ScaleWidth * 45 / 100
  hh = Printer.ScaleHeight * 45 / 100

  
  firstpage = True
 ' upperbiao = 1 'True
 Dim biaohao As Integer
biaohao = 0

For b = 0 To frmprint.Lstpbj.ListCount - 1
If frmprint.Lstpbj.Selected(b) = True Then
biaohao = biaohao + 1

Get #12, b + 1, newbiao
workb.name = Left$(newbiao.bj, 8) + "班"
For i = 0 To Class - 1
For j = 0 To Day - 1
workb.biao(i, j) = Left$(newbiao.kcbiao(i, j), 10)
If Trim$(workb.biao(i, j)) = "x" Then workb.biao(i, j) = " "
Next j
Next i

If Not firstpage And biaohao = 1 Then Printer.NewPage
Select Case (biaohao Mod 4)
Case 1
xx = (Printer.ScaleWidth - 2 * ww) / 4
yy = (Printer.ScaleHeight - 2 * hh) / 3
Case 2
xx = (Printer.ScaleWidth - 2 * ww) / 4
yy = (Printer.ScaleHeight - 2 * hh) * 2 / 3 + hh
Case 3
xx = (Printer.ScaleWidth - 2 * ww) * 3 / 4 + ww
yy = (Printer.ScaleHeight - 2 * hh) / 3
Case 0
xx = (Printer.ScaleWidth - 2 * ww) * 3 / 4 + ww
yy = (Printer.ScaleHeight - 2 * hh) * 2 / 3 + hh
End Select
'MsgBox biaohao
'MsgBox Str(xx) + "+" + Str(yy)
'If upperbiao Then
'yy = (Printer.ScaleHeight - 2 * hh) / 4 '(Printer.ScaleHeight - hh)
'Else
'yy = hh + (Printer.ScaleHeight - 2 * hh) * 3 / 4 '(Printer.ScaleHeight - hh)
'End If

Call printb(xx, yy, ww, hh)
firstpage = False

'If upperbiao Then
'upperbiao = False
'Else
'upperbiao = True
'End If

End If
Next b
Printer.EndDoc
  
  
  Case Is = "bjkd2b"
 Printer.Orientation = 2
  Gsizebt = 26
  Gsize = 16
  firstpage = True
  upperbiao = True
ww = Printer.ScaleWidth * 80 / 100
hh = Printer.ScaleHeight * 45 / 100
For b = 0 To frmprint.Lstpbj.ListCount - 1
If frmprint.Lstpbj.Selected(b) = True Then
Get #12, b + 1, newbiao
workb.name = Left$(newbiao.bj, 8) + "班"
For i = 0 To Class - 1
For j = 0 To Day - 1
workb.biao(i, j) = Left$(newbiao.kcbiao(i, j), 10)
If Trim$(workb.biao(i, j)) = "x" Then workb.biao(i, j) = " "
Next j
Next i
If Not firstpage And upperbiao = True Then Printer.NewPage
xx = (Printer.ScaleWidth - ww) / 2

If upperbiao Then
yy = (Printer.ScaleHeight - 2 * hh) / 4 '(Printer.ScaleHeight - hh)
Else
yy = hh + (Printer.ScaleHeight - 2 * hh) * 3 / 4 '(Printer.ScaleHeight - hh)
End If

Call printb(xx, yy, ww, hh)
firstpage = False

If upperbiao Then
upperbiao = False
Else
upperbiao = True
End If

End If
Next b
Printer.EndDoc

End Select

Close 12#
Unload frmbjoption
End Sub

Private Sub Form_Load()
On Error Resume Next
'检查是否宽行打印机
'If Printer.PaperSize <= 8 Then
   Opt1b.Enabled = True 'False
   Opt2b.Enabled = True 'False
   Optkd4b.Enabled = True
   Optkd2b.Enabled = True
     'Select Case Trim$(Gstrbshu)
      'Case Is = "bjkd2b"
      'Optkd2b.Value = True
      'Case Is <> "bjkd2b"
      'Optkd4b.Value = True
     'End Select
'Else
'   Opt2b.Enabled = True
'   Opt1b.Enabled = True
'    'If Trim$(Gstrbshu) = "bj1b" Then
    'Opt1b.Value = True
    'Opt2b.Value = False
    'Else
    'Opt2b.Value = True
    'Opt1b.Value = False
    'End If
 '  Optkd4b.Enabled = False
 '  Optkd2b.Enabled = False
'End If

Opt2b.Value = 1
'If chkhavebjbz = True Then
'Chkbz.Value = 1
'Texbz.Enabled = True
'Texbz.Text = Gstrbjbz
'Else
Chkbz.Value = 0
'Texbz.Enabled = False

'End If

'If chkhavebjbt = True Then
Chkhavebt.Value = 1
Texbt.Enabled = True
'Texbt.Text = Trim$(Gstrbjbt)
'Else
'Chkhavebt.Value = 0
'Texbt.Enabled = False
'End If

'If chkhavebjsj Then
Chkhavesj.Value = 1
'Else
'Chkhavesj.Value = 0
'End If


Dim i As Integer
For i = 0 To Printer.FontCount - 1
Combjfont.List(i) = Printer.Fonts(i)
Next i
'If Gbjzt = "" Then
Combjfont.Text = "仿宋_GB2312"
Texztyl.FontName = "仿宋_GB2312"
Gbjzt = "仿宋_GB2312"
'Else
'Combjfont.Text = Gbjzt
'Texztyl.FontName = Gbjzt
'End If


On Error GoTo wei
If Printer.ColorMode = 2 Then
 Label3.Caption = "请选择："
  Cmdbtcolor.Enabled = True
  Cmdttcolor.Enabled = True
  cmdzwcolor.Enabled = True
  Cmdbgcolor.Enabled = True
   'If Gbjbtcolor <> Null Then
    'Texbtcolor.ForeColor = Gbjbtcolor
    'Else
     Gbtcolor = &H80000008
   'End If
   
   'If Gbjttcolor <> Null Then
   'Texttcolor.ForeColor = Gbjttcolor
   'Else
   Gttcolor = &H80000008
   'End If
   
   'If Gbjzwcolor <> Null Then
   'texzwcolor.ForeColor = Gbjzwcolor
   'Else
   Gzwcolor = &H80000008
   'End If
   Gbgcolor = &H80000008
  
Else
wei:
  Label3.Caption = "您的当前打印机不支持彩色打印模式，将使用单色打印。"
  Cmdbtcolor.Enabled = False
  Cmdttcolor.Enabled = False
  cmdzwcolor.Enabled = False
  Cmdbgcolor.Enabled = False
  Gbtcolor = &H80000008
  Gttcolor = &H80000008
  Gzwcolor = &H80000008
  Gbgcolor = &H80000008
  Texbtcolor.ForeColor = Gbtcolor
  Texttcolor.ForeColor = Gttcolor
  texzwcolor.ForeColor = Gzwcolor
  Texbg.ForeColor = Gbgcolor
End If

End Sub


Private Sub Form_Unload(Cancel As Integer)

'Gzt = bjzt
'Gbtcolor = bjbtcolor
'Gttcolor = bjttcolor
'Gzwcolor = bjzwcolor
End Sub

Private Sub Frame4_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

Private Sub Opt1b_Click()
Pic1b.Visible = True
Pic2b.Visible = False
Pic4b.Visible = False

'Opt1b.Value = True
Gstrbshu = "bj1b"
Optkd2b.Value = 0
Optkd4b.Value = 0

End Sub

Private Sub Opt2b_Click()
Pic2b.Visible = True
Pic1b.Visible = False
Pic4b.Visible = False

'Opt2b.Value = True
Gstrbshu = "bj2b"
Optkd2b.Value = 0
Optkd4b.Value = 0

End Sub



Private Sub Optkd2b_Click()
Gstrbshu = "bjkd2b"
Opt2b.Value = 0
Opt1b.Value = 0
Pic2b.Visible = True
Pic1b.Visible = False
Pic4b.Visible = False

End Sub


Private Sub Optkd4b_Click()
Gstrbshu = "bjkd4b"
Opt2b.Value = 0
Opt1b.Value = 0
Pic4b.Visible = True
Pic2b.Visible = False
Pic1b.Visible = False

End Sub


Private Sub Pic16b_Click()

End Sub


Private Sub Pic8b_Click()

End Sub

Public Sub Texbt_Click()
'Texbt.SetFocus
End Sub