preview3.frm

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

    Dim i       As Integer
    
    VsPreview.DefaultDevice = True
    
    VsPreview.PaperSize = gPaperSize
    VsPreview.Orientation = gPaperDirect
    VsPreview.FontName = "宋体"
    VsPreview.FontSize = gFontSize

End Sub

Private Function mbSetColumnData() As Boolean
'*************************************************************
'设置各列标题和宽度
'取得标题和班级名称
    Dim iCount              As Integer
    Dim i                   As Integer
    Dim TmpFmt              As String
    Dim TmpHead             As String
    Dim iNum                As Integer
    Dim nums                As Integer
    Dim iStart              As Integer
    Dim TotalWidth          As Double
    
    On Error GoTo ErrSetColumnData
    
    iCount = Len(gFormatfields)
    iStart = 1
    For i = 1 To iCount
       If Mid(gFormatfields, i, 1) = ";" Then
            TmpFmt = Mid(gFormatfields, 1, i)
            TmpHead = Mid(gFormatfields, i + 1, iCount - i)
            Exit For
        End If
    Next i
    
    '取得各列宽度
    iCount = Len(TmpFmt)
    nums = 1
    iNum = 0
    iStart = 1
    TotalWidth = 0
    For i = 1 To iCount
        If Mid(TmpFmt, i, 1) = "|" Or Mid(TmpFmt, i, 1) = ";" Then
            gColWidth(nums) = CInt(Mid(TmpFmt, iStart + 2, iNum - 2))
            gAlign(nums) = Mid(TmpFmt, iStart + 1, 1)
            TotalWidth = TotalWidth + gColWidth(nums)
            nums = nums + 1
            iStart = iStart + iNum + 1
            iNum = 0
        Else
            iNum = iNum + 1
        End If
        
    Next i
    
    '总列数
    gCols = nums - 1
    
    '设定页边距
    
    If gAlignment = 1 Then
            VsPreview.Marginleft = gMargin.Marginleft
            VsPreview.MarginRight = gMargin.MarginRight
            VsPreview.MarginTop = gMargin.MarginTop
            VsPreview.MarginBottom = gMargin.MarginBottom
            
    ElseIf gAlignment = 2 Then
        If (VsPreview.PageWidth - TotalWidth) > (VsPreview.Marginleft + VsPreview.MarginRight) Then
            VsPreview.Marginleft = (VsPreview.PageWidth - TotalWidth) / 2
            VsPreview.MarginRight = VsPreview.Marginleft
        End If
    End If
    
    
    '取得各列标题
    iCount = Len(TmpHead)
    iNum = 0
    nums = 1
    iStart = 1
    For i = 1 To iCount
        If Mid(TmpHead, i, 1) = "|" Or Mid(TmpHead, i, 1) = ";" Then
            gSubHead(nums) = Mid(TmpHead, iStart, iNum)
            nums = nums + 1
            iStart = iStart + iNum + 1
            iNum = 0
        Else
            iNum = iNum + 1
        End If
    Next i
    
    mbSetColumnData = True
    Exit Function
    
ErrSetColumnData:
    Screen.MousePointer = vbDefault
    mbSetColumnData = False
    gShowMsg "设置各列标题内容出错 frmPreview.mbSetColumnData"
    
End Function

Private Function mbSetColumn() As Boolean
'*******************************************************
'显示标题
    Dim left                As Double
    Dim Top                 As Double
    Dim X                   As Double
    Dim Y                   As Double
    Dim iSepLeft            As Double
    Dim iSepTop             As Double
    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 iLen                As Integer
    Dim LfNum               As Double
    Dim OutText             As String
    Dim iStart              As String
    Dim iStep               As Integer
    On Error GoTo ErrSetColumn
        
    '保存字体信息
    OldName = VsPreview.FontName
    OldSize = VsPreview.FontSize
    OldItalic = VsPreview.FontItalic
    OldBold = VsPreview.FontBold
    OldUnder = VsPreview.FontUnderline
    
    VsPreview.FontName = gFontNameHead
    VsPreview.FontSize = gFontSizeHead
    VsPreview.FontBold = gbFontBoldHead
    VsPreview.FontUnderline = gbFontUnderHead
    VsPreview.FontItalic = gbFontItalicHead
'    VsPreview.X1 = VsPreview.CurrentX
'    VsPreview.Y1 = VsPreview.CurrentY
'    VsPreview.X2 = VsPreview.X1
'    VsPreview.Y2 = VsPreview.Y1
    VsPreview.CalcText = "测试字高"
    
    left = VsPreview.Marginleft
    Top = VsPreview.CurrentY + gTitleSep
    
    VsPreview.CalcText = "测试字高"
    gHeadHeight = VsPreview.TextHei * 2
    
    For i = 1 To gCols
    
        VsPreview.CalcText = gSubHead(i)
        LfNum = 1
        '该字段是否含有VBCRLF字符
        iStart = IIf(IsNull(InStr(1, gSubHead(i), vbLf, vbTextCompare)), 0, InStr(1, gSubHead(i), vbLf, vbTextCompare))
        If iStart = 0 Then
            iSepTop = (gHeadHeight - VsPreview.TextHei * LfNum) / 2
            iSepLeft = (gColWidth(i) - VsPreview.TextWid) / 2
            
            Call mDrawRect(left, Top, gColWidth(i), gHeadHeight)
            X = left + iSepLeft
            Y = Top + iSepTop + 30
            Call mWriteText(X, Y, gSubHead(i))
        Else
        '显示两行数据
            If InStr(1, gSubHead(i), vbLf, vbTextCompare) > 0 And InStr(1, gSubHead(i), vbCr, vbTextCompare) > 0 Then
                iStep = 2
            Else

                iStep = 1
            End If
            OutText = Mid(gSubHead(i), 1, iStart - iStep)
            VsPreview.CalcText = OutText
            iSepTop = (gHeadHeight - VsPreview.TextHei * 2) / 2
            
            iSepLeft = (gColWidth(i) - VsPreview.TextWid) / 2
            Call mDrawRect(left, Top, gColWidth(i), gHeadHeight)
            
            X = left + iSepLeft
            OutText = Mid(gSubHead(i), 1, iStart - iStep)
            Y = Top + iSepTop + 30
            Call mWriteText(X, Y, OutText)
            OutText = Mid(gSubHead(i), iStart + 1, Len(gSubHead(i)) - iStart)
            Y = Y + VsPreview.TextHei '- 120
            Call mWriteText(X, Y, OutText)
        End If
'        For iLen = 1 To Len(gSubHead(I))
'            If Mid(gSubHead(I), iLen, 1) = vbCr Then
'            ElseIf Mid(gSubHead(I), iLen, 1) = vbLf Then
'            '含有换行符
'                LfNum = LfNum + 1
'                vspreview.CalcText = Mid(gSubHead(I), iLen + 1, Len(gSubHead(I)) - iLen)
'            End If
'        Next iLen
        '计算表格中字符的TOP坐标
        
        left = left + gColWidth(i)
    Next i
    
    VsPreview.FontName = OldName
    VsPreview.FontSize = OldSize
    VsPreview.FontBold = OldBold
    VsPreview.FontUnderline = OldUnder
    VsPreview.FontItalic = OldItalic

    VsPreview.CurrentY = Y + VsPreview.TextHei + iSepTop - 30
    VsPreview.CurrentX = VsPreview.Marginleft
    mbSetColumn = True
    Exit Function
    
ErrSetColumn:
    Screen.MousePointer = vbDefault
    mbSetColumn = False
    gShowMsg "设置行标题出错 frmPreview.mbSetColumn"

End Function
Private Function mbSetClassTitle(index As Integer) As Boolean
'*******************************************
'显示标题
    Dim YearCode            As String
    Dim sSQL                As String
    Dim Rs                  As New ADODB.Recordset
    Dim OldName             As String
    Dim OldUnder            As Boolean
    Dim OldSize             As Integer
    Dim OldBold             As Boolean
    Dim OldItalic           As Boolean
    
    On Error GoTo ErrSetClassTitle
    
    '取得招生年份
    Screen.MousePointer = vbHourglass
    Rs.Open "Select YearCode from GxxZsYear where IsNew = 1", Cn
    Screen.MousePointer = vbDefault
    If Rs.EOF = False Then
        YearCode = Rs.Fields(0)
        Rs.Close
    Else
        YearCode = ""
        Rs.Close
    End If
    
'    '保存字体信息
'    OldSize = VsPreview.FontSize
'    OldItalic = VsPreview.FontItalic
'    OldBold = VsPreview.FontBold

    '保存字体信息
    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


    VsPreview.TextAlign = taCenterTop

    VsPreview.Text = YearCode & "年度" & gClassName(index) & "班学生名单"
    VsPreview.CalcText = gClassName(index)
    VsPreview.CurrentY = VsPreview.CurrentY + VsPreview.TextHei
    VsPreview.CurrentX = VsPreview.Marginleft
    VsPreview.TextAlign = taLeftTop
    
    '恢复字体信息
    '恢复字体信息
    VsPreview.FontName = OldName
    VsPreview.FontUnderline = OldUnder
    VsPreview.FontSize = OldSize
    VsPreview.FontItalic = OldItalic
    VsPreview.FontBold = OldBold
    
    VsPreview.X1 = VsPreview.CurrentX
    VsPreview.Y1 = VsPreview.CurrentY
    VsPreview.X2 = VsPreview.X1
    VsPreview.Y2 = VsPreview.Y1
    mbSetClassTitle = True
    
    Exit Function
ErrSetClassTitle:
    Screen.MousePointer = vbDefault
    mbSetClassTitle = False
    gShowMsg "显示主标题出错 "
    
End Function

Private Function mbSetClassData() As Boolean
'*********************************************
'读取班级信息
    Dim sSQL            As String
    Dim Rs              As New ADODB.Recordset
    Dim i               As Integer
    
    On Error GoTo ErrSetClassData
    
    sSQL = "Select ClassName from GxcClassXJ order by ClassCode"
    Screen.MousePointer = vbHourglass
    Rs.Open sSQL, Cn, adOpenKeyset
    Screen.MousePointer = vbDefault
    If Rs.EOF Then
        Rs.Close
        MsgBox "新生还没有分班，将列表所有的新生名单！！！", vbInformation + vbOKCancel, ""
        mbSetClassData = False
    End If
    
    ReDim gClassName(Rs.RecordCount) As String
    i = 0
    Do While Rs.EOF = False
        gClassName(i) = IIf(IsNull(Rs.Fields(0)), "", Rs.Fields(0))
        Rs.MoveNext
        i = i + 1
    Loop
    Rs.Close
    mbSetClassData = True
    Exit Function
    
ErrSetClassData:
    Screen.MousePointer = vbDefault
    mbSetClassData = False
    gShowMsg "读取班级信息错误 frmPreview.mbSetClassData"
    
End Function

Private Function mbSetMuliTitle() 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 ErrSetMuliTitle
    
    '保存字体信息
    OldName = VsPreview.FontName
    OldSize = VsPreview.FontSize
    OldItalic = VsPreview.FontItalic
    OldBold = VsPreview.FontBold
    OldUnder = VsPreview.FontUnderline
    
    VsPreview.FontName = gFontNameMuliTitle
    VsPreview.FontSize = gFontSizeMuliTitle
    VsPreview.FontBold = gbFontBoldMuliTitle
    VsPreview.FontItalic = gbFontItalicMuliTitle
    VsPreview.FontUnderline = gbFontUnderMuliTitle
        
    
    lColWidth = 0
    For i = 1 To gCols
        lColWidth = lColWidth + gColWidth(i)
    Next i
        
If gMidTitle <> "" Then
    '显示中标题
    VsPreview.CurrentX = VsPreview.Marginleft + lColWidth / 2 - VsPreview.TextWidth(gMidTitle) / 2
    VsPreview.TextAlign = taLeftTop
    VsPreview.Text = gMidTitle
    VsPreview.CalcText = gMidTitle
End If

    VsPreview.TextAlign = taLeftTop
    
    VsPreview.FontName = gFontNameCon
    VsPreview.FontSize = gFontSizeCon
    VsPreview.FontBold = gbFontBoldCon
    VsPreview.FontUnderline = gbFontUnderCon
    VsPreview.FontItalic = gbFontItalicCon
    
    
If gLeftTitle <> "" Then
    '左大标题
    VsPreview.CurrentY = VsPreview.CurrentY + VsPreview.TextHei
    VsPreview.CurrentX = VsPreview.Marginleft
    VsPreview.TextAlign = taLeftTop
    VsPreview.Text = gLeftTitle
    VsPreview.CalcText = gLeftTitle
    VsPreview.DrawLine VsPreview.Marginleft, VsPreview.CurrentY + VsPreview.TextHeight(gLeftTitle) + 25, VsPreview.Marginleft + VsPreview.TextWidth(gLeftTitle), VsPreview.CurrentY + VsPreview.TextHeight(gLeftTitle) + 25
End If

If gLeftTop <> "" Or gMidTop <> "" Or gRightTop <> "" Then
    '左标题
    VsPreview.CurrentY = VsPreview.CurrentY + VsPreview.TextHei + 150