📄 preview.frm
字号:
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form frmPreview
Appearance = 0 'Flat
BackColor = &H00C0C0C0&
Caption = "打印预览"
ClientHeight = 5640
ClientLeft = 1590
ClientTop = 1680
ClientWidth = 8685
Icon = "Preview.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MinButton = 0 'False
PaletteMode = 1 'UseZOrder
ScaleHeight = 5640
ScaleWidth = 8685
WindowState = 2 'Maximized
Begin VB.PictureBox picProcess
AutoRedraw = -1 'True
BorderStyle = 0 'None
BeginProperty Font
Name = "宋体"
Size = 15.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1800
Left = 1890
ScaleHeight = 1800
ScaleWidth = 4800
TabIndex = 17
TabStop = 0 'False
Top = 2055
Visible = 0 'False
Width = 4800
Begin VB.CommandButton cmdPrintCancel
Cancel = -1 'True
Caption = "取消(&C)"
Height = 315
Left = 1800
TabIndex = 18
Top = 1230
Width = 1200
End
End
Begin VB.CommandButton cmdOffset
Height = 375
Left = 1740
Picture = "Preview.frx":0442
Style = 1 'Graphical
TabIndex = 4
ToolTipText = "打印位置偏移量"
Top = 30
Width = 375
End
Begin VB.CommandButton cmdPrint
Height = 375
Index = 1
Left = 1320
Picture = "Preview.frx":0544
Style = 1 'Graphical
TabIndex = 3
ToolTipText = "打印连续页"
Top = 30
Width = 375
End
Begin VB.CommandButton cmdPage
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 1
Left = 8250
Picture = "Preview.frx":0692
Style = 1 'Graphical
TabIndex = 9
ToolTipText = "后一页"
Top = 60
Width = 315
End
Begin VB.CommandButton cmdPage
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 315
Index = 0
Left = 5610
Picture = "Preview.frx":0794
Style = 1 'Graphical
TabIndex = 7
ToolTipText = "前一页"
Top = 60
Width = 315
End
Begin VB.ComboBox cboPage
Height = 300
Left = 5940
Style = 2 'Dropdown List
TabIndex = 8
ToolTipText = "选择当前打印页"
Top = 75
Width = 2295
End
Begin VB.ComboBox cboPrintScale
Height = 300
ItemData = "Preview.frx":0896
Left = 4740
List = "Preview.frx":08AC
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 6
ToolTipText = "打印时的缩放比例(通常为100%)"
Top = 75
Width = 765
End
Begin VB.CommandButton cmdPrint
Height = 375
Index = 0
Left = 900
Picture = "Preview.frx":08D6
Style = 1 'Graphical
TabIndex = 2
ToolTipText = "打印当前页"
Top = 30
Width = 375
End
Begin VB.CommandButton cmdPrinter
Height = 375
Left = 480
Picture = "Preview.frx":09D8
Style = 1 'Graphical
TabIndex = 1
ToolTipText = "设置默认打印机及其属性"
Top = 30
Width = 375
End
Begin VB.ComboBox cboPreviewScale
Height = 300
ItemData = "Preview.frx":0ADA
Left = 3060
List = "Preview.frx":0AF0
Sorted = -1 'True
Style = 2 'Dropdown List
TabIndex = 5
ToolTipText = "相对于实际打印大小的比例"
Top = 75
Width = 765
End
Begin VB.CommandButton cmdExit
Height = 375
Left = 60
Picture = "Preview.frx":0B18
Style = 1 'Graphical
TabIndex = 0
ToolTipText = "退出打印预览"
Top = 30
Width = 375
End
Begin VB.PictureBox picBoard
Align = 2 'Align Bottom
BackColor = &H00808080&
Height = 5175
Left = 0
ScaleHeight = 5115
ScaleWidth = 8625
TabIndex = 12
TabStop = 0 'False
Top = 465
Width = 8685
Begin VB.CommandButton cmdCorner
Height = 270
Left = 8250
TabIndex = 16
ToolTipText = "显示右下方的预览范围"
Top = 4800
Width = 270
End
Begin VB.VScrollBar vsrPreview
Height = 4785
Left = 8250
Max = 1000
TabIndex = 10
Top = 0
Width = 270
End
Begin VB.HScrollBar hsrPreview
Height = 270
Left = 0
Max = 1000
TabIndex = 11
Top = 4800
Width = 8235
End
Begin VB.PictureBox picPreview
Appearance = 0 'Flat
AutoRedraw = -1 'True
BackColor = &H00FFFFFF&
BorderStyle = 0 'None
ClipControls = 0 'False
DrawStyle = 6 'Inside Solid
ForeColor = &H80000008&
Height = 1995
Left = 180
MouseIcon = "Preview.frx":0C1A
MousePointer = 99 'Custom
ScaleHeight = 1995
ScaleWidth = 1515
TabIndex = 13
TabStop = 0 'False
Top = 180
Width = 1515
End
End
Begin MSComDlg.CommonDialog cdlPrinter
Left = 600
Top = 0
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Label Label1
Caption = "打印比例:"
Height = 195
Index = 1
Left = 3930
TabIndex = 15
Top = 135
Width = 915
End
Begin VB.Label Label1
Caption = "预览比例:"
Height = 195
Index = 0
Left = 2250
TabIndex = 14
Top = 135
Width = 915
End
End
Attribute VB_Name = "frmPreview"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Const TwipsMove As Long = 15 * 10
Const BorderSpace As Long = 15 * 20
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private PaperChangedByUser As Boolean '纸张被用户重新设置
Private devPrinter As Boolean
Private devPrintTo As Object
Private PrintCancel As Boolean
Private RefreshNow As Boolean
Private CellWidth As Single 'mm
Private CellHeight As Single 'mm
Private PreviewScale As Single
Private sqrPreviewScale As Single
Private PrintScale As Single
Private sqrPrintScale As Single
Private mForeColor As Long
Private Offset1 As Single '纵向打印时左边空白宽度
Private Offset2 As Single '纵向打印时顶边空白高度
Private Offset3 As Single '纵向打印时底边空白高度
Private arrFontName() As String '字体名替换表
Private arrFontNameCount As Long
Private Sub cboPage_Click()
With cboPage
Me.Caption = gPreviewCaption & IIf(gPreviewShow, "", "(直接输出到打印机)") & " --- " & .Text
cmdPage(0).Enabled = .ListIndex > 0
cmdPage(1).Enabled = .ListIndex < .ListCount - 1
End With
RefreshPaper 0, 0
End Sub
Private Sub cboPreviewScale_Click()
PreviewScale = Val(cboPreviewScale) / 100
sqrPreviewScale = Sqr(PreviewScale)
With picPreview
RefreshPaper (picBoard.Width / 2 - .Left) / .Width, (picBoard.Height / 2 - .Top) / .Height
End With
End Sub
Private Sub cboPrintScale_Click()
Dim Msg As String
Dim I As Long
Dim L As Long
Dim T As Long
Dim Value As Long
With cboPrintScale
If .ListIndex = .ListCount - 1 Then '自定义
L = Me.Left + 15 * 108
T = Me.Top + 15 * 64
Msg = Trim(InputBox("请输入您要使用的比例值(1% - 200%)：", "自定义打印比例", 100, L, T))
If Len(Msg) > 3 Then
Value = 0
Else
Value = Val(Msg)
End If
If (Value <= 0) Or (Value > 200) Then
If Len(Msg) > 0 Then
MsgBox "您所输入的比例值不可用！", vbOKOnly, gPreviewCaption
End If
RefreshNow = False
.ListIndex = Val(.Tag)
RefreshNow = True
Else
Msg = Right(" " & Value, 3) & "%"
On Error Resume Next
.Text = Msg
If Err > 0 Then
.AddItem Msg
.Text = Msg
End If
End If
Else
PrintScale = Val(cboPrintScale) / 100
sqrPrintScale = Sqr(PrintScale)
With picPreview
RefreshPaper (picBoard.Width / 2 - .Left) / .Width * sqrPrintScale, (picBoard.Height / 2 - .Top) / .Height * sqrPrintScale
End With
End If
End With
End Sub
Private Sub cmdCorner_Click()
On Error Resume Next
RefreshNow = False
If hsrPreview + hsrPreview.LargeChange <= hsrPreview.Max Then
hsrPreview = hsrPreview + hsrPreview.LargeChange
Else
hsrPreview = hsrPreview.Max
End If
If vsrPreview + vsrPreview.LargeChange <= vsrPreview.Max Then
vsrPreview = vsrPreview + vsrPreview.LargeChange
Else
vsrPreview = vsrPreview.Max
End If
RefreshNow = True
ViewMove
End Sub
Private Sub cmdExit_Click()
Unload Me
End Sub
Private Sub cmdOffset_Click()
Dim Msg As String
Dim Offset As String
Dim L As Long
Dim T As Long
Dim Value As Single
Dim Orientation As Long
L = Me.Left + 15 * 80
T = Me.Top + 15 * 64
Msg = " 打印位置偏移量是指打印时在纸张上实际打印区域同纸张边缘的偏移量。"
Msg = Msg & vbCrLf & " 由于打印机的物理原因，各打印机的打印位置偏移量皆有所不同，"
Msg = Msg & "故而可能出现预览同实际打印结果之间的错位，为了避免这种现象的发生，"
Msg = Msg & "本打印预览程序允许您根据所使用打印机的具体情况来纠正这一偏移。"
Msg = Msg & vbCrLf & " 请输入当前默认打印机的打印位置偏移量(左,上,下)，单位：毫米，如不能确定其值，可输入“TEST”打印测试页以便测量："
Offset = Format(Offset1, "0.00") & "," & Format(Offset2, "0.00") & "," & Format(Offset3, "0.00")
Msg = Trim(InputBox(Msg, "打印位置偏移量", Offset, L, T))
If Len(Msg) = 0 Then Exit Sub
On Error Resume Next
If UCase(Msg) <> "TEST" Then
Value = 0
L = InStr(Msg, ",")
If L > 0 Then
Value = Abs(Val(Left(Msg, L - 1)))
Msg = Mid(Msg, L + 1)
End If
Offset1 = Value
Value = 0
L = InStr(Msg, ",")
If L > 0 Then
Value = Abs(Val(Left(Msg, L - 1)))
Msg = Mid(Msg, L + 1)
End If
Offset2 = Value
Value = 0
L = InStr(Msg, ",")
If L > 0 Then
Value = Abs(Val(Left(Msg, L - 1)))
Msg = Mid(Msg, L + 1)
End If
Offset3 = Value
Else
If MsgBox("您确定现在打印测试页？", 36) = 6 Then
SetMP 11
With Printer
Orientation = .Orientation
.Orientation = vbPRORPortrait
.ScaleMode = vbMillimeters
.DrawWidth = 1
Printer.Line (0, 0)-Step(20, 0)
SetBkMode .hdc, 1
.CurrentX = 2
.CurrentY = 2
.FontName = "宋体"
.FontSize = 12
.FontBold = False
.FontItalic = False
.FontStrikethru = False
.FontUnderline = False
Printer.Print "打印测试值2: 此线条到顶边的空白高度(毫米)"
Printer.Line (0, 30)-Step(0, 20)
.CurrentX = 2
.CurrentY = 40 - .TextHeight("TEST") / 2
Printer.Print "打印测试值1: 此线条到左边的空白宽度(毫米)"
Printer.Line (0, .ScaleHeight - 0.1)-Step(20, 0)
.CurrentX = 2
.CurrentY = .ScaleHeight - 2 - .TextHeight("TEST")
Printer.Print "打印测试值3: 此线条到底边的空白高度(毫米)"
.EndDoc
.Orientation = Orientation
End With
SetMP 0
End If
End If
End Sub
Private Sub cmdPage_Click(Index As Integer)
On Error Resume Next
cboPage.ListIndex = cboPage.ListIndex + IIf(Index = 0, -1, 1)
If Not cmdPage(Index).Enabled Then
cboPage.SetFocus
End If
End Sub
Public Sub cmdPrint_Click(Index As Integer)
Dim Msg As String
Dim I As Long
Dim L As Long
Dim T As Long
Dim W As Single
Dim H As Single
Dim PageFrom As Long
Dim PageTo As Long
If Index = -1 Then 'All pages
PageFrom = 1
PageTo = cboPage.ListCount
ElseIf Index = 0 Then
PageFrom = cboPage.ListIndex + 1
PageTo = PageFrom
Else
L = Me.Left + 15 * 64
T = Me.Top + 15 * 64
PageFrom = cboPage.ListIndex + 1
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -