clstext.cls

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

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsText"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"

Option Explicit
'**************************************************************
'*类模块名称：clsText
'*类模块说明：一段要字符串对象
'*
'*备注：
'*
'*作者：chlf78
'*日期：2002-03-17 20:29:45
'***************************************************************

Private Const ModalName = "clsText"

'*字符串的类型
Public Enum typeField
    tyText = 0
    tyNumeric = 1
    tyDateTime = 2
End Enum

'*字符串的对齐方式
Public Enum typeAlign
    tyLeft = 0
    tymiddle = 1
    tyRight = 2
End Enum

'*打印方向
Public Enum typeOrient
    Portrait = 1
    Landscape = 2
End Enum

Public stringX              As String               '*要打印的字符串
Public fieldtype            As typeField            '*字符串的类型

    Public showzero         As Boolean              '*是否显示0
    Public decimalnumber    As Integer              '*小数位数(-1表示不限制)
    Public usesperator      As Boolean              '*是否使用","作为分隔符
    
    '*备注：以上的属性只对数字生效，其它格式在网格控件中自行完成
    
Public Align                As typeAlign            '*对齐方式

Public drawBorder           As Boolean              '*是否绘制边框

Public FontName             As String               '*字体名
Public fontsize             As Single               '*字体大小
Public FontBold             As Boolean              '*粗体
Public FontItalic           As Boolean              '*斜体
Public FontUnderLine        As Boolean              '*下划线
Public FontStrikeThru       As Boolean              '*删除线

Public ForeColor            As Long                 '*字体颜色

Public autowrap             As Boolean              '*自动换行
Public autotrim             As Boolean              '*自动截断
                                                        '*说明:如果自动换行，则此属性不生效
                                                        '*如果是数字和日期，则此属性也不生效
                
                
Public width            As Single           '*可打印的宽度
Public height           As Single           '*可打印的高度
Public rowheight        As Single           '*一行的高度
    
Public left             As Single           '*打印的横向起始位置
Public Top              As Single           '*打印的竖向起始位置

Public tag              As String           '*存储额外信息

Private m_Orient        As typeOrient       '*打印方向（横向、竖向）

Public Property Get orient() As typeOrient
'*得到打印方向（横向、竖向）
    orient = m_Orient
End Property

Public Property Let orient(vData As typeOrient)
'*设置打印方向（横向、竖向）
    m_Orient = vData
End Property

Public Function GetWidth() As Single
'*得到此字符串的打印宽度
    GetWidth = CalWidth(GetStr, fontsize) + 2 * MYSPACE
End Function

Public Function GetHeight() As Single
'*得到此字符串的打印高度
    GetHeight = CalHeight(fontsize) + 2 * MYSPACE
End Function

Public Function GetWidthVer() As Single
'*得到此字符串的打印宽度（纵向）
    GetWidthVer = 2 * fontsize * 10 + 2 * MYSPACE
End Function

Public Function GetHeightVer() As Single
'*得到此字符串的打印高度（纵向）
    GetHeightVer = CalHeight(fontsize) * Len(stringX)
End Function


Public Function GetRows() As Integer
'*得到此字符串的打印行数
Dim str         As String

    str = GetStr
    
    '*对于数字类型，不换行
    '*如果不自动换行，则只输出一行
    '*如果没有字符串，则也只输出一行
    If fieldtype = tyNumeric _
        Or (Not autowrap) _
        Or Len(str) = 0 Then
        GetRows = 1
        Exit Function
    End If
    
'*计算所需的行数
Dim i           As Integer
Dim sWidth      As Single
Dim tWidth      As Single

    GetRows = 0
    sWidth = MYSPACE
    
    For i = 1 To Len(str)
        tWidth = CalWidth(Mid(str, i, 1), fontsize)
        If sWidth + tWidth + MYSPACE > width Then
            GetRows = GetRows + 1
            sWidth = MYSPACE + tWidth
        Else
            sWidth = sWidth + tWidth
        End If
    Next i
    
    GetRows = GetRows + 1
    
    '*如果超过允许的最大行数，则只输出MAXROWS
    If GetRows > MAXROWS Then
        GetRows = MAXROWS
    End If
    
    If GetRows = 0 Then
        GetRows = 1
    End If
End Function

Public Function GetStr() As String
'*得到格式化后的要输出的字符串
On Error GoTo err_proc

    GetStr = stringX
    
    If fieldtype = tyNumeric Then
        If usesperator Then
            GetStr = Format(stringX, "###,###,###,###,##0.0#########")
        End If
        '*重新决定小数位数
        Select Case decimalnumber
            Case -1
                '*不做处理
            Case 0
                '*无小数位
                GetStr = CLng(GetStr)
            Case Else
                If usesperator Then
                    GetStr = Format(stringX, _
                            "###,###,###,###,##0." _
                            & String(decimalnumber, "0"))
                Else
                    GetStr = Format(stringX, _
                            "##############0." _
                            & String(decimalnumber, "0"))
                End If
        End Select
        
        If Not showzero Then        '*如果不显示0
            If Abs(CDbl(GetStr)) < 0.000000001 Then
                GetStr = ""
            End If
        End If
    End If
    
    '*对于文本的自动截断处理
    If fieldtype = tyText Then
        If (Not autowrap) And autotrim Then
            Dim i           As Integer
            Dim sWidth      As Single
            Dim tmpStr      As String
            GetStr = ""
            For i = 1 To Len(stringX)
                sWidth = sWidth + CalWidth(Mid(stringX, i, 1), fontsize)
                If sWidth > width Then
                    Exit For
                End If
                GetStr = GetStr + Mid(stringX, i, 1)
            Next i
        End If
    End If
    
    Exit Function
    
err_proc:
    GetStr = ""
End Function


'**************************************************************
'*名称：Clone
'*功能：复制对象
'*传入参数：
'*      text        --目的对象
'*作者：chlf78
'*日期：2002-04-10 14:14:28
'***************************************************************
Public Sub Clone(text As clsText)

    With text
        .stringX = stringX
        .fieldtype = fieldtype
        .showzero = showzero
        .decimalnumber = decimalnumber
        .usesperator = usesperator
        .Align = Align
        .drawBorder = drawBorder
        .FontName = FontName
        .fontsize = fontsize
        .FontBold = FontBold
        .FontItalic = FontItalic
        .FontUnderLine = FontUnderLine
        .FontStrikeThru = FontStrikeThru
        .ForeColor = ForeColor
        .autowrap = autowrap
        .autotrim = autotrim
        .width = width
        .height = height
        .rowheight = rowheight
        .left = left
        .Top = Top
        .orient = m_Orient
    End With
   
End Sub


'**************************************************************
'*名称：Save
'*功能：保存到文件
'*传入参数：
'*      filename        --文件名
'*返回参数：
'*      是否保存成功
'*作者：chlf78
'*日期：2002-04-16 20:47:42
'***************************************************************
Public Function Save(FileName As String, section As String) As Boolean
    
    Save = SetIni(FileName, section, "stringx", CStr(stringX))
    Save = Save And SetIni(FileName, section, "fieldtype", CStr(fieldtype))
    Save = Save And SetIni(FileName, section, "showzero", CStr(showzero))
    Save = Save And SetIni(FileName, section, "decimalnumber", CStr(decimalnumber))
    Save = Save And SetIni(FileName, section, "usesperator", CStr(usesperator))