📄 frmvisualprint.frm
字号:
VERSION 5.00
Begin VB.Form frmVisualPrint
BackColor = &H80000000&
Caption = "模拟打印 "
ClientHeight = 6360
ClientLeft = 60
ClientTop = 345
ClientWidth = 8985
Icon = "frmVisualPrint.frx":0000
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 318
ScaleMode = 2 'Point
ScaleWidth = 449.25
ShowInTaskbar = 0 'False
WindowState = 2 'Maximized
Begin VB.PictureBox picButtons
Align = 1 'Align Top
BorderStyle = 0 'None
Height = 495
Left = 0
ScaleHeight = 495
ScaleWidth = 8985
TabIndex = 1
Top = 0
Width = 8985
Begin VB.ComboBox cbScale
Height = 300
ItemData = "frmVisualPrint.frx":0742
Left = 3600
List = "frmVisualPrint.frx":0755
Style = 2 'Dropdown List
TabIndex = 9
Top = 90
Width = 930
End
Begin VB.TextBox txtPageRange
Height = 315
Left = 5520
TabIndex = 7
ToolTipText = "页号请用“,”或“-”隔开"
Top = 90
Width = 2775
End
Begin VB.CommandButton cmdPrint
Caption = "打印(&P)"
Height = 315
Left = 120
TabIndex = 6
Top = 90
Width = 975
End
Begin VB.ComboBox cbPage
Height = 300
ItemData = "frmVisualPrint.frx":0770
Left = 1680
List = "frmVisualPrint.frx":0772
Style = 2 'Dropdown List
TabIndex = 5
Top = 90
Width = 930
End
Begin VB.Label lblPage
AutoSize = -1 'True
Caption = "显示比例"
Height = 180
Index = 1
Left = 2760
TabIndex = 12
Top = 150
Width = 720
End
Begin VB.Label lblPageRange
AutoSize = -1 'True
Caption = "页码范围"
Height = 180
Left = 4680
TabIndex = 8
ToolTipText = "页号请用“,”或“-”隔开"
Top = 150
Width = 720
End
Begin VB.Label lblPage
AutoSize = -1 'True
Caption = "页号"
Height = 180
Index = 0
Left = 1200
TabIndex = 4
Top = 150
Width = 360
End
End
Begin VB.PictureBox Picture1
Height = 55
Left = 0
ScaleHeight = 0
ScaleWidth = 8955
TabIndex = 11
Top = 480
Width = 9015
End
Begin VB.PictureBox lblfigleaf
Appearance = 0 'Flat
BackColor = &H80000000&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Left = 1560
ScaleHeight = 375
ScaleWidth = 735
TabIndex = 10
Top = 960
Width = 735
End
Begin VB.HScrollBar HScroll1
Height = 255
Left = 120
Max = 10
TabIndex = 3
Top = 6120
Width = 8415
End
Begin VB.VScrollBar VScroll1
Height = 5535
Left = 8640
Max = 10
TabIndex = 2
Top = 600
Width = 255
End
Begin VB.PictureBox pic
AutoRedraw = -1 'True
AutoSize = -1 'True
BackColor = &H80000009&
BorderStyle = 0 'None
Height = 5595
Left = 0
ScaleHeight = 5595
ScaleWidth = 8475
TabIndex = 0
Top = 600
Width = 8475
End
End
Attribute VB_Name = "frmVisualPrint"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Toprint As Form
Dim PLeft As Integer, PTop As Integer
Dim m_sOldPageNo As String
Property Let SetPageCount(nPageCount As Integer)
Dim i As Integer
For i = cbPage.ListCount + 1 To nPageCount
cbPage.AddItem i
Next
If nPageCount = 1 Then
txtPageRange.Visible = False
lblPageRange.Visible = False
End If
End Property
Property Set Init(IniToprint As Form)
Set Toprint = IniToprint
End Property
'///////////////////////////////////////////////////
Private Sub cbPage_Click()
If cbPage.Text = m_sOldPageNo Then Exit Sub
pic.Cls
Set pic.Picture = Nothing
Toprint.PrintMe Me.pic, cbPage.Text
Set pic.Picture = pic.Image
m_sOldPageNo = cbPage.Text
SizeScrollBar
End Sub
Private Sub cmdPrint_Click()
Dim sRangeText As String
If Trim(txtPageRange.Text) <> "" Then
sRangeText = GetRangeText(Trim(txtPageRange.Text))
If sRangeText <> Trim(txtPageRange.Text) Then
Dim nYesNo As Integer
nYesNo = MsgBox("您选择的打印范围是：“" + sRangeText + "”吗？", vbYesNo, "提示:")
If nYesNo = vbNo Then
txtPageRange.SetFocus
Exit Sub
End If
End If
Else
sRangeText = "1-" & cbPage.ListCount
End If
txtPageRange.Text = sRangeText
Me.MousePointer = vbHourglass
cmdPrint.Enabled = False
Toprint.PrintMe Printer, sRangeText
cmdPrint.Enabled = True
Me.MousePointer = vbDefault
End Sub
Private Sub Cbscale_click()
If (Val(cbScale.Text) / 100 <> ShowRate) Then
ShowRate = Val(cbScale.Text) / 100
pic.Cls
Set pic.Picture = Nothing
Toprint.PrintMe Me.pic, cbPage.Text
Set pic.Picture = pic.Image
SizeScrollBar
End If
End Sub
Private Sub Form_Load()
SetForm Me, 9
pic.ScaleMode = vbPoints
Printer.ScaleMode = vbPoints
pic.Top = Picture1.Top + Picture1.Height
PLeft = pic.Left
PTop = pic.Top
pic.Width = Printer.ScaleWidth
pic.Height = Printer.ScaleHeight
If Me.Height < pic.Height + 3 Then
Me.Height = pic.Height + 3
End If
m_sOldPageNo = ""
cbPage.AddItem "1"
cbPage.ListIndex = 0
Dim i As Integer
cbScale.Clear
For i = 50 To 200 Step 25
cbScale.AddItem Format(i)
Next
cbScale.ListIndex = 2
End Sub
Private Sub Form_Resize()
On Error Resume Next
VScroll1.Top = Me.ScaleTop + picButtons.Height
VScroll1.Height = Me.ScaleHeight - VScroll1.Top - HScroll1.Height
VScroll1.Left = Me.ScaleWidth - VScroll1.Width
HScroll1.Left = Me.ScaleLeft
HScroll1.Width = Me.ScaleWidth - VScroll1.Width
HScroll1.Top = Me.ScaleHeight - HScroll1.Height
SizeScrollBar
lblfigleaf.Top = VScroll1.Height + VScroll1.Top
lblfigleaf.Left = HScroll1.Width + HScroll1.Left
lblfigleaf.Width = HScroll1.Height
lblfigleaf.Height = VScroll1.Width
Picture1.Width = HScroll1.Width
End Sub
Private Sub HScroll1_Change()
If pic.Width > HScroll1.Width Then
pic.Left = PLeft - (HScroll1.Value / HScroll1.Max) * (pic.Width - HScroll1.Width + VScroll1.Width)
Else
pic.Left = PLeft
End If
End Sub
Private Sub VScroll1_Change()
If pic.Height > VScroll1.Height Then
pic.Top = PTop - (VScroll1.Value / VScroll1.Max) * (pic.Height - VScroll1.Height + HScroll1.Height)
Else
pic.Top = PTop
End If
End Sub
Private Function GetRangeText(sText As String) As String
sText = Trim(sText)
If sText = "" Then
GetRangeText = ""
Exit Function
End If
Dim nPos As Integer, nCommaPos As Integer, nWordLen As Integer
Dim sTemp As String, sChar As String, i As Integer, j As Integer
nWordLen = Len("字")
Do ' 全角逗号替换为半角逗号
nPos = InStr(1, sText, "，")
If nPos > 0 Then
sText = Trim(Left(sText, nPos - 1)) + "," + Trim(Mid(sText, nPos + nWordLen))
End If
Loop While nPos > 0
sTemp = ""
For i = 1 To Len(sText) '剔除非数字字符
sChar = Mid(sText, i, 1)
If sChar = "," Or sChar = "-" Or Asc(sChar) >= 48 And Asc(sChar) <= 57 Then ' 0 - 9
sTemp = sTemp + sChar
End If
Next
sText = sTemp
sTemp = ""
nPos = -1
nCommaPos = -1
For i = 1 To Len(sText) '剔除多余的","、"-"
sChar = Mid(sText, i, 1)
If sChar = "," Then '保证","不与前一个","、"-"紧相连
If Not (i = nCommaPos + 1 Or i = nPos + 1) Then
sTemp = sTemp + sChar
End If
nCommaPos = i
ElseIf sChar = "-" Then '保证"-"不与前一个","、"-"紧相连
If Not (i = nCommaPos + 1 Or i = nPos + 1) Then
If nPos > nCommaPos Then '最前一个分格符是"-", 强行把当前"-"改为","
sChar = ","
End If
sTemp = sTemp + sChar
End If
nPos = i
Else
sTemp = sTemp + sChar
End If
Next
If Right(sTemp, 1) = "-" Or Right(sTemp, 1) = "," Then
sTemp = Left(sTemp, Len(sTemp) - 1)
End If
If Left(sTemp, 1) = "-" Or Left(sTemp, 1) = "," Then
sTemp = Right(sTemp, Len(sTemp) - 1)
End If
GetRangeText = sTemp
End Function
Public Sub SizeScrollBar()
If pic.Width > HScroll1.Width Then
HScroll1.Enabled = True
HScroll1.Min = 0
HScroll1.Max = pic.Width - HScroll1.Width
HScroll1.SmallChange = 20
'HScroll1.LargeChange = HScroll1.Max / 10
HScroll1.LargeChange = (HScroll1.Width * HScroll1.Max) / pic.Width
Else
HScroll1.Min = 0
HScroll1.Max = 0
HScroll1.Enabled = False
End If
If pic.Height > VScroll1.Height Then
VScroll1.Enabled = True
VScroll1.Min = 0
VScroll1.Max = pic.Height - VScroll1.Height
VScroll1.SmallChange = 20
'PrnPrv.vBar.LargeChange = PrnPrv.vBar.Max / 10
VScroll1.LargeChange = (VScroll1.Height * VScroll1.Max) / pic.Height
Else
VScroll1.Min = 0
VScroll1.Max = 0
VScroll1.Enabled = False
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -