frmprint.frm

来自「通用书店管理系统」· FRM 代码 · 共 618 行 · 第 1/2 页

FRM
618
字号

Dim lng_drawModel As Long                   '选择打印模式
Dim strPageRange() As String                '页码范围


'窗体初始化
Private Sub iniForm()
    ReDim strPageRange(0)
    strPageRange(0) = "-1"
    
End Sub

Private Sub Form_Activate()
    If Me.scaleWidth > 100 And Me.ScaleHeight > (tb.Height + sb.Height + 400) Then
        vp.Move 50, tb.Height + 50, Me.scaleWidth - 100, Me.ScaleHeight - tb.Height - sb.Height - 400
    End If
End Sub

Private Sub Form_Load()
    '初始化窗体界面
    vp.Move 50, tb.Height + 50, Me.scaleWidth - 100, Me.ScaleHeight - tb.Height - sb.Height - 400
    Call iniForm
    
End Sub

'处理按扭事件
Private Sub tb_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Trim(Button.Caption)
    Case "打印"
        Dim p%
        Dim strTemp
        
        If strPageRange(0) = "-1" Then
            Call vp.PrintDoc
        Else
            For p = 0 To UBound(strPageRange)
                strTemp = Split(strPageRange(p), "-")
                Call vp.PrintDoc(FromPage:=strTemp(0), ToPage:=strTemp(1))
                DoEvents
            Next p
        End If
        
    Case "关闭"
        Unload Me
        
    Case "打印设置"
        vp.PrintDialog (pdPageSetup)
        Call doDraw
        
    Case "页面设置"
        Call setPrintSetup
        Call doDraw
    Case "放大"
        vp.Zoom = vp.Zoom + 10
    
    Case "缩小"
        If vp.Zoom > 10 Then vp.Zoom = vp.Zoom - 10
    
    Case "首页"
        vp.PreviewPage = 0
        Call setPageButtonEnable
        
    Case "上一页"
        
        vp.PreviewPage = vp.PreviewPage - 1
        Call setPageButtonEnable
        
    Case "下一页"
        
        vp.PreviewPage = vp.PreviewPage + 1
        Call setPageButtonEnable
            
    Case "尾页"
        vp.PreviewPage = vp.PageCount
        Call setPageButtonEnable
        
    End Select
End Sub

'窗体开始
Public Sub FormStart(model As Long)
    
    Select Case model
    Case 1
        lng_drawModel = model   '打印模式
        Call doDraw
    End Select
End Sub

Private Sub tb_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
    Select Case Trim(ButtonMenu.Parent.Caption)
    Case "多页显示"
        Select Case Trim(ButtonMenu.Text)
        Case "单页"
            vp.ZoomMode = zmWholePage
        Case "双页"
            vp.ZoomMode = zmTwoPages
        Case "自动"
            vp.ZoomMode = zmThumbnail
        End Select
    Case "比例"
        vp.Zoom = Val(ButtonMenu.Text)
    End Select
End Sub

Private Sub setPageButtonEnable()
    
    If vp.PreviewPage < vp.PageCount Then
        tb.Buttons.Item("下一页").Enabled = True
    Else
        tb.Buttons.Item("下一页").Enabled = False
    End If
    If vp.PreviewPage > 1 Then
        tb.Buttons.Item("上一页").Enabled = True
    Else
        tb.Buttons.Item("上一页").Enabled = False
    End If
    
    sb.Panels(2).Text = "第 " & vp.PreviewPage & " 页  共 " & vp.PageCount & " 页"
    
End Sub

Private Sub doDraw()
    Select Case lng_drawModel
    Case 1  '打印FlexGrid
        Call Draw_FlexGrid
    Case 2
    End Select
    
End Sub

Private Sub Draw_FlexGrid()
    With vp
        '行间距
        .LineSpacing = 150

        
        '显示页眉
        
        .FontBold = PrintInfo.cqPageBrow.FontBold
        .FontItalic = PrintInfo.cqPageBrow.FontItalic
        .FontName = PrintInfo.cqPageBrow.FontName
        .FontSize = PrintInfo.cqPageBrow.FontSize
        .TextColor = PrintInfo.cqPageBrow.ForeColor
        .Header = PrintInfo.cqPageBrow.Content
        
        
        '显示页脚
        
        .FontBold = PrintInfo.cqPageFoot.FontBold
        .FontItalic = PrintInfo.cqPageFoot.FontItalic
        .FontName = PrintInfo.cqPageFoot.FontName
        .FontSize = PrintInfo.cqPageFoot.FontSize
        .TextColor = PrintInfo.cqPageFoot.ForeColor
        .Footer = PrintInfo.cqPageFoot.Content
        
        
        .StartDoc
        
        '显示正标题
        If Trim(PrintInfo.cqFirstTitle.Content) <> "" Then
            .CurrentX = (.PageWidth - .TextWidth(PrintInfo.cqFirstTitle.Content)) / 2
            .FontBold = PrintInfo.cqFirstTitle.FontBold
            .FontItalic = PrintInfo.cqFirstTitle.FontItalic
            .FontName = PrintInfo.cqFirstTitle.FontName
            .FontSize = PrintInfo.cqFirstTitle.FontSize
            .TextColor = PrintInfo.cqFirstTitle.ForeColor
            .Text = PrintInfo.cqFirstTitle.Content
        End If
        
        '显示副标题
        If Trim(PrintInfo.cqSecondTitle.Content) <> "" Then
            .CurrentX = .MarginLeft
            .CurrentY = .CurrentY + .TextHeight("A") * 1    '换行
            
            .FontBold = PrintInfo.cqSecondTitle.FontBold
            .FontItalic = PrintInfo.cqSecondTitle.FontItalic
            .FontName = PrintInfo.cqSecondTitle.FontName
            .FontSize = PrintInfo.cqSecondTitle.FontSize
            .TextColor = PrintInfo.cqSecondTitle.ForeColor
            
            .CurrentX = (.PageWidth - .TextWidth(PrintInfo.cqFirstTitle.Content)) / 2 + .TextWidth("好") * 2
            .CurrentY = .CurrentY + .TextHeight("A") * 0.2  '缝隙
            .Text = PrintInfo.cqSecondTitle.Content
            
        End If
        
        '显示表前叙述
        If Trim(PrintInfo.cqSayingAboveTable.Content) <> "" Then
            
            '定位
            .CurrentX = .MarginLeft
            .CurrentY = .CurrentY + .TextHeight("A") * 3
            
            .FontBold = PrintInfo.cqSayingAboveTable.FontBold
            .FontItalic = PrintInfo.cqSayingAboveTable.FontItalic
            .FontName = PrintInfo.cqSayingAboveTable.FontName
            .FontSize = PrintInfo.cqSayingAboveTable.FontSize
            .TextColor = PrintInfo.cqSayingAboveTable.ForeColor
            
            .CurrentY = .CurrentY + .TextHeight("A") * 0.2  '缝隙
            .Text = PrintInfo.cqSayingAboveTable.Content
            
        End If
        
        
            
        '显示表格
        .CurrentX = .MarginLeft
        .CurrentY = .CurrentY + .TextHeight("A") * 2  '缝隙
        .RenderControl = lng_FlexGrid_Hwnd
        
        '显示表后叙述
        If Trim(PrintInfo.cqSayingBelowTable.Content) <> "" Then
            .CurrentX = .MarginLeft
            .CurrentY = .CurrentY + .TextHeight("A") * 1    '换行

            .FontBold = PrintInfo.cqSayingBelowTable.FontBold
            .FontItalic = PrintInfo.cqSayingBelowTable.FontItalic
            .FontName = PrintInfo.cqSayingBelowTable.FontName
            .FontSize = PrintInfo.cqSayingBelowTable.FontSize
            .TextColor = PrintInfo.cqSayingBelowTable.ForeColor
            
            .CurrentY = .CurrentY + .TextHeight("A") * 0.2  '缝隙
            .Text = PrintInfo.cqSayingBelowTable.Content
            
        End If
        
        '显示签名
       If Trim(PrintInfo.cqSign.Content) <> "" Then
            .CurrentX = .MarginLeft
            .CurrentY = .CurrentY + .TextHeight("A") * 2    '换行
            
            .FontBold = PrintInfo.cqSign.FontBold
            .FontItalic = PrintInfo.cqSign.FontItalic
            .FontName = PrintInfo.cqSign.FontName
            .FontSize = PrintInfo.cqSign.FontSize
            .TextColor = PrintInfo.cqSign.ForeColor
            
            '定位
            If .CurrentY < (vp.PageHeight - .TextHeight("A") * 5 - vp.MarginBottom) Then
                 .CurrentY = (vp.PageHeight - .TextHeight("A") * 5 - vp.MarginBottom)
            Else
                 .CurrentY = (vp.PageHeight + .TextHeight("A") * 5)
                 .Text = ""
                 .CurrentY = (vp.PageHeight - .TextHeight("A") * 5 - vp.MarginBottom)
            End If
       
            .Text = PrintInfo.cqSign.Content
            
       End If
       
        
       .EndDoc
    End With
    
    sb.Panels(2).Text = "第 " & vp.CurrentPage & " 页  共 " & vp.PageCount & " 页"
    
End Sub

Private Sub setPrintSetup()
    Dim frm As New dlgPrint
    
    Set frm.PrintInfo = PrintInfo
    
    Select Case lng_drawModel
    Case 1  '打印FlexGrid
        frm.Show vbModal
        If Not frm.blnOK Then Exit Sub
        
        '全部打印
        If frm.optPageRange(0).Value Then
            ReDim strPageRange(0)
            strPageRange(0) = 1 & "-" & vp.PageCount
        End If
        '打印当前页
        If frm.optPageRange(1).Value Then
            ReDim strPageRange(0)
            strPageRange(0) = vp.PreviewPage & "-" & vp.PreviewPage
        End If
        '选择打印
        If frm.optPageRange(2).Value Then
            strPageRange = Split(Trim(frm.txtPageRange), ",")
            Dim p%
            For p = 0 To UBound(strPageRange)
                If InStr(1, strPageRange(p), "-") = 0 Then _
                    strPageRange(p) = strPageRange(p) & "-" & strPageRange(p)
            Next p
        End If
        '打印份数
        VB.Printer.Copies = CInt(frm.strTxtCopyQty)
        
    Case 2
    
    End Select
    
End Sub


Private Sub vp_AfterFooter()
    
    '显示页码
    vp.CurrentY = vp.PageHeight - vp.MarginBottom + vp.TextHeight("好") * 1
    vp.CurrentX = vp.PageWidth - vp.MarginRight - vp.TextWidth("工") * 15
    vp.Text = "第 " & vp.CurrentPage & " 页  共 " & vp.PageCount & " 页"
    vp.CurrentX = vp.MarginLeft
End Sub

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?