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

                                                                                                                            '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  功能:采用树结构设置筛选条件(供使用条件的窗体调用)
'  日期:1998年7月10日
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  属性        KeyID                          '报表ID
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Const ConNumPerSel = 14                       '当前行的参数个数
Private strCondVersionField As String         'ViewField的版本号条件
Private strCondVersionEnum As String          'Enum总的版本号条件
Private strCondVersion As String              '单据类型的版本号条件
Private strCondHospital As String             '行政医疗条件
'属性变量
Private mlngKeyID As Long                     '报表ID

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'模块变量
Private mlngViewID As Long                    '总的视图ID号
Private mlngKeyType As Long                   '1:list;2:report

Private mlngCurentline As Long                '当前行
Private mlngCurLineOfSelect  As Long
Private mblnRefertext1  As Boolean
Private mblnRefertext2 As Boolean
Private mItemNotExit As Boolean
Private mblnIsSimpleCustomer As Boolean                '瘦身型条件，对字节点供应商起作用
'Private mblnIsSimpleEmployee As Boolean                '瘦身型条件，对字节点职员起作用

Private mintMaxSelLines As Integer             '已选条件个数
Private mCurstrTemp(1 To 9) As String          '当前行的参数 1:字段描述 2:字段名 3:字段类型 4:表名 5:树接点索引号 6:视图ID号 7:父视图ID号
Private mstrSelected() As String               '当前行的参数(MaxLine,1 To 13)
Private mstrTempSelected() As String           '暂存以备条件的数组 ，以备恢复

Private mstrViewKey As String
Private mFilterNode As msComctlLib.Node
Private mMaxNodesNumber As Long
Private mblnSelected As Boolean
Private mstrSpecialTable As String
Private mstrSpecialFieldName As String
Private mstrSpecialID As String

Private mblnAccount As Boolean
Private mblnCustomer As Boolean
Private mblnDepartment As Boolean
Private mblnEmployee As Boolean
Private mblnJob As Boolean
Private mblnClass1 As Boolean
Private mblnClass2 As Boolean
Private mblnItem As Boolean
Private mblnPosition As Boolean
Private mblnPeriod As Boolean
Private mstrPeriodName As String
Private mIntTag As Long                       '特殊条件标志
Private mChineseCond As String                '返回汉语条件
Private mEmployeeTag As Long                  '职员条件标志 -1：所有，1：总帐类
                                              '2：应收类 4：应付类 8：现金银行类 16：采购类 32：销售类 64：库存类 128：委托加工类


'类模块属性
'报表ID
Public Property Let KeyID(vData As Long)
    mlngKeyID = vData
End Property

Public Property Get KeyID() As Long
    KeyID = mlngKeyID
End Property
Public Property Let EmployeeTag(vData As Long)
    mEmployeeTag = vData
End Property
'视图ID
Public Property Let ViewId(vData As Long)
    mlngViewID = vData
End Property

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

Public Property Let blnNotExist(NotExist As Boolean)
    mItemNotExit = NotExist
End Property

Public Property Get blnNotExist() As Boolean
    blnNotExist = mItemNotExit
End Property

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'传递数组mstrSelected() 供财务分析表调用或者暂存数组以备恢复
Public Function GetSelectd(arrsel() As String) As Boolean
Dim intFirst As Integer, intSecond As Integer
Dim Max1 As Integer, Max2 As Integer
    On Error GoTo ErrHandle
    Max1 = mintMaxSelLines
    Max2 = UBound(mstrSelected, 2)
    ReDim arrsel(1 To Max1, 1 To Max2)
    For intFirst = 1 To Max1
       For intSecond = 1 To Max2
         arrsel(intFirst, intSecond) = mstrSelected(intFirst, intSecond)
       Next intSecond
   Next intFirst
   GetSelectd = True
   Exit Function
ErrHandle:
   GetSelectd = False
End Function
'恢复数组mstrSelected()
Public Function ResumeSelectd() As Boolean
Dim intFirst As Integer, intSecond As Integer
Dim Max1 As Integer, Max2 As Integer
    On Error GoTo ErrHandle
    Max1 = UBound(mstrTempSelected, 1)
    mintMaxSelLines = Max1
    Max2 = UBound(mstrTempSelected, 2)
    ReDim mstrSelected(1 To Max1, 1 To Max2)
    For intFirst = 1 To Max1
       For intSecond = 1 To Max2
         mstrSelected(intFirst, intSecond) = mstrTempSelected(intFirst, intSecond)
       Next intSecond
   Next intFirst
   ResumeSelectd = True
   Exit Function
ErrHandle:
   ResumeSelectd = False
End Function
'字符转换为数字
Private Function CondStrToNum(ByVal strOperate As String) As String
    Select Case Trim(strOperate)
        Case "等于", "今天"
           CondStrToNum = "1"
        Case "大于", "本周"
           CondStrToNum = "2"
        Case "小于", "本周至今日"
           CondStrToNum = "3"
        Case "大于等于", "本期"
           CondStrToNum = "4"
        Case "小于等于", "本期至今日"
           CondStrToNum = "5"
        Case "打头字符为", "介于", "本月"
           CondStrToNum = "6"
        Case "包含字符", "本月至今日", "零或空值"
           CondStrToNum = "7"
        Case "类似于", "本季度"
           CondStrToNum = "8"
        Case "本季至今日", "不等于"
           CondStrToNum = "9"
        Case "本年"
           CondStrToNum = "10"
        Case "本年至今日", "空值"
           CondStrToNum = "11"
        Case "上周"
           CondStrToNum = "12"
        Case "上期"
           CondStrToNum = "13"
        Case "上月"
           CondStrToNum = "14"
        Case "上季度"
           CondStrToNum = "15"
        Case "去年"
           CondStrToNum = "16"
        Case "自定义"
           CondStrToNum = "17"
        Case "所有"
           CondStrToNum = "18"
     End Select
End Function

'修改数据库
Public Sub UpdateCond()
 Dim rs As rdoResultset
 Dim rsMultiCond As rdoResultset
 Dim Index As Long
 Dim strTemp As String
 Dim strTable As String
 Dim strSql As String
 Dim strsql2 As String
 Dim strKey As String
 Dim strRootRath As String
 Dim lngTemp As Long
  
    On Error GoTo ErrHandle
    Filter.DelSelectedCond mlngKeyID, mlngKeyType
    If mlngKeyType = 1 Then
         strTable = "ListCond"
        strKey = "lngListId"
    Else
         strTable = "ReportCond"
        strKey = "lngReportId"
    End If
  
  Set rs = gclsBase.BaseDB.OpenResultset("Select * From " & strTable, rdOpenDynamic, 4)
  gclsBase.BaseWorkSpace.BeginTrans
  Index = 1
  Do While Index <= mintMaxSelLines
    rs.AddNew
    rs.rdoColumns(strKey) = mlngKeyID
    rs!lngViewFieldID = CLng(Trim(mstrSelected(Index, 10)))
    rs!strPath = mstrSelected(Index, 11)
    rs!strOthTableName = IIf(mstrSelected(Index, 12) = "", " ", mstrSelected(Index, 12))
    If InStr(rs!strPath, "/") <> 0 Then rs!blnHavefathernode = 1
    Select Case UCase(Trim(mstrSelected(Index, 3)))
        Case "STRING"          '字符串的 “介于” 操作符为10
            If mstrSelected(Index, 5) = "介于" Then
               rs!strStringOP = 10
               rs!strString2 = mstrSelected(Index, 7)
            Else
                rs!strStringOP = CondStrToNum(mstrSelected(Index, 5))
            End If
            rs!strString1 = IIf(mstrSelected(Index, 6) = "", " ", mstrSelected(Index, 6))
        Case "ENUM"
               rs!strString1 = mstrSelected(Index, 5)
               rs!strString2 = IIf(mstrSelected(Index, 6) = "", " ", mstrSelected(Index, 6))
        Case "LONG", "INTEGER", "DOUBLE"
'            mstrSelected(Index, 5) = CondStrToNum(mstrSelected(Index, 5))
            rs!strDoubleOP = CondStrToNum(mstrSelected(Index, 5))
            If mstrSelected(Index, 5) = "零或空值" Then
                rs!dbldouble1 = 0
            Else
                rs!dbldouble1 = mstrSelected(Index, 6)
                If mstrSelected(Index, 5) = "介于" Then
                    rs!dbldouble2 = mstrSelected(Index, 7)
                End If
            End If
        Case "BOOLEAN"
             rs!blnBoolean = IIf(Trim(mstrSelected(Index, 5)) = "是", 1, 0)
        Case "DATE"
             rs!strDateOp = 0
             rs!dtmDate1 = mstrSelected(Index, 5)
        Case "PERIOD"
             'mstrSelected(Index, 5) = CondStrToNum(mstrSelected(Index, 5))
             rs!strDateOp = CondStrToNum(mstrSelected(Index, 5))
             rs!dtmDate1 = mstrSelected(Index, 6)
             rs!dtmDate2 = mstrSelected(Index, 7)
        Case "CODE"
             If Trim(mstrSelected(Index, 5)) = "选择项目" Then
               rs!blnismulicond = 1
                If mlngKeyType = 1 Then
                    Set rsMultiCond = gclsBase.BaseDB.OpenResultset("SELECT * from listMultiIDCond ", rdOpenStatic, 4)
                Else
                    Set rsMultiCond = gclsBase.BaseDB.OpenResultset("SELECT * from ReportMultiIDCond ", rdOpenStatic, 4)
                End If
                rsMultiCond.AddNew
                If mlngKeyType = 1 Then
                    rsMultiCond!lngListID = mlngKeyID
                Else
                    rsMultiCond!lngReportID = mlngKeyID
                End If
                rsMultiCond!strPath = mstrSelected(Index, 11)
                rsMultiCond!strCodeID = mstrSelected(Index, 6)
                rsMultiCond!strKeyName = mstrSelected(Index, 5)
                rsMultiCond!bLNISCODETYPE = 0
                rsMultiCond.Update
                rsMultiCond.Close
'               If mlngKeyType = 1 Then
'                    strSql = "insert into listMultiIDCond( LNGLISTID, STRPATH, STRCODEID, STRKEYNAME, BLNISCODETYPE )  values('" & mlngKeyID & "','" & mstrSelected(Index, 11) & "','" & mstrSelected(Index, 6) & "','" & mstrSelected(Index, 7) & "','0')"
'               Else
'                    strSql = "insert into ReportMultiIDCond( LNGREPORTID, STRPATH, STRCODEID, STRKEYNAME, BLNISCODETYPE )  values('" & mlngKeyID & "','" & mstrSelected(Index, 11) & "','" & mstrSelected(Index, 6) & "','" & mstrSelected(Index, 7) & "','0')"
'               End If
             Else
               rs!blnismulicond = 0
                If mlngKeyType = 1 Then
                    Set rsMultiCond = gclsBase.BaseDB.OpenResultset("SELECT * from listMultiIDCond ", rdOpenStatic, 4)
                Else
                    Set rsMultiCond = gclsBase.BaseDB.OpenResultset("SELECT * from ReportMultiIDCond ", rdOpenStatic, 4)
                End If
                rsMultiCond.AddNew
                If mlngKeyType = 1 Then
                    rsMultiCond!lngListID = mlngKeyID
                Else
                    rsMultiCond!lngReportID = mlngKeyID
                End If
                rsMultiCond!strPath = mstrSelected(Index, 11)