listset.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 = "ListSet"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  列表设置类
'  作者：魏然
'  日期：1998.05.18
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Private mvarViewID As Long                            '视图ID
Private mvarViewName As String                        '视图名称
Private mvarListID As Long                            '列表ID
Private mblnFormatNum As Boolean
Private mvarColumns As Integer                        '栏目数
Private mvarFixColumns As Integer                     '固定栏目数
Private mvarMustColumns As Integer                    '必选栏目数
Private mvarColumnWidth() As Long                     '栏目宽度
Private mvarColumnOrderType() As Integer              '栏目排序方式 0=不排序 1=升序列 2=降序
Private mvarColumnIsFix() As Boolean                  '是否固定栏目
Private mvarColumnIsMust() As Boolean                 '是否必选栏目
Private mvarColumnIsFind() As Boolean                 '是否查找栏目
Private mvarColumnFieldID() As Variant                '栏目字段ID
Private mvarColumnFieldName() As String               '栏目字段
Private mvarColumnDesc() As String                    '栏目说明
Private mvarColumnGroup() As String                   '栏目Group

Private mvarColumnFieldType() As String               '栏目字段类型
Private mvarColumnFieldSize() As Integer              '栏目字段长度
Private mvarFieldDec() As Byte                        '栏目字段小数位数
Private mvarColumnCombine() As String                 '栏目合并名称
Private mbytFormat() As Byte                          '栏目格式化类型 0=其他 1=数量 2=单价 3=原币 4=汇率 5=本币
Private mblnNotZero() As Boolean                      '栏目是否只显示非零值

Private mstrCurTable As String                        '币种表名

Private mvarShowAll As Boolean                        '是否全部显示
Private mvarFrom As String                            'SQL 的 FROM 子句
Private mvarSelect As String                          'SQL 的 SELECT 子句
Private mvarWhere As String                           'SQL 的 WHERE 子句
Private mstrHaving As String                          'SQL 的 Having 子句

Private mblnReadOnly As Boolean                       '属性是否只读
Private mblnFirstUse As Boolean                       '该用户是否第一次使用此列表

Private mstrPureWhere As String                       'SQL 的 PureWHERE 子句
Private mstrWhereInFrom As String                     'From 中Where
Private mblnFormatCell As Boolean                     'SQL 的 SELECT 子句是否格式化
'''''''''''''''''''''''''''''''''''''''''''''''''''
'                列表设置类属性
'
'''''''''''''''''''''''''''''''''''''''''''''''''''

Public Property Get FirstUse() As Integer
    FirstUse = mblnFirstUse
End Property

Public Property Get FormatNum() As Boolean
    FormatNum = mblnFormatNum
End Property

Public Property Let FormatNum(ByVal New_Data As Boolean)
    mblnFormatNum = New_Data
End Property

Public Property Get GetPureWhere() As String
    GetPureWhere = mstrPureWhere
End Property
Public Property Get GetWhereInFrom() As String
    GetWhereInFrom = mstrWhereInFrom
End Property
'栏目字段小数位数
Public Property Get ColumnFieldDec(ByVal ColumnIndex As Integer) As Byte
    ColumnFieldDec = mvarFieldDec(ColumnIndex)
End Property

Public Property Let ColumnFieldDec(ByVal ColumnIndex As Integer, ByVal vData As Byte)
    mvarFieldDec(ColumnIndex) = vData
End Property

'栏目字段长度
Public Property Let ColumnFieldSize(ByVal ColumnIndex As Integer, ByVal vData As Integer)
    mvarColumnFieldSize(ColumnIndex) = vData
End Property

Public Property Get ColumnFieldSize(ByVal ColumnIndex As Integer) As Integer
    ColumnFieldSize = mvarColumnFieldSize(ColumnIndex)
End Property

'栏目字段类型
Public Property Let ColumnFieldType(ByVal ColumnIndex As Integer, ByVal vData As String)
    mvarColumnFieldType(ColumnIndex) = vData
End Property

Public Property Get ColumnFieldType(ByVal ColumnIndex As Integer) As String
    ColumnFieldType = mvarColumnFieldType(ColumnIndex)
End Property

'栏目说明
Public Property Let ColumnDesc(ByVal ColumnIndex As Integer, ByVal vData As String)
    mvarColumnDesc(ColumnIndex) = vData
End Property

Public Property Get ColumnDesc(ByVal ColumnIndex As Integer) As String
    ColumnDesc = mvarColumnDesc(ColumnIndex)
End Property

'栏目格式类型
Public Property Let ColumnFormat(ByVal ColumnIndex As Integer, ByVal vData As Byte)
    mbytFormat(ColumnIndex) = vData
End Property

Public Property Get ColumnFormat(ByVal ColumnIndex As Integer) As Byte
    ColumnFormat = mbytFormat(ColumnIndex)
End Property

'只显示非零值
Public Property Let ColumnNotZero(ByVal ColumnIndex As Integer, ByVal vData As Boolean)
    mblnNotZero(ColumnIndex) = vData
End Property

Public Property Get ColumnNotZero(ByVal ColumnIndex As Integer) As Boolean
    ColumnNotZero = mblnNotZero(ColumnIndex)
End Property

'栏目字段
Public Property Let ColumnFieldName(ByVal ColumnIndex As Integer, ByVal vData As String)
    mvarColumnFieldName(ColumnIndex) = vData
End Property

Public Property Get ColumnFieldName(ByVal ColumnIndex As Integer) As String
    ColumnFieldName = mvarColumnFieldName(ColumnIndex)
End Property

'栏目字段ID
Public Property Let ColumnFieldID(ByVal ColumnIndex As Integer, ByVal vData As Long)
    mvarColumnFieldID(ColumnIndex) = vData
End Property

Public Property Get ColumnFieldID(ByVal ColumnIndex As Integer) As Long
    ColumnFieldID = mvarColumnFieldID(ColumnIndex)
End Property

'栏目 Group By
Public Property Let ColumnGroup(ByVal ColumnIndex As Integer, ByVal vData As String)
    mvarColumnGroup(ColumnIndex) = vData
End Property

Public Property Get ColumnGroup(ByVal ColumnIndex As Integer) As String
    ColumnGroup = mvarColumnGroup(ColumnIndex)
End Property

'是否查找栏目
Public Property Let ColumnIsFind(ByVal ColumnIndex As Integer, ByVal vData As Boolean)
    mvarColumnIsFind(ColumnIndex) = vData
End Property

Public Property Get ColumnIsFind(ByVal ColumnIndex As Integer) As Boolean
    ColumnIsFind = mvarColumnIsFind(ColumnIndex)
End Property

'是否固定栏目
Public Property Let ColumnIsFix(ByVal ColumnIndex As Integer, ByVal vData As Boolean)
    mvarColumnIsFix(ColumnIndex) = vData
End Property

Public Property Get ColumnIsFix(ByVal ColumnIndex As Integer) As Boolean
    ColumnIsFix = mvarColumnIsFix(ColumnIndex)
End Property

'是否必选栏目
Public Property Let ColumnIsMust(ByVal ColumnIndex As Integer, ByVal vData As Boolean)
    mvarColumnIsMust(ColumnIndex) = vData
End Property

Public Property Get ColumnIsMust(ByVal ColumnIndex As Integer) As Boolean
    ColumnIsMust = mvarColumnIsMust(ColumnIndex)
End Property

'栏目排序方式 0=不排序 1=升序列 2=降序
Public Property Let ColumnOrderType(ByVal ColumnIndex As Integer, ByVal vData As Integer)
    On Error Resume Next
    mvarColumnOrderType(ColumnIndex) = vData
End Property

Public Property Get ColumnOrderType(ByVal ColumnIndex As Integer) As Integer
    ColumnOrderType = mvarColumnOrderType(ColumnIndex)
End Property

'栏目宽度
Public Property Let ColumnWidth(ByVal ColumnIndex As Integer, ByVal vData As Long)
    mvarColumnWidth(ColumnIndex) = vData
End Property

Public Property Get ColumnWidth(ByVal ColumnIndex As Integer) As Long
    On Error Resume Next
    ColumnWidth = mvarColumnWidth(ColumnIndex)
End Property

'栏目合并列名
Public Property Let ColumnCombine(ByVal ColumnIndex As Integer, ByVal vData As String)
    mvarColumnCombine(ColumnIndex) = vData
End Property

Public Property Get ColumnCombine(ByVal ColumnIndex As Integer) As String
    ColumnCombine = mvarColumnCombine(ColumnIndex)
End Property

'栏目数
Public Property Let Columns(ByVal vData As Integer)
    mvarColumns = vData
    ReDim mvarColumnWidth(mvarColumns)
    ReDim mvarColumnOrderType(mvarColumns)
    ReDim mvarColumnIsFix(mvarColumns)
    ReDim mvarColumnIsFind(mvarColumns)
    ReDim mvarColumnFieldID(mvarColumns)
    ReDim mvarColumnFieldName(mvarColumns)
    ReDim mvarColumnDesc(mvarColumns)
    ReDim mvarColumnFieldType(mvarColumns)
    ReDim mvarColumnFieldSize(mvarColumns)
    ReDim mvarColumnIsMust(mvarColumns)
    ReDim mvarFieldDec(mvarColumns)
    ReDim mvarColumnGroup(mvarColumns)
    ReDim mvarColumnCombine(mvarColumns)
    ReDim mbytFormat(mvarColumns)
    ReDim mblnNotZero(mvarColumns)
End Property

Public Property Get Columns() As Integer
    Columns = mvarColumns
End Property

'固定栏目数
Public Property Let FixColumns(ByVal vData As Integer)
    mvarFixColumns = vData
End Property

Public Property Get FixColumns() As Integer
    FixColumns = mvarFixColumns
End Property

'必选栏目数
Public Property Let MustColumns(ByVal vData As Integer)
    mvarMustColumns = vData
End Property

Public Property Get MustColumns() As Integer
    MustColumns = mvarMustColumns
End Property

'取 FROM 子句
Public Property Get FromOfSql() As String
    FromOfSql = mvarFrom
End Property

'取 Group 子句
Public Property Get GroupOfSql() As String
  Dim intCount As Integer
  Dim strGroup As String
    
    For intCount = 1 To mvarColumns
       If Trim(mvarColumnGroup(intCount)) <> "" Then
           If strGroup = "" Then
              strGroup = mvarColumnGroup(intCount)
           Else
              strGroup = strGroup & "," & mvarColumnGroup(intCount)
           End If
       End If
    Next intCount
    GroupOfSql = strGroup
End Property

'取 SELECT 子句
Public Property Get SelectOfSql() As String
    SelectOfSql = mvarSelect
End Property

'取 WHERE 子句
Public Property Get WhereOfSql() As String
    WhereOfSql = Trim(mvarWhere)
End Property

'取 HAVING 子句
Public Property Get HavingOfSql() As String
    HavingOfSql = mstrHaving
End Property

'SELECT 子句是否格式化
Public Property Let FormatSelect(ByVal blnFormatCell As Boolean)
    mblnFormatCell = blnFormatCell
End Property

'列表对应的视图ID
Public Property Let ViewId(ByVal vData As Long)
    Dim rstView As rdoResultset
    On Error Resume Next
    mvarViewID = vData
'    Debug.Print "Listse1: " & Timer
    Set rstView = gclsBase.BaseDB.OpenResultset("Select strViewName,strViewSQL,strCurTable,StrViewWhere from View1 Where lngViewId=" & mvarViewID, rdOpenStatic)
    If Not rstView.EOF Then
        mvarViewName = rstView!strViewName
        mstrCurTable = IIf(IsNull(rstView!strCurTable), "", rstView!strCurTable)
        mvarFrom = " From " & rstView!strViewSQL
        'mvarWhere = IIf(IsNull(CStr(rstView!StrViewWhere)), "", rstView!StrViewWhere)
        'mvarWhere = rstView!StrViewWhere
        mstrWhereInFrom = rstView!StrViewWhere
    End If
'    Debug.Print "Listse2: " & Timer
    GetListSet mvarViewID
'    Debug.Print "Listse3: " & Timer
    rstView.Close
   ' Exit Property
'Handerl:
'      If Err.Number = 94 Then mvarWhere = ""
End Property

Public Property Get ViewId() As Long
    ViewId = mvarViewID
End Property

'列表ID
Public Property Get ListID() As Long
    ListID = mvarListID
End Property

'列表对应的视图名称
Public Property Get ViewName() As String
    ViewName = mvarViewName
End Property

'''''''''''''''''''''''''''''''''''''''''''''''''''
'                列表设置类方法
'
'''''''''''''''''''''''''''''''''''''''''''''''''''

'按用户ID重新保存一份列表
Private Sub AddList()
  Dim intCount As Integer
  Dim rstList As rdoResultset
  Dim rstListField As rdoResultset
  Dim strSql As String
  Dim lngListID As Long

    'Add List
    strSql = "Select * from List"
    Set rstList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    With rstList
       .AddNew
          !lngViewId = mvarViewID
          !strListName = mvarViewName
          !lngOperatorID = gclsBase.OperatorID
          lngListID = GetNewID("List")
          !lngListID = lngListID
       .Update