frmprint.frm

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

         Top             =   1335
         Width           =   1575
      End
      Begin VB.Label Label4 
         Caption         =   "单位名称字号(磅)"
         Height          =   255
         Left            =   120
         TabIndex        =   34
         Top             =   255
         Width           =   1575
      End
      Begin VB.Label Label5 
         Caption         =   "左边界（毫米）"
         Height          =   255
         Left            =   3240
         TabIndex        =   33
         Top             =   255
         Width           =   1335
      End
      Begin VB.Label Label6 
         Caption         =   "上边界(毫米)"
         Height          =   255
         Left            =   3240
         TabIndex        =   32
         Top             =   975
         Width           =   1335
      End
      Begin VB.Label Label7 
         Caption         =   "右边界（毫米）"
         Height          =   255
         Left            =   3240
         TabIndex        =   31
         Top             =   615
         Width           =   1335
      End
      Begin VB.Label Label8 
         Caption         =   "下边界(毫米)"
         Height          =   255
         Left            =   3240
         TabIndex        =   30
         Top             =   1335
         Width           =   1335
      End
      Begin VB.Label Label11 
         Caption         =   "横向分栏"
         Height          =   255
         Left            =   120
         TabIndex        =   29
         Top             =   1695
         Width           =   1575
      End
   End
   Begin VB.CommandButton CmdPrintView 
      Caption         =   "打印预览"
      Height          =   372
      Left            =   1560
      TabIndex        =   16
      Top             =   4440
      Width           =   1212
   End
   Begin VB.CommandButton CmdPrint 
      Caption         =   "打印"
      Height          =   372
      Left            =   3000
      TabIndex        =   17
      Top             =   4440
      Width           =   1212
   End
   Begin VB.CommandButton cmdPassOne 
      Caption         =   ">"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2760
      TabIndex        =   11
      Top             =   2760
      Width           =   375
   End
   Begin VB.CommandButton cmdRetuAll 
      Caption         =   "<<"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2760
      TabIndex        =   12
      Top             =   3240
      Width           =   375
   End
   Begin VB.CommandButton cmdRetuOne 
      Caption         =   "<"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2760
      TabIndex        =   13
      Top             =   3720
      Width           =   375
   End
   Begin VB.CommandButton cmdPassAll 
      Caption         =   ">>"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   9
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   2760
      TabIndex        =   10
      Top             =   2280
      Width           =   375
   End
   Begin VB.CommandButton CmdSetup 
      Caption         =   "打印机设置"
      Height          =   372
      Left            =   120
      TabIndex        =   15
      Top             =   4440
      Width           =   1212
   End
   Begin VB.CommandButton CmdProcess 
      Caption         =   "保存"
      Height          =   372
      Left            =   4440
      TabIndex        =   18
      Top             =   4440
      Width           =   1212
   End
End
Attribute VB_Name = "frmPrint"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Dim m_sIniSection As String
Dim PrintColumns As Object, Toprint As Form

Property Let Initial(iniSection As String, GrdCols As Object, f As Form)
    m_sIniSection = iniSection
    Set PrintColumns = GrdCols
    Set Toprint = f
End Property

Private Sub CmdPassAll_Click()
    Do Until LstNotPrint.ListCount = 0
        LstPrint.AddItem LstNotPrint.List(0)
        LstPrint.ItemData(LstPrint.ListCount - 1) = LstNotPrint.ItemData(0)
        LstNotPrint.RemoveItem 0
    Loop
End Sub

Private Sub cmdPassOne_Click()
    If LstNotPrint.ListIndex = -1 Then Exit Sub
    
    LstPrint.AddItem LstNotPrint.List(LstNotPrint.ListIndex)
    LstPrint.ItemData(LstPrint.ListCount - 1) = LstNotPrint.ItemData(LstNotPrint.ListIndex)
    LstNotPrint.RemoveItem LstNotPrint.ListIndex
End Sub

Private Sub cmdretuOne_Click()
    If LstPrint.ListIndex = -1 Then Exit Sub
    
    LstNotPrint.AddItem LstPrint.List(LstPrint.ListIndex)
    LstNotPrint.ItemData(LstNotPrint.ListCount - 1) = LstPrint.ItemData(LstPrint.ListIndex)
    LstPrint.RemoveItem LstPrint.ListIndex
End Sub

Private Sub cmdRetuAll_Click()
    Do Until LstPrint.ListCount = 0
        LstNotPrint.AddItem LstPrint.List(0)
        LstNotPrint.ItemData(LstNotPrint.ListCount - 1) = LstPrint.ItemData(0)
        LstPrint.RemoveItem 0
    Loop
End Sub

Private Sub CmdSetup_Click()
    CmnDlg.Flags = cdlPDPrintSetup + cdlPDUseDevModeCopies
    CmnDlg.ShowPrinter
End Sub

Private Sub cmdPrint_Click()
    CmdProcess_Click
    Toprint.PrintMe Printer
End Sub

Private Sub CmdPrintView_Click()
    CmdProcess_Click
    
    Dim i As Integer
    For i = 0 To Forms.Count - 1
        If Forms(i) Is frmVisualPrint Then
            Unload Forms(i)
        End If
    Next
    
    Set frmVisualPrint.Init = Toprint
    frmVisualPrint.Show
    frmVisualPrint.SetFocus
End Sub

Private Sub CmdProcess_Click()
    SavePrivateSetting m_sIniSection, "UnitSize", TxtUnitSize.Text
    SavePrivateSetting m_sIniSection, "TextSize", TxtTextSize.Text
    SavePrivateSetting m_sIniSection, "CaptionSize", TxtCaptionSize.Text
    SavePrivateSetting m_sIniSection, "RowHeight", TxtRowHeight.Text
    SavePrivateSetting m_sIniSection, "PrintLeft", TxtLeft.Text
    SavePrivateSetting m_sIniSection, "PrintTop", TxtTop.Text
    SavePrivateSetting m_sIniSection, "PrintRight", TxtRight.Text
    SavePrivateSetting m_sIniSection, "PrintBottom", TxtBottom.Text
    SavePrivateSetting m_sIniSection, "PrintXdiv", TxtXdiv.Text
    SavePrivateSetting m_sIniSection, "PrintColList", PutColList()
    Unload Me
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{Tab}"
    End If
End Sub

Private Sub Form_Load()
    Dim NotSelected As Boolean
    Dim PrintColList As String

    SetForm Me, 9
    TxtUnitSize.Text = GetPrivateSetting(m_sIniSection, "UnitSize", 11)
    TxtTextSize.Text = GetPrivateSetting(m_sIniSection, "TextSize", 11)
    TxtCaptionSize.Text = GetPrivateSetting(m_sIniSection, "CaptionSize", 20)
    TxtRowHeight.Text = GetPrivateSetting(m_sIniSection, "RowHeight", 6)
    TxtLeft.Text = GetPrivateSetting(m_sIniSection, "PrintLeft", 0)
    TxtTop.Text = GetPrivateSetting(m_sIniSection, "PrintTop", 0)
    TxtRight.Text = GetPrivateSetting(m_sIniSection, "PrintRight", 0)
    TxtBottom.Text = GetPrivateSetting(m_sIniSection, "PrintBottom", 0)
    TxtXdiv.Text = GetPrivateSetting(m_sIniSection, "PrintXdiv", 1)
    PrintColList = GetPrivateSetting(m_sIniSection, "PrintColList", "")
    
    NotSelected = IIf(PrintColList = "", True, False)
    Dim CurCol As Integer
    For CurCol = 0 To PrintColumns.Count - 1
        If PrintColumns(CurCol).Visible And PrintColumns(CurCol).Width >= 61 Then
            If InPrintColList(PrintColList, CurCol) Or NotSelected Then
                LstPrint.AddItem PrintColumns(CurCol).Caption
                LstPrint.ItemData(LstPrint.ListCount - 1) = CurCol
            Else
                LstNotPrint.AddItem PrintColumns(CurCol).Caption
                LstNotPrint.ItemData(LstNotPrint.ListCount - 1) = CurCol
            End If
        End If
    Next
End Sub

Private Function PutColList() As String
    PutColList = ""
    Dim MyLoop As Integer
    Do Until MyLoop >= LstPrint.ListCount
        PutString PutColList, LstPrint.ItemData(MyLoop)
        MyLoop = MyLoop + 1
    Loop
End Function

Private Sub LstNotPrint_DblClick()
    cmdPassOne_Click
End Sub

Private Sub LstPrint_DblClick()
    cmdretuOne_Click
End Sub

Private Sub TxtBottom_Validate(Cancel As Boolean)
    If Not IsNumeric(TxtBottom.Text) Then
        Cancel = True
    End If
End Sub

Private Sub TxtCaptionSize_Validate(Cancel As Boolean)
    If Not IsNumeric(TxtCaptionSize.Text) Then
        Cancel = True
    End If
End Sub

Private Sub TxtLeft_Validate(Cancel As Boolean)
    If Not IsNumeric(TxtLeft.Text) Then
        Cancel = True
    End If
End Sub

Private Sub TxtRight_Validate(Cancel As Boolean)
    If Not IsNumeric(TxtRight.Text) Then
        Cancel = True
    End If
End Sub

Private Sub TxtRowHeight_Validate(Cancel As Boolean)
    If Not IsNumeric(TxtRowHeight.Text) Then
        Cancel = True
    End If
End Sub

Private Sub TxtTextSize_Validate(Cancel As Boolean)
    If Not IsNumeric(TxtTextSize.Text) Then
        Cancel = True
    End If
End Sub

Private Sub TxtTop_Validate(Cancel As Boolean)
    If Not IsNumeric(TxtTop.Text) Then
        Cancel = True
    End If
End Sub

Private Sub TxtUnitSize_Validate(Cancel As Boolean)
    If Not IsNumeric(TxtUnitSize.Text) Then
        Cancel = True
    End If
End Sub

Private Sub TxtXdiv_Validate(Cancel As Boolean)
    If Not IsNumeric(TxtXdiv.Text) Then
        Cancel = True
    End If
End Sub