frmmodcommonprint.frm

通用书店管理系统

Dim strSubtotal As String               '记录表格汇总信息
   

'窗体初始化
Private Sub iniForm()
    
    ReDim strPageRange(0)
    strPageRange(0) = "-1"
    Font_Gap = 1.05
    
    If SubTotal_Height = 0 Then SubTotal_Height = 600
    If TopHeader_Height = 0 Then TopHeader_Height = 300
    
    If RowInterRate = 0 Then RowInterRate = 0.2    '设置行缝隙
    If ParagraphInterRate = 0 Then ParagraphInterRate = 0.5 '设置段落缝隙
    
    vp.MarginHeader = vp.MarginTop          '把打印边距设定赋给头空白区域
    vp.MarginFooter = vp.MarginBottom        '把打印边距设定赋给脚空白区域
    
    If PrintMarginLeft <> 0 Then vp.MarginLeft = PrintMarginLeft
    If PrintMarginRight <> 0 Then vp.MarginRight = PrintMarginRight
    If PrintMarginHeader <> 0 Then vp.MarginHeader = PrintMarginHeader
    If PrintMarginFooter <> 0 Then vp.MarginFooter = PrintMarginFooter
    If PrintPaperSize <> 0 Then vp.PaperSize = PrintPaperSize
    
    vp.Orientation = PrintOrientation
    
    TableLabelVisable = True: TableTextVisable = True
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 Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    '释放资源
    Unload frm
    Set frm = Nothing
End Sub

'处理按扭事件
Private Sub tb_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error GoTo err
    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中的MaringHeader相对应；
        '                      而下边距和VP中的MaringFooter相对应
        Dim oldMarginTop As Double
        Dim oldMarginBotton As Double
        
        oldMarginTop = vp.MarginTop
        oldMarginBotton = vp.MarginBottom
        
        vp.MarginTop = vp.MarginHeader
        vp.MarginBottom = vp.MarginFooter
        
        If vp.PrintDialog(pdPageSetup) Then
            vp.MarginHeader = vp.MarginTop
            vp.MarginFooter = vp.MarginBottom
            Call doDraw
        Else
            vp.MarginTop = oldMarginTop
            vp.MarginBottom = oldMarginBotton
        End If
        
    Case "页面设置"
        Call setPrintSetup
        
    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
    Exit Sub
err:
    MsgBox "打印设置出错：" & err.Description
End Sub

'窗体开始
Public Sub FormStart()
    On Error GoTo err
    
    strDBMainTable = "tCOM_PrintInfo"
    strDBDetailTable = "tCOM_PrintInfo_Dtl"
    
    Call setPrintConfig(strPrintInfoName)   '配置打印信息
    Call doDraw
    
    Exit Sub
err:
    MsgBox err.Description
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()
    On Error GoTo err
    '-----打印前准备
    With vp
        .StartDoc
        .Text = " "             '给个空串初始化打印
        .GetMargins
        .ShowGuides = gdShow
        
        Draw_HeaderFooter       '页眉/页脚
        .CurrentY = .MarginHeader
        Draw_Title              '标题
        Draw_SayingAboveTable   '表前叙述
        Draw_SayingBelowTable   '表后叙述
        Draw_Sign               '签名
        
        '计算表格所占高度，同时计算出“上空白区”与“下空白区”
        Dim TotalKeepTopMargin&, TotalKeepBottomMargin&
        If blnRepeatTitle Then TotalKeepTopMargin = TotalKeepTopMargin + Title_Height
        If blnRepeatSayingAboveTable Then TotalKeepTopMargin = TotalKeepTopMargin + SayingAboveTable_Height
        If blnRepeatSayingBelowTable Then TotalKeepBottomMargin = TotalKeepBottomMargin + SayingBelowTable_Height
        If blnRepeatSign Then TotalKeepBottomMargin = TotalKeepBottomMargin + Sign_Height
    
        .MarginTop = .MarginHeader + TotalKeepTopMargin + TopHeader_Height  '上空白区
        .MarginBottom = .MarginFooter + TotalKeepBottomMargin + SubTotal_Height  '下空白区
        
        If MaxRowsPerPage <> 0 Then '当强行指定行高行数时，采用方法二计算
            .MarginBottom = .PageHeight - .MarginTop - Row_Height * MaxRowsPerPage
        End If
        
        Table_Height = .PageHeight - .MarginTop - .MarginBottom  '表格高度
        
        .EndDoc
        
    End With
    
    '----正式绘制
    With vp
        .StartDoc
        '.GetMargins
        
        '.CurrentY = .MarginHeader
        '画标题
        'Draw_Title
        
        '.CurrentY = .MarginHeader + Title_Height
        '画表前叙述
        'Draw_SayingAboveTable
        
        '画表格
        .CurrentY = .MarginHeader + Title_Height + SayingAboveTable_Height + TopHeader_Height
        Draw_Table
        
        If Not blnEmptyRow Then
            '画汇总信息,如果自动填空行时，则在下面统一处理
            Draw_Subtotal (vp.PageCount)
        
            '画表后叙述,如果自动填空行时，则在下面统一处理
            Draw_SayingBelowTable
        
        End If
        
        .EndDoc
    End With
    
    '----重复填补
    Dim i&, j&
    For i = 1 To vp.PageCount
        With vp
            .StartOverlay i
            
            '填补标题
            If i = 1 Then
                .CurrentY = .MarginHeader
                Draw_Title
            ElseIf blnRepeatTitle Then
                .CurrentY = .MarginHeader
                Draw_Title
            End If
            
            '填补表前叙述
            If i = 1 Then
                .CurrentY = .MarginHeader + Title_Height
                Draw_SayingAboveTable
            ElseIf blnRepeatSayingAboveTable Then
                .CurrentY = .MarginHeader
                If blnRepeatTitle Then .CurrentY = .MarginHeader + Title_Height
                Draw_SayingAboveTable
            End If
            
            '填补双列头
            If i = 1 Then
                .CurrentY = .MarginHeader + Title_Height + SayingAboveTable_Height
                Draw_TopHeader
            Else
                .CurrentY = .MarginTop - TopHeader_Height
                Draw_TopHeader
            End If
            
            '填补空行
            If i = vp.PageCount Then
                If blnEmptyRow And intEmptyRows >= 1 Then
                    .CurrentY = dblEmptyBeginY
                    .StartTable
                    ReDim arr(UBound(arrHeader), intEmptyRows - 1)
                    .AddTableArray strFormat, "", arr
                    .TableCell(tcRowHeight) = Row_Height
                    For j = 1 To UBound(arrColWidth) + 1
                        .TableCell(tcColWidth, 0, j) = arrColWidth(j - 1)
                    Next j
                    .EndTable
                End If
            End If
            
            '填补汇总,最后页在前面始终打印
            If i = 1 Then
                If Not blnEmptyRow Then
                    .CurrentY = .MarginHeader + Title_Height + SayingAboveTable_Height + TopHeader_Height + RowsFirstPage * (Row_Height)
                Else
                    If .PageCount = 1 Then
                        .CurrentY = .MarginHeader + Title_Height + SayingAboveTable_Height + TopHeader_Height + RowsPerPage * (Row_Height)
                    Else
                        .CurrentY = .MarginHeader + Title_Height + SayingAboveTable_Height + TopHeader_Height + RowsFirstPage * (Row_Height)
                    End If
                End If
                Draw_Subtotal i
                
            ElseIf i < vp.PageCount Then
                .CurrentY = .PageHeight - .MarginBottom - (Table_Height - RowsPerPage * (Row_Height))
                Draw_Subtotal i
            Else    '当打印到最后一页时，如自动填充空行，则在此打印
                If blnEmptyRow Then
                    .CurrentY = .PageHeight - .MarginBottom - (Table_Height - RowsPerPage * (Row_Height))
                    Draw_Subtotal i
                End If
            End If
            
            '填补表后叙述,最后页在前面始终打印
            If blnRepeatSayingBelowTable Then
                If i < vp.PageCount Or blnEmptyRow Then
                    .CurrentY = .PageHeight - .MarginBottom - (Table_Height - RowsPerPage * (Row_Height)) + SubTotal_Height
                    Draw_SayingBelowTable
                End If
            ElseIf blnEmptyRow Then
                If i = vp.PageCount Then
                    .CurrentY = .PageHeight - .MarginBottom - (Table_Height - RowsPerPage * (Row_Height)) + SubTotal_Height
                    Draw_SayingBelowTable
                End If
            End If
            
            '填补签名,最后页在前面始终打印
            If blnRepeatSign Or i = vp.PageCount Then
                .CurrentY = .PageHeight - .MarginFooter
                .CurrentY = .CurrentY - Sign_Height
                Draw_Sign
            End If
            
            '填补页码
            Draw_PageNumber i, vp.PageCount
            
            .EndOverlay
        End With
    Next i
    
    sb.Panels(2).Text = "第 " & vp.CurrentPage & " 页  共 " & vp.PageCount & " 页"
    Exit Sub
err:
    MsgBox "打印出现错误：" & err.Description