freecellset.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 = "FreeCellSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False

'  MultiUse = -1  'True
'  Persistable = 0  'NotPersistable
'  DataBindingBehavior = 0  'vbNone
'  DataSourceBehavior = 0   'vbNone
'  MTSTransactionMode = 0   'NotAnMTSObject
'End
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  报表自由单元向导设置类
'  作者：邓强
'  日期：1999.01.22
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                       属性说明
'
'ReportID                                          '报表ID
Option Explicit

Private Const MaxHeadCells As Integer = 9
Private Const MaxTailCells As Integer = 9
Private mvarReportID As Long                               '报表ID
Private mvarReportName As String                           '报表名称
Private mvarFreeHeads As Integer                           '有效自由单元个数
Private mvarFreeTails As Integer                           '有效表头自由单元个数
Private mvarFreeCells As Integer                           '有效表尾自由单元个数
Private mvarCanAddHead As Boolean                          '新增表头自由单元
Private mvarCanAddTail As Boolean                          '新增表尾自由单元
Private mvarDateCellNo As Integer                          '日期自由单元序号

Private mvarCellName() As String                           '自由单元名称
Private mvarCellNo() As Integer                            '自由单元编号
Private mvarCellType() As Integer                          '自由单元类型
Private mvarCellFunc() As Integer                          '自由单元函数索引
Private mvarCellAlign() As Integer                         '自由单元对齐方式
Private mvarCellTop() As Long                              '自由单元上间距
Private mvarCellLeft() As Long                             '自由单元左间距
Private mvarCellHeight() As Long                           '自由单元高度
Private mvarCellWidth() As Long                            '自由单元宽度
Private mvarCellValid() As Boolean                         '自由单元有效性

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                    属性方法
'
'报表ID
Public Property Let ReportID(ByVal vData As Long)
    mvarReportID = vData
End Property
Public Property Get ReportID() As Long
    ReportID = mvarReportID
End Property

'自由单元名称
Public Property Let CellName(ByVal intColumn As Integer, ByVal vData As String)
    mvarCellName(intColumn) = vData
End Property
Public Property Get CellName(ByVal intColumn As Integer) As String
    CellName = mvarCellName(intColumn)
End Property
'自由单元编号
Public Property Let CellNo(ByVal intColumn As Integer, ByVal vData As Integer)
    mvarCellNo(intColumn) = vData
End Property
Public Property Get CellNo(ByVal intColumn As Integer) As Integer
    CellNo = mvarCellNo(intColumn)
End Property
'自由单元类型
Public Property Let CellType(ByVal intColumn As Integer, ByVal vData As Integer)
    mvarCellType(intColumn) = vData
End Property
Public Property Get CellType(ByVal intColumn As Integer) As Integer
    CellType = mvarCellType(intColumn)
End Property
'自由单元函数索引
Public Property Let CellFunc(ByVal intColumn As Integer, ByVal vData As Integer)
    mvarCellFunc(intColumn) = vData
End Property
Public Property Get CellFunc(ByVal intColumn As Integer) As Integer
    CellFunc = mvarCellFunc(intColumn)
End Property
'自由单元对齐方式
Public Property Let CellAlign(ByVal intColumn As Integer, ByVal vData As Integer)
    mvarCellAlign(intColumn) = vData
End Property
Public Property Get CellAlign(ByVal intColumn As Integer) As Integer
    CellAlign = mvarCellAlign(intColumn)
End Property
'自由单元上间距
Public Property Let CellTop(ByVal intColumn As Integer, ByVal vData As Long)
    mvarCellTop(intColumn) = vData
End Property
Public Property Get CellTop(ByVal intColumn As Integer) As Long
    CellTop = mvarCellTop(intColumn)
End Property
'自由单元左间距
Public Property Let CellLeft(ByVal intColumn As Integer, ByVal vData As Long)
    mvarCellLeft(intColumn) = vData
End Property
Public Property Get CellLeft(ByVal intColumn As Integer) As Long
    CellLeft = mvarCellLeft(intColumn)
End Property
'自由单元高度
Public Property Let CellHeight(ByVal intColumn As Integer, ByVal vData As Long)
    mvarCellHeight(intColumn) = vData
End Property
Public Property Get CellHeight(ByVal intColumn As Integer) As Long
    CellHeight = mvarCellHeight(intColumn)
End Property
'自由单元宽度
Public Property Let CellWidth(ByVal intColumn As Integer, ByVal vData As Long)
    mvarCellWidth(intColumn) = vData
End Property
Public Property Get CellWidth(ByVal intColumn As Integer) As Long
    CellWidth = mvarCellWidth(intColumn)
End Property
''''''''''''''''''''''          只读属性
''''''''''''''''''''''
'能否新增表头自由单元
Public Property Get CanAddHead() As Boolean
    CanAddHead = mvarCanAddHead
End Property
'能否新增表尾自由单元
Public Property Get CanAddTail() As Boolean
    CanAddTail = mvarCanAddTail
End Property
'自由单元上界
Public Property Get CellUBound() As Integer
    CellUBound = UBound(mvarCellName)
End Property
'有效自由单元个数
Public Property Get FreeCells() As Integer
    FreeCells = mvarFreeCells
End Property
'自由单元有效性
Public Property Get CellValid(ByVal intColumn As Integer) As Boolean
    CellValid = mvarCellValid(intColumn)
End Property
''''''''''''''''''''''          只写属性
''''''''''''''''''''''
'报表名称
Public Property Let ReportName(ByVal vData As String)
    mvarReportName = vData
End Property
'日期自由单元最初序号
Public Property Let DateCellInitNo(ByVal vData As String)
    mvarDateCellNo = vData
End Property
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                 公共过程
'
'寻找位置
Public Sub FindLoc(ByVal intIndex As Integer, intLoc As Integer)
Dim intCount As Integer
    intLoc = -1
    For intCount = 0 To UBound(mvarCellNo)
        If mvarCellNo(intCount) = intIndex And mvarCellValid(intCount) = True Then
            intLoc = intCount
            Exit For
        End If
    Next intCount
End Sub
'删除自由单元
Public Function DelCell(ByVal intColumn As Integer) As Boolean
Dim intCount As Integer
Dim blnFind  As Boolean
    
    blnFind = False
    For intCount = 0 To UBound(mvarCellNo)
        If mvarCellNo(intCount) = intColumn And mvarCellValid(intCount) Then
            blnFind = True
            Exit For
        End If
    Next intCount
    If blnFind Then
        mvarCellValid(intCount) = False
        mvarFreeCells = mvarFreeCells - 1
        If mvarCellType(intCount) = 1 Then
            mvarFreeHeads = mvarFreeHeads - 1
        ElseIf mvarCellValid(intCount) = 2 Then
            mvarFreeTails = mvarFreeTails - 1
        End If
        ReSort intCount
        SetCanAddCell
        DelCell = True
    Else
        DelCell = False
    End If
End Function

'新增自由单元
Public Sub AddCell(ByVal intNo As Integer, ByVal strName As String, Optional ByVal intType As Integer = 1, Optional ByVal intFunc As Integer = 0 _
                    , Optional ByVal lngTop As Integer = 50, Optional ByVal lngLeft As Integer = 100, Optional ByVal lngWidth As Long = 1500, Optional ByVal lngHeight As Long = 225)
Dim intCount As Integer, intLoc As Integer
Dim blnFind  As Boolean
    
    '找空缺位置
    blnFind = False
    For intCount = 0 To UBound(mvarCellValid)
        If mvarCellValid(intCount) = False Then
            blnFind = True
            Exit For
        End If
    Next intCount
    If blnFind Then
        '找到空缺位置
        intLoc = intCount
    Else