preview3.frm

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

    VsPreview.FontSize = gFontSizeCon
    VsPreview.FontBold = gbFontBoldCon
    VsPreview.FontItalic = gbFontItalicCon
    
    VsPreview.HdrFontSize = VsPreview.FontSize - 1
    VsPreview.HdrFontBold = False
    VsPreview.Footer = "|第 %d 页|"
    mbBeginLine = True
    
    '显示主标题
    If mbSetMainTitle() = False Then mbPrintMuliVsf = False: Exit Function
    
    '设置子标题
    If mbSetMuliTitle() = False Then mbPrintMuliVsf = False: Exit Function

    '设置列标题
    If mbSetColumn() = False Then mbPrintMuliVsf = False: Exit Function
    
    '列表内容
    If mbListVsFlex() = False Then mbPrintMuliVsf = False: Exit Function
    
    '设置尾注
    If mbSetFootTitle = False Then mbPrintMuliVsf = False: Exit Function
    
    VsPreview.EndDoc
    Screen.MousePointer = vbDefault
    mbPrintMuliVsf = True
    Exit Function
ErrPrintMuliVsf:
    Screen.MousePointer = vbDefault
    mbPrintMuliVsf = True
    gShowMsg "打印MuliVSF表格内容出错 frmPreview.mbPrintMulivsf"

End Function

Private Function mbPrintVsf() As Boolean
'***************************************
'向打印机输出VSFLEX表格中的内容
'
    On Error GoTo ErrPrintVsf
    
    mbBeginLine = False
    Screen.MousePointer = vbHourglass
    VsPreview.StartDoc
    VsPreview.FontName = gFontNameCon
    VsPreview.FontSize = gFontSizeCon
    VsPreview.FontBold = gbFontBoldCon
    VsPreview.FontItalic = gbFontItalicCon
    
    VsPreview.HdrFontSize = VsPreview.FontSize - 1
    VsPreview.HdrFontBold = False
    VsPreview.Footer = "|第 %d 页|"
    mbBeginLine = True
    
    '显示主标题
    If mbSetMainTitle() = False Then mbPrintVsf = False: Exit Function
    
    '设置列标题
    If mbSetColumn() = False Then mbPrintVsf = False: Exit Function
    
    '列表内容
    If mbListVsFlex() = False Then mbPrintVsf = False: Exit Function
    
    VsPreview.EndDoc
    Screen.MousePointer = vbDefault
    mbPrintVsf = True
    Exit Function
ErrPrintVsf:
    Screen.MousePointer = vbDefault
    mbPrintVsf = True
    gShowMsg "打印VSF表格内容出错 frmPreview.mbPrint.vsf"

End Function

Private Function mbPrintSt() As Boolean
'**********************************************
'向打印机输出班级学生
    Dim i               As Integer
    Dim Upper           As Integer
                    
    
    Upper = UBound(gClassName)
    mbBeginLine = False
    Screen.MousePointer = vbHourglass
    VsPreview.StartDoc
    
    VsPreview.FontName = gFontNameCon
    VsPreview.FontSize = gFontSizeCon
    VsPreview.FontBold = gbFontBoldCon
    VsPreview.FontItalic = gbFontItalicCon
    
    VsPreview.HdrFontSize = VsPreview.FontSize - 1
    VsPreview.HdrFontBold = False
    VsPreview.Footer = "|第 %d 页|"
    
    
'    VsPreview.FontName = "宋体"
'
'    VsPreview.HdrFontSize = VsPreview.FontSize - 1
'    VsPreview.HdrFontBold = False
'    VsPreview.Footer = "|第 %d 页|"
    
    mbBeginLine = True
    '显示主标题
    If mbSetClassTitle(0) = False Then mbPrintSt = False: Exit Function
    
     '设置列标题
    If mbSetColumn() = False Then mbPrintSt = False: Exit Function

    '列表学生名单
    If mbPreviewStudent(0) = False Then mbPrintSt = False: Exit Function
    
    For i = 1 To Upper - 1
        
        mbSetNextColumn = False
        
        VsPreview.NewPage

        '显示主标题
        If mbSetClassTitle(i) = False Then mbPrintSt = False: Exit Function
        
         '设置列标题
        If mbSetColumn() = False Then mbPrintSt = False: Exit Function
    
        '列表学生名单
        If mbPreviewStudent(i) = False Then mbPrintSt = False: Exit Function
    Next i
    
    

    VsPreview.EndDoc
    Screen.MousePointer = vbDefault
    mbPrintSt = True
    Exit Function
    
ErrPrintSt:
    Screen.MousePointer = vbDefault
    mbPrintSt = False
    gShowMsg "打印学生信息出错 frmPreview.mbPrintSt"
    
End Function

'Private Function mbPreviewNextClass() As Boolean
''*****************************************************
''预览下一个班级数据
'    Dim Upper           As Integer
'
'    Upper = UBound(gClassName)
'    If Upper = mIndex Then
'        mbPreviewNextClass = False
'    Else
'        mIndex = mIndex + 1
'        mbSetNextColumn = False
'        vspreview.NewPage
'
'        '显示主标题
'        If mbSetClassTitle(mIndex) = False Then mbPreviewNextClass = False: Exit Function
'
'         '设置列标题
'        If mbSetColumn() = False Then mbPreviewNextClass = False: Exit Function
'
'        '列表学生名单
'        If mbPreviewStudent(mIndex) = False Then mbPreviewNextClass = False: Exit Function
'
'    End If
'
'    mbPreviewNextClass = True
'
'End Function

Private Function mbNextPage(Y As Double) As Boolean
'*************************************************
'是否已经满一页
    Dim iLeft               As Double
    
    iLeft = VsPreview.PageHeight - Y - VsPreview.MarginBottom - gRowHeight
    
    If iLeft >= 0 Then
    '还没有满一页
        mbNextPage = False
    Else
        mbNextPage = True
    End If
    
End Function

Private Function mbPreviewStudent(index As Integer) As Boolean
'********************************************************************]
'读取学生资料
    Dim sSQL            As String
    Dim Rs              As New ADODB.Recordset
    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 strOutText1     As String
    Dim i               As Integer
    Dim iStart          As Integer
    Dim iLen            As Integer
    
    On Error GoTo ErrPreviewStudent
    
    '********************************************
    '计算字体高度
    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
    
    sSQL = "Select School_num,StName,BirthPlace,Sex,BirthDay,PostSchool,TotalMark,HomeAdd,OtherMemo  from GxxNewSt S left join GxcClassXJ C on S.ClassCode = C.ClassCode where C.ClassName = '" & gClassName(index) & "' order by S.ClassCode ASC "
    Screen.MousePointer = vbHourglass
    Rs.Open sSQL, Cn, adOpenKeyset
    Screen.MousePointer = vbDefault
    
    left = VsPreview.CurrentX
    mTop = VsPreview.CurrentY
    
    Do While Rs.EOF = False
        For i = 0 To gCols - 1
            
            If mbNextPage(mTop) Then VsPreview.NewPage
            
            Call mDrawRect(left, mTop, gColWidth(i + 1), gRowHeight)
            X = left + iSepLeft
            '计算该字的长度符串是否超出
            If i = 4 Then
                OutText = IIf(IsNull(Rs.Fields(i)), "", Format(Rs.Fields(i), "yyyy-mm-dd"))
            Else
                OutText = IIf(IsNull(Rs.Fields(i)), "", Rs.Fields(i))
            End If
            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
            left = left + gColWidth(i + 1)
        Next i
        Rs.MoveNext
        left = VsPreview.Marginleft
        mTop = mTop + gRowHeight
    Loop
    Rs.Close
    
    mbPreviewStudent = True
    Exit Function
ErrPreviewStudent:
    Screen.MousePointer = vbDefault
    mbPreviewStudent = False
    gShowMsg "预览学生名单出错 frmPreview.mbPreviewStudent"

End Function


Private Function mbPrintStudent() As Boolean
'*************************************************
'打印学生班级名单
    Dim sSQL                As String
    Dim Rs                  As New ADODB.Recordset
    Dim iCount          As Integer
    Dim i               As Integer
    Dim TmpFmt          As String
    Dim TmpHead         As String
    Dim strBody         As String
    Dim tmpContent      As String
    Dim ClassName       As String
    Dim iRow            As Integer
    Dim Upper           As Integer
    Dim iCol                    As Integer
    Dim ColWidth(1 To 50)      As Integer
    
    On Error GoTo ErrPrintStudent
    
    '读取标题和列宽内容
    If mbSetColumnData() = False Then mbPrintStudent = False: Exit Function
    
    '读取班级信息
    If mbSetClassData() = False Then mbPrintStudent = False: Exit Function
        
    Timer1.Enabled = True
        
'    mbBeginLine = False
'    vspreview.StartDoc
'    vspreview.FontName = "宋体"
'    mbBeginLine = True
'
'    For I = 0 To Upper - 1
'
'        mbSetNextColumn = False
'
'        vspreview.NewPage
'
'        '设置主标题
'        If mbSetClassTitle(I) = False Then mbPrintStudent = False: Exit Function
'
'        '设置列标题
'        If mbSetColumn() = False Then mbPrintStudent = False: Exit Function
'
'        '列表学生名单
'        If mbPreviewStudent(I) = False Then mbPrintStudent = False: Exit Function
'
'    Next I
'
'    vspreview.EndDoc
    mbPrintStudent = True
    Exit Function
ErrPrintStudent:
    Screen.MousePointer = vbDefault
    mbPrintStudent = False
    mbBeginLine = False
    mbEndLine = True
    gShowMsg "打印学生名单出错: frmPreview.mbPrint"

End Function


''Private Function mbSetFirstPreview() As Boolean
''首次显示时——延迟显示数据
''
''    If VsPreview.PaperSize = pprUser Then
''        VsPreview.PageHeight = gMMtoTwip(268)
''        VsPreview.PageWidth = gMMtoTwip(194)
''    End If
''
''    If gDataSourceType = abSelect Then
''        mbSetFirstPreview = mbPrintStudent
''    ElseIf gDataSourceType = abVsf Then
''        mbSetFirstPreview = mbPrintVsfFirst
''    ElseIf gDataSourceType = abLvw Then
''        mbSetFirstPreview = mbPrintLvwFirst
''    ElseIf gDataSourceType = abDB Then
''        mbSetFirstPreview = mbPrintDBFirst
''    End If
''
''End Function

Private Function mbPrintMuliVsfFirst() As Boolean
'****************************************************
'
'首次打印MuliVsFlex表格
'
'**************************************************

If mbSetColumnData() = False Then mbPrintMuliVsfFirst = False: Exit Function
    Timer1.Enabled = True
    mbPrintMuliVsfFirst = True
End Function

Private Function mbPrintVsfFirst() As Boolean
'****************************************************
'
'首次打印VsFlex表格
'
'**************************************************
    
    If mbSetColumnData() = False T