clstext.cls

超经典的打印预览动态库源码 版权： 本资源版权归作者所有 说明： 本资源由源码天空搜集,仅提供学习参考

    Save = Save And SetIni(FileName, section, "align", CStr(Align))
    Save = Save And SetIni(FileName, section, "drawborder", CStr(drawBorder))
    Save = Save And SetIni(FileName, section, "fontname", CStr(FontName))
    Save = Save And SetIni(FileName, section, "fontsize", CStr(fontsize))
    Save = Save And SetIni(FileName, section, "fontbold", CStr(FontBold))
    Save = Save And SetIni(FileName, section, "fontitalic", CStr(FontItalic))
    Save = Save And SetIni(FileName, section, "fontunderline", CStr(FontUnderLine))
    Save = Save And SetIni(FileName, section, "FontStrikethru", CStr(FontStrikeThru))
    Save = Save And SetIni(FileName, section, "foreColor", CStr(ForeColor))
    Save = Save And SetIni(FileName, section, "autowrap", CStr(autowrap))
    Save = Save And SetIni(FileName, section, "autotrim", CStr(autotrim))
    Save = Save And SetIni(FileName, section, "width", CStr(width))
    Save = Save And SetIni(FileName, section, "height", CStr(height))
    Save = Save And SetIni(FileName, section, "rowheight", CStr(rowheight))
    Save = Save And SetIni(FileName, section, "left", CStr(left))
    Save = Save And SetIni(FileName, section, "top", CStr(Top))
    Save = Save And SetIni(FileName, section, "tag", CStr(tag))
    Save = Save And SetIni(FileName, section, "orient", CStr(m_Orient))
End Function


'**************************************************************
'*名称：Read
'*功能：从文件中读取
'*传入参数：
'*      filename        --文件名
'*返回参数：
'*      是否读取成功
'*作者：chlf78
'*日期：2002-04-16 20:47:42
'***************************************************************
Public Function Read(FileName As String, section As String) As Boolean
    
    On Error GoTo err_proc
    
    stringX = GetIni(FileName, section, "stringx")
    fieldtype = CInt(GetIni(FileName, section, "fieldtype"))
    showzero = CBool(GetIni(FileName, section, "showzero"))
    decimalnumber = CInt(GetIni(FileName, section, "decimalnumber"))
    usesperator = CBool(GetIni(FileName, section, "usesperator"))
    Align = CInt(GetIni(FileName, section, "align"))
    drawBorder = CBool(GetIni(FileName, section, "drawborder"))
    FontName = GetIni(FileName, section, "fontname")
    fontsize = CSng(GetIni(FileName, section, "fontsize"))
    FontBold = CBool(GetIni(FileName, section, "fontbold"))
    FontItalic = CBool(GetIni(FileName, section, "fontitalic"))
    FontUnderLine = CBool(GetIni(FileName, section, "fontunderline"))
    FontStrikeThru = CBool(GetIni(FileName, section, "FontStrikethru"))
    ForeColor = CLng(GetIni(FileName, section, "foreColor"))
    autowrap = CBool(GetIni(FileName, section, "autowrap"))
    autotrim = CBool(GetIni(FileName, section, "autotrim"))
    width = CSng(GetIni(FileName, section, "width"))
    height = CSng(GetIni(FileName, section, "height"))
    rowheight = CSng(GetIni(FileName, section, "rowheight"))
    left = CSng(GetIni(FileName, section, "left"))
    Top = CSng(GetIni(FileName, section, "top"))
    tag = GetIni(FileName, section, "tag")
    m_Orient = CInt(GetIni(FileName, section, "orient"))
    Read = True
    Exit Function
    
err_proc:
    Read = False
End Function

'**************************************************************
'*名称：PrintIt
'*功能：输出此字符串
'*传入参数：
'*      obj     --要输出的对象
'*      sRate   --缩放比例
'*返回参数：
'*
'*作者：chlf78
'*日期：2002-03-17 21:09:51
'***************************************************************
Public Function PrintIt(obj As Object, sRate As Single)

On Error Resume Next

    '*画边框
    If drawBorder Then
        obj.DrawWidth = IIf(sRate < 1, 1, CInt(sRate))
        '*只绘制右边和底部的边框
        obj.Line (left * sRate, (Top + height) * sRate)-Step(width * sRate, 0), vbBlack 'foreColor
        obj.Line ((left + width) * sRate, Top * sRate)-Step(0, height * sRate), vbBlack ' foreColor
    End If
    
    '*设置输出对象的属性
    SetObj obj, sRate
    
    Dim rows    As Integer      '*总用行数
    
    rows = GetRows
    '*如果高度为0,设高度为GetHeight
    If height = 0 Then
        height = GetHeight
    End If
    '*如果行高为0，设行高为height
    If rowheight = 0 Then
        rowheight = height
    End If
    
    '*计算真正的输出竖向起始位置
    '*（因为有时候一行的其它列占用的行比本列的要多）
    Dim mTop    As Single
    mTop = Top
    If CInt(height / rowheight) > rows Then
        mTop = (height - rowheight * rows) / 2
    End If
    
    '*开始输出了....
    Dim i           As Integer
    Dim sWidth      As Single
    Dim tWidth      As Single
    Dim str         As String
    Dim tStr        As String
    Dim row         As Integer
    

    str = GetStr
    row = 0
    sWidth = MYSPACE
    
    '*如果是数值型，必须一次全部输出
    If fieldtype = tyNumeric Then
        PrintStr obj, 1, rows, str, sRate
        Exit Function
    End If
    
    
    For i = 1 To Len(str)
        tWidth = CalWidth(Mid(str, i, 1), fontsize)
        If sWidth + tWidth + MYSPACE > width Then     '*超出可打印宽度，新的一行
            row = row + 1
            If row > MAXROWS Then
                Exit Function
            End If
            
            '*输出此字符串
            PrintStr obj, row, rows, tStr, sRate
            
            If (Not autowrap) And i = 1 Then        '*如果不自动换行，则只输出一行
                
                Exit Function
            End If
            
            sWidth = MYSPACE + tWidth
            tStr = Mid(str, i, 1)
        Else                                        '*未超出宽度
            sWidth = sWidth + tWidth
            tStr = tStr & Mid(str, i, 1)
        End If
    Next i
    
    '*输出此字符串
    PrintStr obj, row + 1, rows, tStr, sRate
    
End Function

'**************************************************************
'*名称：PrintItVer
'*功能：输出此字符串（竖向）
'*传入参数：
'*      obj     --要输出的对象
'*      sRate   --缩放比例
'*返回参数：
'*
'*作者：chlf78
'*日期：2002-04-29 21:09:51
'***************************************************************
Public Function PrintItVer(obj As Object, sRate As Single)

'
    
    '*设置输出对象的属性
    SetObj obj, sRate
    
    Dim mstr            As String           '*当前要输出的字符
    Dim mTop            As Single           '*当前输出的Y位置
    Dim mWidth          As Single           '*当前每个字要占用的宽度（非汉字）
    Dim mHeight         As Single           '*每个字要占用的高度
    
    mHeight = CalHeight(fontsize)
    
    '*根据对齐方式决定输出的顶点位置
    Select Case Align
        Case tyLeft
            mTop = Top
        Case tymiddle
            mTop = Top + (height - mHeight * Len(stringX)) / 2
        Case tyRight
            mTop = Top + (height - mHeight * Len(stringX))
    End Select
    Dim i           As Integer
    For i = 1 To Len(stringX)
        '*输出
        mstr = Mid(stringX, i, 1)
        mWidth = CalWidth(mstr, fontsize)
        '*得到输出的左位置
        obj.CurrentX = (left + (width - mWidth) / 2) * sRate
        obj.CurrentY = mTop * sRate
        obj.Print Mid(stringX, i, 1)
        '*重新计算Y位置
        mTop = mTop + mHeight
    Next i
    
End Function

Private Sub PrintStr(obj As Object, row As Integer, rows As Integer, str As String, sRate As Single)
'*输出此行字符串
    '*  obj     --输出对象
    '*  row     --输出行数
    '*  rows    --总行数
    '*  str     --输出字符串
    '*  srate   --缩放比例
    Select Case Align
        Case tyLeft     '*左对齐
            obj.CurrentX = left + MYSPACE
        Case tymiddle   '*居中对齐
            obj.CurrentX = left + (width - CalWidth(str, fontsize)) / 2
        Case tyRight    '*右对齐
            obj.CurrentX = left + width - (CalWidth(str, fontsize) + MYSPACE)
    End Select

    
    obj.CurrentY = Top + (row - 1) * height / rows _
                   + (height / rows - CalHeight(fontsize)) / 2

    obj.CurrentX = obj.CurrentX * sRate
    obj.CurrentY = obj.CurrentY * sRate

    '*输出
    obj.Print str
End Sub


'**************************************************************
'*名称：SetObj
'*功能：设置输出对象属性
'*传入参数：
'*      obj             --输出对象
'*作者：chlf78
'*日期：2002-04-29 23:45:06
'***************************************************************
Private Sub SetObj(obj As Object, sRate As Single)

    On Error Resume Next
    With obj
        .FontName = FontName
        .fontsize = fontsize * sRate
        .FontBold = FontBold
        .FontItalic = FontItalic
        .FontUnderLine = FontUnderLine
        .FontStrikeThru = FontStrikeThru
        .ForeColor = ForeColor
    End With
End Sub



Private Sub Class_Initialize()
    '*初始化
    fieldtype = tyText
    Align = tyLeft
    showzero = True
    decimalnumber = -1
    usesperator = False
    
    FontName = "宋体"
    fontsize = 9
    ForeColor = vbBlack
    
    autowrap = True
    autotrim = False
    
    m_Orient = Landscape
End Sub