frmmodcommonprint.frm

通用书店管理系统

End Sub

'显示页眉/页脚
Private Sub Draw_HeaderFooter()
    With vp
        '显示页眉
        setCurrentFont PrintInfo.cqPageBrow  '设置字体
        .Header = PrintInfo.cqPageBrow.Content & " "
        
        '显示页脚
        setCurrentFont PrintInfo.cqPageFoot  '设置字体
        .Footer = PrintInfo.cqPageFoot.Content & " "
        
   End With
End Sub

'显示标题
Private Sub Draw_Title()
    Dim BeginY&, EndY&
    Dim oldY&
    With vp
        BeginY = .CurrentY
        '为页眉留出空间
        If Trim(PrintInfo.cqPageBrow.Content) <> "" Then
            setCurrentFont PrintInfo.cqPageBrow  '设置字体
            .CurrentY = .CurrentY + One_Height * (1 + ParagraphInterRate)
        End If
        
        '显示正标题
        If Trim(PrintInfo.cqFirstTitle.Content) <> "" Then
            
            setCurrentFont PrintInfo.cqFirstTitle  '设置字体
            .CurrentX = (.PageWidth - .TextWidth(PrintInfo.cqFirstTitle.Content)) / 2
            
            If TableLabelVisable Then              '控制交给表格标签是否显示
                .Text = PrintInfo.cqFirstTitle.Content
            End If
            .CurrentY = .CurrentY + .TextHeight("A")     '换行
            'Call .DrawLine(.CurrentX - .TextWidth(PrintInfo.cqFirstTitle.Content) - 200, .CurrentY + .TextHeight("A") * 1.1, .CurrentX + 200, .CurrentY + .TextHeight("A") * 1.1)
            
        End If
        
        '显示副标题
        If Trim(PrintInfo.cqSecondTitle.Content) <> "" Then
            .CurrentX = .MarginLeft
            setCurrentFont PrintInfo.cqSecondTitle  '设置字体
            .CurrentX = (.PageWidth - .TextWidth(PrintInfo.cqFirstTitle.Content)) / 2 + .TextWidth("好") * 2
            .CurrentY = .CurrentY + .TextHeight("A") * 0.2  '缝隙
            
            If TableLabelVisable Then              '控制交给表格标签是否显示
                .Text = PrintInfo.cqSecondTitle.Content
            End If
            .CurrentY = .CurrentY + .TextHeight("A")
            
        End If
        
        If Trim(PrintInfo.cqFirstTitle.Content) <> "" Or Trim(PrintInfo.cqSecondTitle.Content) <> "" Then
            .CurrentY = .CurrentY + One_Height * ParagraphInterRate
        End If
        
        EndY = .CurrentY
    
    End With
    Title_Height = EndY - BeginY
    
End Sub

'显示表前叙述
Private Sub Draw_SayingAboveTable()
    Dim BeginY&, EndY&
    
    With vp
        BeginY = .CurrentY
        
        If Trim(PrintInfo.cqSayingAboveTable.Content) <> "" Then
            
            '定位
            .CurrentX = .MarginLeft
            
            setCurrentFont PrintInfo.cqSayingAboveTable  '设置字体
            
            Call DrawText(PrintInfo.cqSayingAboveTable.Content, _
                            PrintInfo.cqSayingAboveTable.LayOut, _
                            PrintInfo.cqSayingAboveTable.Separation)
            .CurrentY = .CurrentY + .TextHeight("A")
            .CurrentY = .CurrentY + One_Height * ParagraphInterRate
        End If
        
        EndY = .CurrentY
    End With
    SayingAboveTable_Height = EndY - BeginY
End Sub

'获得宽度
Private Function getColIndex(strValue As String) As Integer
    Dim i%
    For i = 0 To UBound(arrHeader)
        If Trim(arrHeader(i)) = Trim(strValue) _
                Or i + 1 = Val(strValue) Then
            getColIndex = i + 1
            Exit For
        End If
    Next i
End Function

'显示顶层列头
Private Sub Draw_TopHeader()
    
    If Trim(strHeaderMerge) = "" Then Exit Sub
    
    Dim arrMergerGroup
    Dim arrMerger
    Dim i%, j%, c%, p%
    Dim StartMarginLeft&, StartY&
    Dim colWidth&
    arrMergerGroup = Split(strHeaderMerge, "|")
    
    StartMarginLeft = vp.MarginLeft: StartY = vp.CurrentY  '保留当前坐标
    
    setCurrentFont PrintInfo.cqTable  '设置字体
    
    With vp
        .StartTable
        .TableCell(tcRows) = 1
        .TableCell(tcCols) = UBound(arrHeader) + 1
        .TableCell(tcAlign) = taCenterMiddle
        .TableCell(tcRowHeight, 1) = TopHeader_Height + Row_Height
        .TableCell(tcBackColor) = vbWhite
        For i = 0 To UBound(arrHeader)
            If TableLabelVisable Then _
                .TableCell(tcText, 1, i + 1) = Trim(arrHeader(i))
            
            .TableCell(tcColWidth, 1, i + 1) = CDbl(arrColWidth(i))
        Next i
        .EndTable
    End With
    
    For i = 0 To UBound(arrMergerGroup)
        arrMerger = Split(arrMergerGroup(i), ",")
        j = getColIndex(Trim(arrMerger(1)))
        With vp
            '定位Y坐标
            colWidth = 0
            For c = 1 To j - 1
                colWidth = colWidth + CDbl(arrColWidth(c - 1))
            Next c
            
            .MarginLeft = StartMarginLeft + colWidth
            .CurrentY = StartY
            
            '绘制表格
            .StartTable
            
            .TableCell(tcRows) = 2
            .TableCell(tcCols) = CInt(arrMerger(2))
            .TableCell(tcAlign) = taCenterMiddle
            .TableCell(tcBackColor) = vbWhite
            
            '给第二行赋值
            For c = 1 To CInt(arrMerger(2))
                If TableLabelVisable Then _
                    .TableCell(tcText, 2, c) = Trim(arrHeader(j + c - 2))
                .TableCell(tcRowHeight, 2) = Row_Height
                .TableCell(tcColWidth, , c) = CDbl(arrColWidth(j + c - 2))
            Next c
            
            '给第一行赋值
            If TableLabelVisable Then _
                .TableCell(tcText, 1, 1) = Trim(arrMerger(0))
            .TableCell(tcColSpan, 1) = CInt(arrMerger(2))
            .TableCell(tcRowHeight, 1) = TopHeader_Height
            
            .EndTable
        End With
    Next i
        
    vp.MarginLeft = StartMarginLeft
    
End Sub


'显示表后叙述
Private Sub Draw_SayingBelowTable()
    Dim BeginY&, EndY&
    
    With vp
        
        BeginY = .CurrentY
        
        If Trim(PrintInfo.cqSayingBelowTable.Content) <> "" Then
            .CurrentX = .MarginLeft
            
            setCurrentFont PrintInfo.cqSayingBelowTable  '设置字体
            .CurrentY = .CurrentY + One_Height * ParagraphInterRate '与上一节的缝隙
            Call DrawText(PrintInfo.cqSayingBelowTable.Content, _
                            PrintInfo.cqSayingBelowTable.LayOut, _
                            PrintInfo.cqSayingBelowTable.Separation)
            
            .CurrentY = .CurrentY + .TextHeight("A")
            .CurrentY = .CurrentY + One_Height * ParagraphInterRate
        End If
        EndY = .CurrentY
    End With
    SayingBelowTable_Height = EndY - BeginY
End Sub

'显示汇总信息
Private Sub Draw_Subtotal(intPage As Long)
    Dim i%, strFormat$, arr, arrSum
    Dim g%, Subtatal_MaxRow%, arrSubtotalSpanCol
    
    
    If Trim(strSubtotal) = "" Then Exit Sub
    If UBound(Subtotal_Type) < 0 Then Exit Sub
    
    setCurrentFont PrintInfo.cqTable  '设置字体
    
    '求出最大行数
    For i = 0 To UBound(Subtotal_Row)
        If Subtatal_MaxRow < Subtotal_Row(i) Then Subtatal_MaxRow = Subtotal_Row(i)
    Next i
    
    vp.StartTable   '表格开始
    For i = 0 To UBound(arrColWidth)        '生成表格格式
        If i < UBound(arrColWidth) Then
            strFormat = strFormat & arrColWidth(i) & "|"
        Else
            strFormat = strFormat & arrColWidth(i)
        End If
    Next i
    ReDim arr(UBound(arrColWidth), Subtatal_MaxRow - 1)     '创建数组
    vp.AddTableArray strFormat, "", arr         '生成表框架
    vp.TableCell(tcRowHeight) = SubTotal_Height / Subtatal_MaxRow   '设定行高
    
    For g = 0 To UBound(Subtotal_Type)
        Select Case Subtotal_Type(g)
        Case 1  '总计
            '赋值
            If Not TableLabelVisable Then
                vp.TableCell(tcText, Subtotal_Row(g), Subtotal_CaptionCol(g)) = ""
            Else
                vp.TableCell(tcText, Subtotal_Row(g), Subtotal_CaptionCol(g)) = Subtotal_Caption(g)
            End If
            If Not TableTextVisable Then
                vp.TableCell(tcText, Subtotal_Row(g), Subtotal_SumPosition(g)) = ""
            Else
                vp.TableCell(tcText, Subtotal_Row(g), Subtotal_SumPosition(g)) = DataFormat(Subtotal_Sum(g), Subtotal_Format(g))
            End If
        Case 2  '页合计
            arrSum = Split(Subtotal_Sum(g), ";")
            If intPage > UBound(arrSum) + 1 Then
                MsgBox "打印进行汇总是发生错误，请选择的合适的页尺寸！如再有问题请与系统管理员联系！"
                Exit Sub
            End If
            '赋值
            If Not TableLabelVisable Then
                vp.TableCell(tcText, Subtotal_Row(g), Subtotal_CaptionCol(g)) = ""
            Else
                vp.TableCell(tcText, Subtotal_Row(g), Subtotal_CaptionCol(g)) = Subtotal_Caption(g)
            End If
            If Not TableTextVisable Then
                vp.TableCell(tcText, Subtotal_Row(g), Subtotal_SumPosition(g)) = ""
            Else
                vp.TableCell(tcText, Subtotal_Row(g), Subtotal_SumPosition(g)) = DataFormat(arrSum(intPage - 1), Subtotal_Format(g))
            End If
            
        End Select
        
        '布局
        vp.TableCell(tcAlign, Subtotal_Row(g), Subtotal_CaptionCol(g)) = taCenterMiddle
        vp.TableCell(tcAlign, Subtotal_Row(g), Subtotal_SumPosition(g)) = taLeftMiddle
        '合并
        arrSubtotalSpanCol = Split(Subtotal_SpanCol(g), "-")
        vp.TableCell(tcColSpan, Subtotal_Row(g), Subtotal_CaptionCol(g)) = CInt(arrSubtotalSpanCol(0))
        vp.TableCell(tcColSpan, Subtotal_Row(g), Subtotal_SumPosition(g)) = CInt(arrSubtotalSpanCol(1))
            
    Next g
    vp.EndTable
        
End Sub

'显示签名
Private Sub Draw_Sign()
    Dim BeginY&, EndY&
    
    With vp
        BeginY = .CurrentY
        
        If Trim(PrintInfo.cqSign.Content) <> "" Then
            .CurrentX = .MarginLeft
            
            setCurrentFont PrintInfo.cqSign  '设置字体
       
            Call DrawText(PrintInfo.cqSign.Content, _
                            PrintInfo.cqSign.LayOut, _
                            PrintInfo.cqSign.Separation)
            
            .CurrentY = .CurrentY + .TextHeight("A")
            .CurrentY = .CurrentY + One_Height * (1 + ParagraphInterRate)
        End If
        
        EndY = .CurrentY
    End With
    Sign_Height = EndY - BeginY
End Sub

'显示表格
Private Sub Draw_Table()
    With vp
        
        '-----直接画控件
        If PrintInfo.cqTable.Hwnd <> 0 Then
            .CurrentX = .MarginLeft
            .RenderControl = PrintInfo.cqTable.Hwnd
        End If
        
        '-----画数组
        If InStr(1, TypeName(PrintInfo.cqTable.Content), "(") <> 0 Then
            .CurrentX = .MarginLeft
            setCurrentFont PrintInfo.cqTable  '设置字体
            Call DrawTable  '绘制由数组传入的表格
            
        End If
    End With
End Sub

'显示页码
Private Sub Draw_PageNumber(curPage As Long, TotalPages As Long)
    Dim strPageValue$ '显示内容
    Dim strPageOf As String
    Dim strPageOfFormat$, strPageOfPosType$, strPageOfPosXY$
    Dim arrPageOfPosXY() As String
    strPageOf = PrintInfo.cqPageFoot.LayOut
    If strPageOf = "" Then
        strPageOf = "PageOf PageOfFormat=第(页码)页共(页数)页 PageOfPosType=右下角 "       '向前兼容，进行数据初始化工作
        PrintInfo.cqPageFoot.LayOut = strPageOf
    End If
    
    strPageOfFormat = g_GetValueByString(strPageOfFormat, "PageOfFormat", strPageOf)
    strPageOfPosType = g_GetValueByString(strPageOfPosType, "PageOfPosType", strPageOf)
    strPageOfPosXY = g_GetValueByString(strPageOfPosXY, "PageOfPosXY", strPageOf)