print.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "ClsPrint"
Attribute VB_GlobalNameSpace = True
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'数据来源
Public Enum DataSourceType
    abLvw = 1       'ListView
    abVsf = 2       'vsFlexGrid
    abString = 3       'String
    abDB = 4            '结果集
    abSelect = 5        '语句
    abVsfString = 6     '特殊表格
    abMuliVsf = 7       '多标题
    
End Enum

'预览、打印格式类型
Public Enum DefPrintStyle
    
    abNomal = 14
    abMuliHeaders = 15
    abText = 16
    abTodayIncome = 17
    abTodayLeave = 18
    abTomorrowLeave = 19
    abNight = 20
    abChangeWork = 21
    abTodayAnaly = 22
    
End Enum

'纸张打印方向
Public Enum DefPaperDirect
    abHD = 0            '纵向
    abVD = 1            '横向
End Enum


Public Property Let iTitle(ByVal vNewValue As String)
    gTitle = vNewValue
End Property

Public Property Let iLeftTop(ByVal vNewValue As String)
    gLeftTop = vNewValue
End Property

Public Property Let iMidTop(ByVal vNewValue As String)
    gMidTop = vNewValue
End Property

Public Property Let iRightTop(ByVal vNewValue As String)
    gRightTop = vNewValue
End Property
Public Property Let iPaperDirect(ByVal vNewValue As DefPaperDirect)
    gPaperDirect = vNewValue
End Property

Public Property Let iDataSourceType(ByVal vNewValue As DataSourceType)
    gDataSourceType = vNewValue
End Property

Public Property Set SetDataSource(ByVal vNewValue As Variant)
    
    If gDataSourceType = abLvw Then
        Set glvwItemData = vNewValue
    ElseIf gDataSourceType = abVsf Or gDataSourceType = abVsfString Or gDataSourceType = abMuliVsf Then
        Set gvsfItemData = vNewValue
    ElseIf gDataSourceType = abDB Then
        Set gRs = vNewValue
    
    End If
    
End Property

Public Property Set ConnectDB(ByVal CnDb As ADODB.Connection)
    Set Cn = CnDb
End Property

Public Sub ShowMain()
    frmPreview.Show 1
End Sub

Public Property Let iFormatFields(ByVal vNewValue As String)
    gFormatfields = vNewValue
End Property
Public Property Let iLeftBottom(ByVal vNewValue As String)
    
    gLeftBottom = vNewValue
    
End Property

Public Property Let iFontSize(ByVal vNewValue As String)
    
    gFontSize = vNewValue
    
End Property

Public Property Let iMidBottom(ByVal vNewValue As Variant)

    gMidBottom = vNewValue
    
End Property

Public Property Let iRightBottom(ByVal vNewValue As Variant)

    gRightBottom = vNewValue
    
End Property

Public Property Let iPaperSize(ByVal vNewValue As String)
    gPaperSize = vNewValue
End Property

Public Property Let iHeadHeight(ByVal vNewValue As String)
    gHeadHeight = vNewValue
End Property

Public Property Let iRowHeight(ByVal vNewValue As String)
    gRowHeight = vNewValue
End Property
Private Sub Class_Initialize()
    
    Dim WindowsPath         As String
    Dim tempValue           As String
    
    WindowsPath = mGetWindowsPath & "\gxwh.ini"
    
'*****************设置打印窗口的页边距
    tempValue = mGetValues("SetPage", "MarginBottom", WindowsPath)
    If tempValue = "" Then
        gMargin.MarginBottom = 1080
    Else
        gMargin.MarginBottom = Val(tempValue)
    End If
    
    tempValue = mGetValues("SetPage", "MarginTop", WindowsPath)
    If tempValue = "" Then
        gMargin.MarginTop = 1080
    Else
        gMargin.MarginTop = Val(tempValue)
    End If
    
    tempValue = mGetValues("SetPage", "Marginleft", WindowsPath)
    If tempValue = "" Then
        gMargin.Marginleft = 720
    Else
        gMargin.Marginleft = Val(tempValue)
    End If
    
    tempValue = mGetValues("SetPage", "MarginRight", WindowsPath)
    If tempValue = "" Then
        gMargin.MarginRight = 720
    Else
        gMargin.MarginRight = Val(tempValue)
    End If
    
'********对齐方式
    tempValue = mGetValues("SetPage", "Alignment", WindowsPath)
    If tempValue = "" Then
        gAlignment = 1
    Else
        gAlignment = Val(tempValue)
    End If
        
    gPrintStyle = abNomal
    gLeftTop = ""
    gMidTop = ""
    gRightTop = ""
    gLeftBottom = ""
    gMidBottom = ""
    gRightBottom = ""
    gTitle = ""
    gSubTitle = ""
    gMidTitle = ""
    gLeftTitle = ""
    gMuliHeaders = ""
    gTagInfo = ""
    gFontSize = 9
    
    '字段标题高度
    gHeadHeight = 600
    '行高度
    gRowHeight = 400
    '缺省纸张
    gPaperSize = pprA4
    '纸张打印方向
    gPaperDirect = abHD
    
    
    '设置字体信息
    
'**************设置主标题字体信息
    tempValue = mGetValues("Title1", "FontName", WindowsPath)
    If tempValue = "" Then
        gFontNameTitle = "宋体"
    Else
        gFontNameTitle = tempValue
    End If
    
    '主标题字体大小
    tempValue = mGetValues("Title1", "FontSize", WindowsPath)
    If tempValue = "" Then
        gFontSizeTitle = 20
    Else
        gFontSizeTitle = Val(tempValue)
    End If
        
    '主标题是否斜体
    tempValue = mGetValues("Title1", "FontItalic", WindowsPath)
    If tempValue = "" Then
        gbFontItalicTitle = False
    Else
        gbFontItalicTitle = CBool(tempValue)
    End If
        
    '主标题是否带下划线
    tempValue = mGetValues("Title1", "FontUnderLine", WindowsPath)
    If tempValue = "" Then
        gbFontUnderTitle = False
    Else
        gbFontUnderTitle = CBool(tempValue)
    End If
    
    '主标题是否粗体
    tempValue = mGetValues("Title1", "FontBold", WindowsPath)
    If tempValue = "" Then
        gbFontBoldTitle = True
    Else
        gbFontBoldTitle = CBool(tempValue)
    End If

'**************设置子标题字体信息
    tempValue = mGetValues("MuliTitle", "FontName", WindowsPath)
    If tempValue = "" Then
        gFontNameMuliTitle = "宋体"
    Else
        gFontNameMuliTitle = tempValue
    End If
    
    '主标题字体大小
    tempValue = mGetValues("MuliTitle", "FontSize", WindowsPath)
    If tempValue = "" Then
        gFontSizeMuliTitle = 12
    Else
        gFontSizeMuliTitle = Val(tempValue)
    End If
        
    '主标题是否斜体
    tempValue = mGetValues("MuliTitle", "FontItalic", WindowsPath)
    If tempValue = "" Then
        gbFontItalicMuliTitle = False
    Else
        gbFontItalicMuliTitle = CBool(tempValue)
    End If
        
    '主标题是否带下划线
    tempValue = mGetValues("MuliTitle", "FontUnderLine", WindowsPath)
    If tempValue = "" Then
        gbFontUnderMuliTitle = False
    Else
        gbFontUnderMuliTitle = CBool(tempValue)
    End If
    
    '主标题是否粗体
    tempValue = mGetValues("MuliTitle", "FontBold", WindowsPath)
    If tempValue = "" Then
        gbFontBoldMuliTitle = True
    Else
        gbFontBoldMuliTitle = CBool(tempValue)
    End If
    
'********************设置尾注字体信息
    tempValue = mGetValues("FootTitle", "FontName", WindowsPath)
    If tempValue = "" Then
        gFontNameFootTitle = "宋体"
    Else
        gFontNameFootTitle = tempValue
    End If
    
    '主标题字体大小
    tempValue = mGetValues("FootTitle", "FontSize", WindowsPath)
    If tempValue = "" Then
        gFontSizeFootTitle = 9
    Else
        gFontSizeFootTitle = Val(tempValue)
    End If
        
    '主标题是否斜体
    tempValue = mGetValues("FootTitle", "FontItalic", WindowsPath)
    If tempValue = "" Then
        gbFontItalicFootTitle = False
    Else
        gbFontItalicFootTitle = CBool(tempValue)
    End If
        
    '主标题是否带下划线
    tempValue = mGetValues("FootTitle", "FontUnderLine", WindowsPath)
    If tempValue = "" Then
        gbFontUnderFootTitle = False
    Else
        gbFontUnderFootTitle = CBool(tempValue)
    End If
    
    '主标题是否粗体
    tempValue = mGetValues("FootTitle", "FontBold", WindowsPath)
    If tempValue = "" Then
        gbFontBoldFootTitle = False
    Else
        gbFontBoldFootTitle = CBool(tempValue)
    End If
    
'**************设置标题头字体信息
    tempValue = mGetValues("Head", "FontName", WindowsPath)
    If tempValue = "" Then
        gFontNameHead = "宋体"
    Else
        gFontNameHead = tempValue
    End If
    
    '字体大小
    tempValue = mGetValues("Head", "FontSize", WindowsPath)
    If tempValue = "" Then
        gFontSizeHead = 10
    Else
        gFontSizeHead = Val(tempValue)
    End If
        
    '斜体
    tempValue = mGetValues("Head", "FontItalic", WindowsPath)
    If tempValue = "" Then
        gbFontItalicHead = False
    Else
        gbFontItalicHead = CBool(tempValue)
    End If
        
    '下划线
    tempValue = mGetValues("Head", "FontUnderLine", WindowsPath)
    If tempValue = "" Then
        gbFontUnderHead = False
    Else
        gbFontUnderHead = CBool(tempValue)
    End If
    
    '粗体
    tempValue = mGetValues("Head", "FontBold", WindowsPath)
    If tempValue = "" Then
        gbFontBoldHead = True
    Else
        gbFontBoldHead = CBool(tempValue)
    End If

'*****************设置正文字体信息
    tempValue = mGetValues("Content", "FontName", WindowsPath)
    If tempValue = "" Then
        gFontNameCon = "宋体"
    Else
        gFontNameCon = tempValue
    End If
    
    '字体大小
    tempValue = mGetValues("Content", "FontSize", WindowsPath)
    If tempValue = "" Then
        gFontSizeCon = 9
    Else
        gFontSizeCon = CInt(tempValue)
    End If
        
    '斜体
    tempValue = mGetValues("Content", "FontItalic", WindowsPath)
    If tempValue = "" Then
        gbFontItalicCon = False
    Else
        gbFontItalicCon = CBool(tempValue)
    End If
        
    '下划线
    tempValue = mGetValues("Content", "FontUnderLine", WindowsPath)
    If tempValue = "" Then
        gbFontUnderCon = False
    Else
        gbFontUnderCon = CBool(tempValue)
    End If
    
    '粗体
    tempValue = mGetValues("Content", "FontBold", WindowsPath)
    If tempValue = "" Then
        gbFontBoldCon = False
    Else
        gbFontBoldCon = CBool(tempValue)
    End If

'****************设置其他选项
    '正文单元格左边距
    tempValue = mGetValues("SetPage", "LeftCon", WindowsPath)
    If tempValue = "" Then
        gLeftCon = 80
    Else
        gLeftCon = Val(tempValue)
    End If
    
    '正文单元格上边距
    tempValue = mGetValues("SetPage", "TopCon", WindowsPath)
    If tempValue = "" Then
        gTopCon = 30
    Else
        gTopCon = Val(tempValue)
    End If
    
    '标题同正文之间的间距
    tempValue = mGetValues("SetPage", "TitleSep", WindowsPath)
    If tempValue = "" Then
        gTitleSep = 300
    Else
        gTitleSep = Val(tempValue)
    End If
    


    
    
End Sub

Public Property Let MuliHeaders(ByVal vNewValue As String)
    gMuliHeaders = vNewValue
End Property

Public Property Let PrintStyle(ByVal vNewValue As DefPrintStyle)
    gPrintStyle = vNewValue
End Property

Public Property Let TagDesc(ByVal vNewValue As String)
    gTagInfo = vNewValue
End Property

Public Property Let iLeftTitle(ByVal vNewValue As String)
    gLeftTitle = vNewValue
End Property


Public Property Let iMidTitle(ByVal vNewValue As String)
    gMidTitle = vNewValue
End Property

Public Property Get iSubTitle() As Variant

End Property

Public Property Let iSubTitle(ByVal vNewValue As Variant)
        gSubTitle = vNewValue
End Property

Public Property Get iMemoBottom() As String

End Property

Public Property Let iMemoBottom(ByVal sNewValue As String)
    gMemoBottom = sNewValue
End Property