preview3.frm

来自「这个是我以前做的一个客户管理系统.包内已经含有源码和所用到的控件.代码是用VB写」· FRM 代码 · 共 1,949 行 · 第 1/5 页

    VsPreview.CurrentX = VsPreview.Marginleft
    VsPreview.TextAlign = taLeftTop
    VsPreview.Text = gLeftTop
    VsPreview.CalcText = gLeftTop
    
    '中标题
    VsPreview.CurrentX = VsPreview.Marginleft + lColWidth / 2 - VsPreview.TextWidth(gMidTop) / 2
    VsPreview.TextAlign = taLeftTop
    VsPreview.Text = gMidTop
    VsPreview.CalcText = gMidTop
    
    '右标题
    VsPreview.CurrentX = VsPreview.Marginleft + lColWidth - VsPreview.TextWidth(gRightTop) - 200
    VsPreview.TextAlign = taLeftTop
    VsPreview.Text = gRightTop
    VsPreview.CalcText = gRightTop
End If
    
    
    '恢复字体信息
    VsPreview.FontName = OldName
    VsPreview.FontUnderline = OldUnder
    VsPreview.FontSize = OldSize
    VsPreview.FontItalic = OldItalic
    VsPreview.FontBold = OldBold
    
    mbSetMuliTitle = True
    Exit Function
    
ErrSetMuliTitle:
    Screen.MousePointer = vbDefault
    mbSetMuliTitle = False
    gShowMsg "设置打印子标题出错 frmPreview.mbSetMuliTitle"

End Function

Private Function mbSetFootTitle() As Boolean
'****************************************************
'设置打印尾注

    Dim OldSize             As Integer
    Dim OldBold             As Boolean
    Dim OldItalic           As Boolean
    Dim OldName         As String
    Dim OldUnder        As Boolean
    Dim i               As Integer
    Dim lColWidth       As Long
    
    On Error GoTo ErrSetFootTitle
    
    '保存字体信息
    OldName = VsPreview.FontName
    OldSize = VsPreview.FontSize
    OldItalic = VsPreview.FontItalic
    OldBold = VsPreview.FontBold
    OldUnder = VsPreview.FontUnderline


    VsPreview.FontName = gFontNameFootTitle
    VsPreview.FontSize = gFontSizeFootTitle
    VsPreview.FontBold = gbFontBoldFootTitle
    VsPreview.FontItalic = gbFontItalicFootTitle
    VsPreview.FontUnderline = gbFontUnderFootTitle

     VsPreview.CurrentY = VsPreview.CurrentY + VsPreview.TextHei * 2
    
    lColWidth = 0
    For i = 1 To gCols
        lColWidth = lColWidth + gColWidth(i)
    Next i
    
    '左下标题
    VsPreview.Text = gLeftBottom
    VsPreview.CalcText = gLeftBottom
    '中下标题
    VsPreview.CalcText = gMidBottom
    VsPreview.CurrentX = VsPreview.Marginleft + lColWidth / 2 - VsPreview.TextWidth(gMidBottom) / 2
    VsPreview.TextAlign = taLeftMiddle
    VsPreview.Text = gMidBottom
    
    
    '右下标题
    VsPreview.CalcText = gRightBottom
    VsPreview.CurrentX = VsPreview.Marginleft + lColWidth - VsPreview.TextWidth(gRightBottom) - 500
    VsPreview.TextAlign = taLeftBottom
    VsPreview.Text = gRightBottom
    
    '右下备注
    
    VsPreview.CalcText = gMemoBottom
    VsPreview.CurrentX = VsPreview.Marginleft
    VsPreview.CurrentY = VsPreview.CurrentY + VsPreview.TextHei + 150
    VsPreview.TextAlign = taLeftBottom
    VsPreview.Text = gMemoBottom

    
    '恢复字体信息
    VsPreview.FontName = OldName
    VsPreview.FontUnderline = OldUnder
    VsPreview.FontSize = OldSize
    VsPreview.FontItalic = OldItalic
    VsPreview.FontBold = OldBold
    
    mbSetFootTitle = True
    Exit Function
    
ErrSetFootTitle:
    Screen.MousePointer = vbDefault
    mbSetFootTitle = False
    gShowMsg "设置打印尾注出错 frmPreview.mbSetFootTitle"

End Function

Private Function mbSetMainTitle() As Boolean

'****************************************************
'设置打印主标题
        
    Dim OldSize             As Integer
    Dim OldBold             As Boolean
    Dim OldItalic           As Boolean
    Dim OldName         As String
    Dim OldUnder        As Boolean
    Dim lColWidth       As Long
    Dim i               As Integer
    
    On Error GoTo ErrSetMainTitle
    
    '保存字体信息
    OldName = VsPreview.FontName
    OldSize = VsPreview.FontSize
    OldItalic = VsPreview.FontItalic
    OldBold = VsPreview.FontBold
    OldUnder = VsPreview.FontUnderline

    '显示主标题
    VsPreview.FontName = gFontNameTitle
    VsPreview.FontSize = gFontSizeTitle
    VsPreview.FontBold = gbFontBoldTitle
    VsPreview.FontItalic = gbFontItalicTitle
    VsPreview.FontUnderline = gbFontUnderTitle

        lColWidth = 0
    For i = 1 To gCols
        lColWidth = lColWidth + gColWidth(i)
    Next i

    VsPreview.CurrentY = VsPreview.MarginTop
    VsPreview.TextAlign = taLeftTop
    VsPreview.CurrentX = VsPreview.Marginleft + lColWidth / 2 - VsPreview.TextWidth(gTitle) / 2
    VsPreview.Text = gTitle
    VsPreview.CalcText = gTitle
    VsPreview.CurrentY = VsPreview.CurrentY + VsPreview.TextHei
    
    If gSubTitle <> "" Then
    '子标题
    VsPreview.CurrentX = VsPreview.Marginleft + lColWidth / 2 - VsPreview.TextWidth(gSubTitle) / 2
    VsPreview.Text = gSubTitle
    VsPreview.CalcText = gSubTitle
    VsPreview.CurrentY = VsPreview.CurrentY + VsPreview.TextHei
    End If
    
    VsPreview.CurrentX = VsPreview.Marginleft
    VsPreview.TextAlign = taLeftTop
    
    
    '恢复字体信息
    VsPreview.FontName = OldName
    VsPreview.FontUnderline = OldUnder
    VsPreview.FontSize = OldSize
    VsPreview.FontItalic = OldItalic
    VsPreview.FontBold = OldBold
    
    mbSetMainTitle = True
    Exit Function
    
ErrSetMainTitle:
    Screen.MousePointer = vbDefault
    mbSetMainTitle = False
    gShowMsg "设置打印主标题出错 frmPreview.mbSetMainTitle"
    
End Function

Private Function mbListVsFlex() As Boolean
'*********************************************
'
'列表VSFLEX内容到打印机
'
'**********************************************
    Dim left            As Double
    Dim X               As Double
    Dim Y1              As Double
    Dim Y               As Double
    Dim iSepLeft        As Double
    Dim iSepTop         As Double
    Dim OutText         As String
    Dim TmpOutText      As String
    Dim strOutText1     As String
    Dim i               As Integer
    Dim iStart          As Integer
    Dim iVBCRLF         As Integer
    Dim iLen            As Integer
    Dim iRows           As Integer
    Dim iRow            As Integer
    Dim iCol            As Integer
    
    On Error GoTo ErrListVsFlex
    
    '********************************************
    '计算字体高度
    
    VsPreview.FontName = gFontNameCon
    VsPreview.FontSize = gFontSizeCon
    VsPreview.FontBold = gbFontBoldCon
    VsPreview.FontUnderline = gbFontUnderCon
    VsPreview.FontItalic = gbFontItalicCon
    
    VsPreview.CalcText = "测试字高"
    gRowHeight = VsPreview.TextHei * 2
    
    
    mbSetNextColumn = True
    
    '线条同字间距离
    iSepLeft = gLeftCon
    iSepTop = gTopCon
    
    left = VsPreview.CurrentX
    mTop = VsPreview.CurrentY
    
    iRows = gvsfItemData.Rows - 1
    
    For iRow = 1 To iRows
        
        If mbNextPage(mTop) Then VsPreview.NewPage
        i = 0
        For iCol = 0 To gvsfItemData.Cols - 1 'gCols - 1
            
            If gvsfItemData.ColHidden(iCol) = False Then
                Call mDrawRect(left, mTop, gColWidth(i + 1), gRowHeight)
                X = left + iSepLeft
                
                '计算该字的长度符串是否超出
                TmpOutText = Trim(gvsfItemData.TextMatrix(iRow, iCol))
            
                iVBCRLF = IIf(IsNull(InStr(1, TmpOutText, vbLf, vbTextCompare)), 0, InStr(1, TmpOutText, vbLf, vbTextCompare))
                If iVBCRLF = 0 Then
                    OutText = TmpOutText
                    VsPreview.CalcText = OutText
                    If VsPreview.TextWid > gColWidth(i + 1) - iSepLeft * 2 Then
                    '若字符串长度大于列的宽度
                        iLen = Len(OutText)
                        For iStart = 1 To iLen
                            strOutText1 = Mid(OutText, 1, iLen - iStart)
                            VsPreview.CalcText = strOutText1
                            If VsPreview.TextWid <= gColWidth(i + 1) - iSepLeft * 2 Then Exit For
                        Next iStart
                        
                        '计算文字距表格线的距离
                        iSepTop = (gRowHeight - VsPreview.TextHei * 2) / 2
                        Y1 = mTop + iSepTop
                        '分两部分输出
                        strOutText1 = Mid(OutText, 1, iLen - iStart)
                        Call mWriteText(X, Y1, strOutText1)
                        strOutText1 = Mid(OutText, iLen - iStart + 1, iStart)
                        Y1 = Y1 + VsPreview.TextHei
                        Call mWriteText(X, Y1, strOutText1)
                    Else
                        iSepTop = (gRowHeight - VsPreview.TextHei) / 2
                        Y = mTop + iSepTop + 30
                        Call mWriteText(X, Y, OutText)
                    
                    End If
                Else
                    
                    OutText = Mid(TmpOutText, 1, iVBCRLF - 2)
                    VsPreview.CalcText = OutText
                    iSepTop = (gRowHeight - VsPreview.TextHei * 2) / 2
                    Y = mTop + iSepTop
                    Call mWriteText(X, Y, OutText)
                    OutText = Mid(TmpOutText, iVBCRLF + 1, Len(TmpOutText) - iVBCRLF)
                    Y = Y + VsPreview.TextHei '- 120
                    Call mWriteText(X, Y, OutText)
                End If
                left = left + gColWidth(i + 1)
                i = i + 1
            End If
        Next iCol
        left = VsPreview.Marginleft
        mTop = mTop + gRowHeight
        VsPreview.CurrentX = left
    Next iRow
    
    mbListVsFlex = True
    Exit Function
ErrListVsFlex:
    Screen.MousePointer = vbDefault
    mbListVsFlex = False
    gShowMsg "预览学生名单出错 frmPreview.mbListVsFlex"
    
End Function

Private Function mbListVsfString() As Boolean
'*********************************************
'
'列表VSFLEX内容到打印机
'
'**********************************************
    Dim left            As Double
    Dim X               As Double
    Dim Y1              As Double
    Dim Y               As Double
    Dim iSepLeft        As Double
    Dim iSepTop         As Double
    Dim OutText         As String
    Dim TmpOutText      As String
    Dim strOutText1     As String
    Dim i               As Integer
    Dim iStart          As Integer
    Dim iVBCRLF         As Integer
    Dim iLen            As Integer
    Dim iRows           As Integer
    Dim iRow            As Integer
    
    On Error GoTo ErrListVsfString
    
    '********************************************
    '计算字体高度
    
    VsPreview.FontName = gFontNameCon
    VsPreview.FontSize = gFontSizeCon
    VsPreview.FontBold = gbFontBoldCon
    VsPreview.FontUnderline = gbFontUnderCon
    VsPreview.FontItalic = gbFontItalicCon
    
    VsPreview.CalcText = "测试字高"
    gRowHeight = VsPreview.TextHei * 2
    
    
    mbSetNextColumn = True
    
    '线条同字间距离
    iSepLeft = gLeftCon
    iSepTop = gTopCon
    
    left = VsPreview.CurrentX
    mTop = VsPreview.CurrentY
    
    iRows = gvsfItemData.Rows - 1
    
    For iRow = 3 To iRows
        
        If mbNextPage(mTop) Then VsPreview.NewPage

        For i = 0 To gCols - 1
            Call mDrawRect(left, mTop, gColWidth(i + 1), gRowHeight)
            X = left + iSepLeft
            '计算该字的长度符串是否超出
            OutText = Trim(gvsfItemData.TextMatrix(iRow, i))
            
            VsPreview.CalcText = OutText
            iSepTop = (gRowHeight - VsPreview.TextHei) / 2
            Y = mTop + iSepTop + 30
            Call mWriteText(X, Y, OutText)

            left = left + gColWidth(i + 1)
        Next i
        left = VsPreview.Marginleft
        mTop = mTop + gRowHeight
        VsPreview.CurrentX = left
    Next iRow
    
    mbListVsfString = True
    Exit Function
ErrListVsfString:
    Screen.MousePointer = vbDefault
    mbListVsfString = False
    gShowMsg "预览学生名单出错 frmPreview.mbListVsfString"
    
End Function
Private Function mbPrintMuliVsf() As Boolean
'***************************************
'向打印机输出VSFLEX表格中的内容
'
    On Error GoTo ErrPrintMuliVsf
    
    mbBeginLine = False
    Screen.MousePointer = vbHourglass
    VsPreview.StartDoc
    VsPreview.FontName = gFontNameCon