VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsContent"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit
'**************************************************************
'*類模塊名稱：clsContent
'*類模塊說明：報表的正文對象
'*
'*備注：
'*      存入的單元格cell對象應該都已經知道了分頁屬性
'*      開始存入的單元格并不具備分行等特性
'*      所有和正文相關的操作都由本對象提供
'*
'*      所有涉及到行列的數組，列在前面，行在后面
'*作者：progame
'*日期：2002-04-01 19:55:41
'***************************************************************


Public page             As Integer              '*頁
Public cutpage          As Integer              '*分頁

Private dicMergeCell    As Dictionary           '*合并單元格
Private dicCell()       As Dictionary           '*按頁和分頁來存放合并單元格
Private colText()       As clsText              '*列的屬性設置

Private dicCurPage()    As Dictionary           '*當前頁的合并單元格存放

Private m_cols          As Integer              '*列數
Private m_rows          As Integer              '*行數
Private m_cutpages      As Integer              '*分頁總數

Private mergeCol()      As Boolean              '*合并列
Private mergeRow()      As Boolean              '*合并列

Private cells()         As clsCellNew           '*單元格數組

Private colHeight()     As Single               '*存入當前頁某列的累計高度
Private lstColHeight()  As Single               '*存入當前頁某列的未加入當前行的累計高度

Private dicPageHeight   As Dictionary           '*存入頁的正文高度

'*分頁完成進度
Public Event InitProgress(Value As Integer)

'*打印輸出的完成進度
Public Event PrintProgress(Value As Integer)

Friend Function GetMergeCell(page As Integer, cutpage As Integer) As Dictionary
'*對于內部提供合并單元格集合
    Set GetMergeCell = dicCell(page, cutpage)
End Function

Public Function GetText(col As Integer, row As Integer) As clsCellNew
'*取得列頭單元格中的字符串對象
    If m_rows = 0 Or m_cols = 0 Then
        Set GetText = Nothing
    End If
    
    Set GetText = cells(col, row)
    
End Function

Public Function GetColText(col As Integer) As clsText
'*取得列設置
    If m_rows = 0 Or m_cols = 0 Then
        Set GetColText = Nothing
    End If
    
    Set GetColText = colText(col)
    
End Function

Public Function GetMergeCol(col As Integer) As Boolean
'*取得此列是否合并
    On Error Resume Next
    
    GetMergeCol = False
    GetMergeCol = mergeCol(col)
    
End Function

Public Property Get Cols() As Integer

    Cols = m_cols
    
End Property

Public Property Get rows() As Integer

    rows = m_rows
    
End Property

'**************************************************************
'*名稱：SetColRows
'*功能：設置列數和行數
'*傳入參數：
'*      cols        --列數
'*      rows        --行數
'*返回參數：
'*      設置是否成功
'*作者：progame
'*日期：2002-03-27 16:08:34
'***************************************************************
Public Function SetColRows(Cols As Integer, rows As Integer) As Boolean

    If Cols < 1 Or rows < 1 Then
        SetColRows = False
    End If
    
On Error GoTo err_proc

    ReDim Preserve cells(1 To Cols, 1 To rows)
    ReDim Preserve mergeCol(1 To Cols)
    ReDim Preserve colText(1 To Cols)
    
    ReDim colHeight(1 To Cols)
    ReDim lstColHeight(1 To Cols)
    
    m_cols = Cols
    m_rows = rows
    m_cutpages = cells(m_cols, m_rows).cutpage
    
    SetColRows = True
    Exit Function
    
err_proc:
    SetColRows = False
    
End Function


'**************************************************************
'*名稱：SetCell
'*功能：設置一個單元格的值
'*傳入參數：
'*      col     --列
'*      row     --行
'*      cell    --單元
'*返回參數：
'*
'*作者：progame
'*日期：2002-03-27 16:15:00
'***************************************************************
Public Function SetCell(cell As clsCellNew) As Boolean
    
    On Error GoTo err_proc
    
    Set cells(cell.colFrom, cell.rowFrom) = cell
    
    SetCell = True
    Exit Function
    
'*錯誤處理
err_proc:
    SetCell = False
    
End Function


'**************************************************************
'*名稱：SetColText
'*功能：設置列的屬性
'*傳入參數：
'*      col         --列
'*      text        --列設置
'*返回參數：
'*
'*作者：progame
'*日期：2002-04-19 10:09:21
'***************************************************************
Public Function SetColText(col As Integer, text As clsText) As Boolean

    On Error GoTo err_proc
    
    Set colText(col) = text
    
    SetColText = True
    Exit Function
    
'*錯誤處理
err_proc:
    SetColText = False
    
End Function



'**************************************************************
'*名稱：SetMergeCol
'*功能：設置要合并的列
'*傳入參數：
'*      col     --列值
'*      ifmerge --是否需要合并
'*返回參數：
'*      設置是否成功
'*作者：progame
'*日期：2002-03-27 22:54:58
'***************************************************************
Public Function SetMergeCol(col As Integer, IfMerge As Boolean) As Boolean

    If col < 1 Or col > m_cols Then
        SetMergeCol = False
        Exit Function
    End If
    
    '*設置
    mergeCol(col) = IfMerge
    SetMergeCol = True
    
End Function
'**************************************************************
'*名稱：SetMergeCol
'*功能：設置要合并的列
'*傳入參數：
'*      col     --列值
'*      ifmerge --是否需要合并
'*返回參數：
'*      設置是否成功
'*作者：progame
'*日期：2002-03-27 22:54:58
'***************************************************************
Public Function SetMergerow(row As Integer, IfMerge As Boolean) As Boolean

    If row < 1 Or row > m_rows Then
        SetMergerow = False
        Exit Function
    End If
    
    '*設置
    mergeRow(row) = IfMerge
    SetMergerow = True
    
End Function


Public Function GetPages() As Integer
'*得到總頁數
    GetPages = dicPageHeight.Count
End Function

'**************************************************************
'*名稱：GetWidth
'*功能：得到分頁的寬度
'*傳入參數：
'*      cutpage         --分頁
'*返回參數：
'*      此分頁的正文輸出寬度
'*作者：progame
'*日期：2002-04-05 15:26:38
'***************************************************************
Public Function GetWidth(cutpage As Integer) As Single
Dim cell

    On Error Resume Next
    
    GetWidth = 0
    
    For Each cell In dicCell(1, cutpage).Items
        With cell
            If .rowFrom = 1 Then
                GetWidth = GetWidth + .text.width
            End If
        End With
    Next
    
End Function


'**************************************************************
'*名稱：PrintIt
'*功能：輸出正文
'*傳入參數：
'*      obj     --要輸出的對象
'*      page    --頁數
'*      cutpage --分頁數
'*      left    --正文輸出的左起點
'*      top     --正文輸出的頂起點
'*      sRate   --縮放比例
'*返回參數：
'*
'*作者：progame
'*日期：2002-04-04 20:27:51
'***************************************************************
Public Function PrintIt(obj As Object, page As Integer, cutpage As Integer, _
                        Left As Single, Top As Single, sRate As Single)

Dim cell
Dim ForeColor       As OLE_COLOR
Dim cText           As clsText

    If dicCell(page, cutpage).Count > 0 Then
        '*得到線寬和顏色
        obj.DrawWidth = IIf(sRate < 1, 1, CInt(sRate))
        ForeColor = vbBlack 'cText.foreColor
        
        '*繪制整個區域的左邊框和頂部邊框
        obj.Line (Left * sRate, Top * sRate)-Step(GetWidth(cutpage) * sRate, 0), ForeColor
        obj.Line (Left * sRate, Top * sRate)-Step(0, GetHeight(page) * sRate), ForeColor
    End If
    
    For Each cell In dicCell(page, cutpage).Items
    
        With cell
            Set cText = colText(cell.colFrom)
            
            cText.stringX = .stringX
            cText.Left = Left + cText.Left
            cText.Top = Top + cell.Top
            cText.height = .height
            
            '*輸出
            cText.PrintIt obj, sRate

            '*恢復設置
            cText.Left = cText.Left - Left

        End With
        
    Next
    
End Function


'**************************************************************
'*名稱：GetHeight
'*功能：得到正文的高度
'*傳入參數：
'*      page            --頁數
'*返回參數：
'*      此頁的正文高度
'*作者：progame
'*日期：2002-04-05 15:35:54
'***************************************************************