📄 打印预览.frm
字号:
VERSION 5.00
Object = "{A8561640-E93C-11D3-AC3B-CE6078F7B616}#1.0#0"; "VSPRINT7.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmdyyl
Caption = "打印预览"
ClientHeight = 6390
ClientLeft = 60
ClientTop = 345
ClientWidth = 9270
Icon = "打印预览.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
ScaleHeight = 6390
ScaleWidth = 9270
StartUpPosition = 2 '屏幕中心
WindowState = 2 'Maximized
Begin VB.CommandButton Command1
Caption = "设置"
Height = 375
Left = 120
TabIndex = 1
Top = 60
Width = 1095
End
Begin VSPrinter7LibCtl.VSPrinter vp
Height = 5895
Left = 0
TabIndex = 0
Top = 480
Width = 9255
_cx = 16325
_cy = 10398
Appearance = 1
BorderStyle = 1
Enabled = -1 'True
MousePointer = 0
BackColor = -2147483643
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty HdrFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Courier New"
Size = 14.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
_ConvInfo = 1
AutoRTF = -1 'True
Preview = -1 'True
DefaultDevice = -1 'True
PhysicalPage = -1 'True
AbortWindow = -1 'True
AbortWindowPos = 0
AbortCaption = "Printing..."
AbortTextButton = "Cancel"
AbortTextDevice = "on the %s on %s"
AbortTextPage = "Now printing Page %d of"
FileName = ""
MarginLeft = 1440
MarginTop = 1440
MarginRight = 1440
MarginBottom = 1440
MarginHeader = 0
MarginFooter = 0
IndentLeft = 0
IndentRight = 0
IndentFirst = 0
IndentTab = 720
SpaceBefore = 0
SpaceAfter = 0
LineSpacing = 100
Columns = 1
ColumnSpacing = 180
ShowGuides = 2
LargeChangeHorz = 300
LargeChangeVert = 300
SmallChangeHorz = 30
SmallChangeVert = 30
Track = 0 'False
ProportionalBars= -1 'True
Zoom = 33.8068181818182
ZoomMode = 3
ZoomMax = 400
ZoomMin = 10
ZoomStep = 25
EmptyColor = 14737632
TextColor = 0
HdrColor = 0
BrushColor = 0
BrushStyle = 0
PenColor = 0
PenStyle = 5
PenWidth = 0
PageBorder = 7
Header = ""
Footer = ""
TableSep = "|;"
TableBorder = 7
TablePen = 0
TablePenLR = 0
TablePenTB = 0
NavBar = 0
NavBarColor = -2147483633
ExportFormat = 0
URL = ""
Navigation = 3
NavBarMenuText = "Whole &Page|Page &Width|&Two Pages|Thumb&nail"
Begin MSComDlg.CommonDialog CommonDialogsp
Left = 5160
Top = 480
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
End
Begin VB.Menu menu
Caption = "菜单"
Visible = 0 'False
Begin VB.Menu menudyqd
Caption = "打印全部"
End
Begin VB.Menu sy1
Caption = "-"
End
Begin VB.Menu menuxsff
Caption = "显示方法"
Begin VB.Menu menuzyxs
Caption = "整页显示"
End
Begin VB.Menu menuykxs
Caption = "页宽显示"
End
Begin VB.Menu menusyxs
Caption = "双页显示"
End
Begin VB.Menu menuzxxs
Caption = "最小显示"
End
Begin VB.Menu menulsxs
Caption = "拉伸显示"
End
End
Begin VB.Menu menuxsbl
Caption = "显示比例"
Begin VB.Menu menubl150
Caption = "比例 150%"
End
Begin VB.Menu menubl100
Caption = "比例 100%"
End
Begin VB.Menu menubl75
Caption = "比例 75%"
End
Begin VB.Menu menubl50
Caption = "比例 50%"
End
Begin VB.Menu menubl25
Caption = "比例 25%"
End
End
Begin VB.Menu sy4
Caption = "-"
End
Begin VB.Menu menudhtml
Caption = "导出为html"
End
Begin VB.Menu menudrtf
Caption = "导出为rtf"
End
Begin VB.Menu menudtxt
Caption = "导出为txt"
End
Begin VB.Menu sy3
Caption = "-"
End
Begin VB.Menu menudyjsz
Caption = "打印机设置"
End
Begin VB.Menu sy2
Caption = "-"
End
Begin VB.Menu menugb
Caption = "关闭预览"
End
End
End
Attribute VB_Name = "frmdyyl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Command1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'点击
On Error GoTo handlerror:
If Button = 1 Then
PopupMenu menu
End If
Exit Sub
handlerror:
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
'Esc键退出，VbEscape可以用27代替
On Error GoTo handlerror
If KeyAscii = 27 Then
Unload Me
End If
Exit Sub
handlerror:
End Sub
Private Sub Form_Load()
'启动
On Error GoTo handlerror
Call subxsnr '显示文件内容
Exit Sub
handlerror:
End Sub
Private Sub Form_Resize()
'窗体尺寸
On Error GoTo handlerror
If frmdyyl.Width - 200 > 0 Then vp.Width = frmdyyl.Width - 200
If frmdyyl.Height - 100 > 0 Then vp.Height = frmdyyl.Height - 100
Exit Sub
handlerror:
End Sub
Private Sub menubl100_Click()
'显示比例100
On Error GoTo handlerror
vp.Zoom = 100
Exit Sub
handlerror:
End Sub
Private Sub menubl150_Click()
'显示比例150
On Error GoTo handlerror
vp.Zoom = 150
Exit Sub
handlerror:
End Sub
Private Sub menubl25_Click()
'显示比例25
On Error GoTo handlerror
vp.Zoom = 25
Exit Sub
handlerror:
End Sub
Private Sub menubl50_Click()
'显示比例50
On Error GoTo handlerror
vp.Zoom = 50
Exit Sub
handlerror:
End Sub
Private Sub menubl75_Click()
'显示比例75
On Error GoTo handlerror
vp.Zoom = 75
Exit Sub
handlerror:
End Sub
Private Sub menudhtml_Click()
'导出为html
On Error GoTo handlerror
xiansh = MsgBox("导出的文件同本程序路径，文件名为temp.html。", vbInformation, "问题提示")
vp.ExportFile = App.Path & "\temp.htm"
vp.ExportFormat = vpxDHTML
Call subxsnr
' show file in browser
ShellExecute hwnd, "open", vp.ExportFile, 0, 0, 0
' clear HTML output file
vp.ExportFile = ""
Exit Sub
handlerror:
End Sub
Private Sub menudrtf_Click()
'导出到rtf
On Error GoTo handlerror
xiansh = MsgBox("导出的文件同本程序路径，文件名为temp.rtf。", vbInformation, "问题提示")
vp.ExportFile = App.Path & "\temp.rtf"
vp.ExportFormat = vpxRTF
Call subxsnr
' clear rtf output file
vp.ExportFile = ""
Exit Sub
handlerror:
End Sub
Private Sub menudtxt_Click()
'导出到txt
On Error GoTo handlerror
xiansh = MsgBox("导出的文件同本程序路径，文件名为temp.txt。", vbInformation, "问题提示")
wjm = App.Path & "\temp.txt"
Open wjm For Output As #1
Print #1, frmMain.Text1.Text
Close #1
Exit Sub
handlerror:
If Err.Number = 55 Then Close #1
End Sub
Private Sub menudyjsz_Click()
'打印机设置
CommonDialogsp.CancelError = True
On Error GoTo handlerror
CommonDialogsp.Flags = &H40
CommonDialogsp.ShowPrinter
Exit Sub
handlerror:
End Sub
Private Sub menudyqd_Click()
'打印
On Error GoTo handlerror
frmdyyl.vp.PrintDoc (False)
Exit Sub
handlerror:
End Sub
Private Sub menugb_Click()
'关闭
Unload Me
End Sub
Private Sub menulsxs_Click()
'拉伸显示
On Error GoTo handlerror
vp.ZoomMode = zmStretch
Exit Sub
handlerror:
End Sub
Private Sub menusyxs_Click()
'双页显示
On Error GoTo handlerror
vp.ZoomMode = zmTwoPages
Exit Sub
handlerror:
End Sub
Private Sub menuykxs_Click()
'页宽显示
On Error GoTo handlerror
vp.ZoomMode = zmPageWidth
Exit Sub
handlerror:
End Sub
Private Sub menuzxxs_Click()
'最小显示
On Error GoTo handlerror
vp.ZoomMode = zmThumbnail
Exit Sub
handlerror:
End Sub
Private Sub menuzyxs_Click()
'整页显示
On Error GoTo handlerror
vp.ZoomMode = zmWholePage
Exit Sub
handlerror:
End Sub
Private Sub vp_AfterFooter()
'页脚
On Error GoTo handlerror
vp.HdrFontBold = False
vp.HdrFontSize = "8"
vp.HdrFontName = "宋体"
Exit Sub
handlerror:
End Sub
Private Sub vp_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
'右键菜单
On Error GoTo handlerror
If Button = 2 Then
PopupMenu menu
End If
Exit Sub
handlerror:
End Sub
Public Sub subxsnr()
'显示文件内容
On Error GoTo handlerror
If yemsz1 = 1 Then vp.Orientation = orPortrait
If yemsz1 = 2 Then vp.Orientation = orLandscape
If yemsz2 = 1 Then vp.PaperSize = pprA4
If yemsz2 = 2 Then vp.PaperSize = pprA3
vp.MarginLeft = yemsz
vp.MarginRight = yemsy
vp.MarginTop = yemss
vp.MarginBottom = yemsx
vp.MarginHeader = 567
vp.MarginTop = 1247
' vp.MarginFooter = 624
' vp.MarginBottom = 624
If bgxsyj = 1 Then vp.Footer = "|-" + "%d"
With vp
.StartDoc
.FontName = bgztsz
.FontBold = True
.FontSize = 18
.TextAlign = taCenterMiddle
.Text = btmch & vbCrLf & ""
.FontName = bgztsz
.FontSize = bgzhsz
.FontBold = False
.TextAlign = taLeftBottom
.Text = frmMain.Text1
.EndDoc
End With
Exit Sub
handlerror:
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -