frmprint.frm

此为vb6做的报表打印控件源码

        ccboPaper.Enabled = False
    Else
        ctxtPaperWidth.Enabled = False
        ctxtPaperHeight.Enabled = False
        ctxtPaperWidth.BackColor = vb3DFace
        ctxtPaperHeight.BackColor = vb3DFace
        Option1.Enabled = False
        Option2.Enabled = False
        ccboPaper.Enabled = True
    End If
End Sub

Private Sub ccmdCancel_Click()
    Unload Me
End Sub

Private Sub ccmdOK_Click()
    Dim lintTee As Integer '毫米、英寸的换算单位
    Dim lintMinH As Integer
    Dim lintMinW As Integer
    If Option1.Value = True Then
        lintTee = 1440
        lintMinH = 4320
        lintMinW = 4320
    Else
        lintTee = 56.7
        lintMinH = 4320
        lintMinW = 4320
    End If
    'mctlPrinter.ScaleOutput
    mctlPrinter.Device = ccboPrinter
   
        If cchkUserPaper.Value = 1 Then
         If IsNumeric(ctxtPaperWidth) = True And IsNumeric(ctxtPaperHeight) = True Then
            mctlPrinter.PaperSize = 256
            mctlPrinter.PaperWidth = Val(ctxtPaperWidth) * lintTee
            
            mctlPrinter.PaperHeight = Val(ctxtPaperHeight) * lintTee
            If mctlPrinter.PaperHeight < lintMinH Then mctlPrinter.PaperHeight = lintMinH
            If mctlPrinter.PaperWidth < lintMinW Then mctlPrinter.PaperWidth = lintMinW
         End If
        Else
            If ccboPaper.ListCount > 0 Then
            mctlPrinter.PaperSize = ccboPaper.ItemData(ccboPaper.ListIndex)
            End If
        End If
    '设置打印方向
        If copt横向.Value = True Then
            mctlPrinter.Orientation = orLandscape
        Else
            mctlPrinter.Orientation = orPortrait
        End If
    '设置打印页边距
      
      If funcSetMargin = True Then Unload Me
    
End Sub

Private Sub ctxtMargin_GotFocus(Index As Integer)
    SendKeys "{HOME}+{end}"
End Sub

Private Sub ctxtPaperHeight_LostFocus()
    If IsNumeric(ctxtPaperHeight) = False Then
            MsgBox "不是正确的数值", vbExclamation, "错误"
            ctxtPaperHeight.SetFocus
            SendKeys "{Home}+{End}"
    End If
End Sub

Private Sub ctxtPaperWidth_LostFocus()
    If IsNumeric(ctxtPaperWidth) = False Then
        MsgBox "不是正确的数值", vbExclamation, "错误"
        ctxtPaperWidth.SetFocus
        SendKeys "{Home}+{End}"
    End If
End Sub

Private Sub Form_Load()
d(1) = "信笺， 8 1/2 x 11 英寸 "
d(2) = "+A611 小型信笺， 8 1/2 x 11 英寸"
d(3) = "小型报， 11 x 17 英寸"
d(4) = "分类帐， 17 x 11 英寸"
d(5) = "法律文件， 8 1/2 x 14 英寸"
d(6) = "声明书，5 1/2 x 8 1/2 英寸"
d(7) = "行政文件，7 1/2 x 10 1/2 英寸"
d(8) = "A3, 297 x 420 毫米 "
d(9) = "A4, 210 x 297 毫米 "
d(10) = "A4小号， 210 x 297 毫米"
d(11) = "A5, 148 x 210 毫米 "
d(12) = "B4, 250 x 354 毫米 "
d(13) = "B5, 182 x 257 毫米 "
d(14) = "对开本， 8 1/2 x 13 英寸"
d(15) = "四开本， 215 x 275 毫米"
d(16) = "10 x 14 英寸"
d(17) = "11 x 17 英寸 "
d(18) = "便条，8 1/2 x 11 英寸"
d(19) = "#9 信封， 3 7/8 x 8 7/8 英寸"
d(20) = "#10 信封， 4 1/8 x 9 1/2 英寸"
d(21) = "#11 信封， 4 1/2 x 10 3/8 英寸 "
d(22) = "#12 信封， 4 1/2 x 11 英寸"
d(23) = "#14 信封， 5 x 11 1/2 英寸"
d(24) = "C 尺寸工作单"
d(25) = "D 尺寸工作单"
d(26) = "E 尺寸工作单"
d(27) = "DL 型信封， 110 x 220 毫米"
d(28) = "C3 型信封， 324 x 458 毫米"
d(29) = "C4 型信封， 229 x 324 毫米"
d(30) = "C5 型信封， 162 x 229 毫米"
d(31) = "C6 型信封， 114 x 162 毫米"
d(32) = "C65 型信封，114 x 229 毫米"
d(33) = "B4 型信封， 250 x 353 毫米"
d(34) = "B5 型信封，176 x 250 毫米"
d(35) = "B6 型信封， 176 x 125 毫米"
d(36) = "信封， 110 x 230 毫米"
d(37) = "信封大王， 3 7/8 x 7 1/2 英寸"
d(38) = "信封， 3 5/8 x 6 1/2 英寸"
d(39) = "U.S. 标准复写簿， 14 7/8 x 11 英寸 "
d(40) = "德国标准复写簿， 8 1/2 x 12 英寸"
d(41) = "德国法律复写簿， 8 1/2 x 13 英寸 "


    If mctlPrinter Is Nothing Then
        Exit Sub
    End If
    
    With mctlPrinter
    .PreView = True
'    .PreView = True
'    .Visible = False
'    .Visible = True
    '加入打印机名称
        '如没有可使用的打印机
    If mctlPrinter.NDevices = 0 Then
        MsgBox "没有可以使用的打印机，请检查打印安装", vbExclamation, "提示"
        
        ccboPrinter.Enabled = False
        ccboPaper.Enabled = False
        cchkUserPaper.Enabled = False
        ctxtPaperHeight.Enabled = False
        ctxtPaperWidth.Enabled = False
        ccmdOK.Enabled = False
        ccmdCancel.Enabled = True
        Exit Sub
    End If
    '列出可用的打印机
    j = 0
    For i = 1 To mctlPrinter.NDevices
       ccboPrinter.AddItem .Devices(i - 1)
       If .Device <> "" And .Device = ccboPrinter.List(i - 1) Then
        j = i - 1
        End If
    Next
    ccboPrinter.ListIndex = j
    
    
'    .Device = ccboPrinter.Text
    .StartDoc
    .EndDoc
    
    '加入可用纸张名
    subShowPaper
    If .PaperSize <> 0 Or .PaperSize < 255 Then
        For i = 0 To ccboPaper.ListCount - 1
            If ccboPaper.ItemData(i) = .PaperSize Then
                ccboPaper.ListIndex = i
            End If
        Next
    End If
    subShowPageMargin
    End With
    
End Sub
Private Sub subShowPaper()
mbolEventLock = True
    ccboPaper.Clear
    
    With mctlPrinter
    j = 0
    ccboPaper.Clear
    For i = 1 To 41
        
        If .PaperSizes(i) = True Then
            j = j + 1
            ccboPaper.AddItem d(i)
            ccboPaper.ItemData(j - 1) = i
        End If
    Next
    
    If ccboPaper.ListCount > 0 Then
        ccboPaper.ListIndex = 0
        '.PaperSize = ccboPaper.ItemData(0)
    End If

    End With
mbolEventLock = False
End Sub
Private Sub subShowPageMargin()
    ctxtMargin(0) = Format(mctlPrinter.MarginLeft / 567, "####.##")
    ctxtMargin(1) = Format(mctlPrinter.MarginRight / 567, "####.##")
    ctxtMargin(2) = Format(mctlPrinter.MarginTop / 567, "####.##")
    ctxtMargin(3) = Format(mctlPrinter.MarginBottom / 567, "####.##")
End Sub
Private Function funcSetMargin() As Boolean

Dim i As Integer
    funcSetMargin = False
    For i = 0 To 3
        With mctlPrinter
        .PhysicalPage = True
        If IsNumeric(ctxtMargin(i)) = True Then
          If Val(ctxtMargin(i)) >= 0 Then
          Select Case i
            Case 0
                If Val(ctxtMargin(i)) * 567 > .PageWidth Then
                    MsgBox "页边距设置不正确，请重新输入", vbExclamation, "打印"
                    ctxtMargin(0).SetFocus
                    ctxtMargin(0).Text = 0
                    Exit Function
                Else
                    mctlPrinter.MarginLeft = Val(ctxtMargin(i)) * 567
                End If
            Case 1
                    If Val(ctxtMargin(i)) * 567 > .PageWidth Then
                    MsgBox "页边距设置不正确，请重新输入", vbExclamation, "打印"
                    ctxtMargin(1).SetFocus
                    ctxtMargin(1).Text = 0
                    Exit Function
                Else
                    mctlPrinter.MarginRight = Val(ctxtMargin(i)) * 567
                End If
            Case 2
                    If Val(ctxtMargin(i)) * 567 > .PageHeight Then
                    MsgBox "页边距设置不正确，请重新输入", vbExclamation, "打印"
                    ctxtMargin(2).SetFocus
                    ctxtMargin(2).Text = 0
                    Exit Function
                Else
                    mctlPrinter.MarginTop = Val(ctxtMargin(i)) * 567
                End If
            Case 3
                If Val(ctxtMargin(i)) * 567 > .PageHeight Then
                    MsgBox "页边距设置不正确，请重新输入", vbExclamation, "打印"
                    ctxtMargin(3).SetFocus
                    ctxtMargin(3).Text = 0
                    Exit Function
                Else
                    mctlPrinter.MarginBottom = Val(ctxtMargin(i)) * 567
                End If
            End Select
            End If
        Else
            MsgBox "页边距设置不正确，请重新输入", vbExclamation, "打印"
            ctxtMargin(0).SetFocus
            Exit Function
        End If


        End With
        Next
      funcSetMargin = True
End Function