frmvisualprint.frm

一个为公安系统接警中心控制软件,不错哦.

VERSION 5.00
Begin VB.Form frmVisualPrint 
   BackColor       =   &H80000006&
   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.HScrollBar HScroll1 
      Height          =   255
      LargeChange     =   1000
      Left            =   120
      SmallChange     =   100
      TabIndex        =   3
      Top             =   6000
      Width           =   8415
   End
   Begin VB.VScrollBar VScroll1 
      Height          =   6015
      LargeChange     =   1000
      Left            =   8640
      SmallChange     =   100
      TabIndex        =   2
      Top             =   360
      Width           =   255
   End
   Begin VB.PictureBox picButtons 
      Align           =   1  'Align Top
      BorderStyle     =   0  'None
      Height          =   435
      Left            =   0
      ScaleHeight     =   435
      ScaleWidth      =   8985
      TabIndex        =   1
      Top             =   0
      Width           =   8985
      Begin VB.TextBox txtPageRange 
         Height          =   315
         Left            =   4920
         TabIndex        =   7
         ToolTipText     =   "页号请用“,”或“-”隔开"
         Top             =   40
         Width           =   2775
      End
      Begin VB.CommandButton cmdPrint 
         Caption         =   "打印(&P)"
         Height          =   315
         Left            =   2880
         TabIndex        =   6
         Top             =   40
         Width           =   975
      End
      Begin VB.ComboBox cbPage 
         Height          =   300
         ItemData        =   "frmVisualPrint.frx":0742
         Left            =   600
         List            =   "frmVisualPrint.frx":0744
         Style           =   2  'Dropdown List
         TabIndex        =   5
         Top             =   40
         Width           =   930
      End
      Begin VB.Label lblPageRange 
         Caption         =   "页码范围"
         Height          =   255
         Left            =   4080
         TabIndex        =   8
         ToolTipText     =   "页号请用“,”或“-”隔开"
         Top             =   105
         Width           =   855
      End
      Begin VB.Label lblPage 
         Caption         =   "页号"
         Height          =   255
         Left            =   120
         TabIndex        =   4
         Top             =   105
         Width           =   405
      End
   End
   Begin VB.PictureBox pic 
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H80000009&
      Height          =   5475
      Left            =   120
      ScaleHeight     =   5415
      ScaleWidth      =   8415
      TabIndex        =   0
      Top             =   480
      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
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 Form_Load()
    SetForm Me, 9
    
    pic.ScaleMode = vbPoints
    Printer.ScaleMode = vbPoints
    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
End Sub

Private Sub Form_Resize()
    On Error Resume Next
    VScroll1.Top = Me.ScaleTop
    VScroll1.Height = Me.ScaleHeight - HScroll1.Height
    VScroll1.Left = Me.ScaleWidth - VScroll1.Width
    HScroll1.Left = Me.ScaleLeft
    HScroll1.Width = Me.ScaleWidth - VScroll1.Width
    HScroll1.Top = Me.ScaleHeight - HScroll1.Height
End Sub

Private Sub HScroll1_Change()
    pic.Left = PLeft - (HScroll1.Value / HScroll1.Max) * pic.Width
End Sub

Private Sub VScroll1_Change()
    pic.Top = PTop - (VScroll1.Value / VScroll1.Max) * pic.Height
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