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