filter.bas

金算盘软件代码

Attribute VB_Name = "Filter"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'   作者:王佥
'   模块功能: 采用树结构设置筛选条件并返回筛选Where字句.
'   使用范围: 整个工程.

'   ShowFilter(LngFilterID, lngType,ChineseCond, IntTag ,strCond , strPeriodName,TOK,strSpecial) As String
'   方法功能:当 IntTag=0 时返回筛选的全部Where字句, 否则返回除去特殊条件类后的部分Where字句
'                                    TOK 确定退出标志
'                                    strSpecial 对特殊代码型字段赋初值 如:"Account/101 现金/1" 其中Account:字段所在表名
'                                              101 现金:代码号+名字(或者 代码号串) 1:ID号
'
'   GetInitWhere(LngFilterID , lngType , IntTag , strCond , strPeriodName ) As String
'   参数说明:                        LngFilterID为筛选ID号(如帐册ID号)
'                                    lngType为类型号 1:ListClass 2:ReportClass
'                                    IntTag为特殊条件类:0:所有 1:科目 2:单位 4:部门 8:员工
'                                                      16:工程项目 32:统计 64:期间 128:商品 256 :项目
'                                    strCond 特殊条件类返回参数
'                                    strPeriodName 区间型字段名
'   方法功能:取上一次设置的条件
'
'   日期:1998年7月3日
'
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

'显示筛选窗口
Public Function ShowFilter(ByVal LngFilterID As Long, lngType As Long, Optional ChineseCond As String = "", Optional IntTag As Integer = 0, Optional strCond As String = "", Optional strPeriodName As String = "", Optional tOk As Boolean = False, Optional strSpecial As String = "", Optional NewFormName As String = "筛选", Optional lngReceiptTypeID As Long = 0, Optional strReceiptTypeID As String = "", Optional EmployeeTag As Long = -1, Optional strWhereing As String = "", Optional strHaving As String = "") As String
   Dim frmTreefilter  As New frmFilter
   On Error Resume Next
   Load frmTreefilter
   frmTreefilter.Caption = NewFormName
   frmTreefilter.ShowFilter LngFilterID, lngType, IntTag, strCond, strPeriodName, strSpecial, lngReceiptTypeID, strReceiptTypeID, EmployeeTag
   frmTreefilter.Show vbModal
   If frmTreefilter.mblnOk Then
        tOk = frmTreefilter.mblnOk
        strCond = frmTreefilter.mstrCond
        ChineseCond = frmTreefilter.mChineseCond
        ShowFilter = frmTreefilter.mstrWhere
        strWhereing = frmTreefilter.mstrWhereing
        strHaving = frmTreefilter.mstrHaving
   End If
   Unload frmTreefilter
   Set frmTreefilter = Nothing

End Function

'从数据库中删除已选条件
Public Function DelSelectedCond(ByVal lngKeyID As Long, lngTypeID As Long) As Boolean
  Dim strSql As String
  Dim strsql2 As String
  Dim strSql3 As String
    Select Case lngTypeID
        Case 1
            strSql = " Delete  from ListCond where ListCond.lngListID = " & lngKeyID
            strsql2 = " Delete  from ListMultiIDCond where lngListID = " & lngKeyID
        Case 2
            strSql = " Delete  from ReportCond where ReportCond.lngReportID = " & lngKeyID
            strsql2 = " Delete  from ReportMultiIDCond where lngReportID = " & lngKeyID
            strSql3 = " Delete  from ReportFilter where lngReportID = " & lngKeyID
        Case Else
            Exit Function
    End Select
    gclsBase.BaseDB.Execute strSql
    gclsBase.BaseDB.Execute strsql2
    If lngTypeID = 2 Then
        gclsBase.BaseDB.Execute strSql3
    End If
    DelSelectedCond = True
End Function

'把由 strSeach(字段名数组) 所生成的条件从 strSelected(已选条件) 中分裂出来
'注意: 数组从0 开始
Public Function ModifyCond(strSelected As String, strSearch() As String, strReturn As String) As String
  Dim Index As Long
  Dim strSearchTemp As String
  On Error GoTo EndHandle
    strReturn = ""
    '处理 First 分组条件
    If Trim(strSelected) <> "" Then
        Dim strFirst As String
        Dim strIsDate As String
        '考虑日期型
        strIsDate = "DECODE(ISDATE(MIN("
        Do While ModifyCondPer(strSelected, strIsDate)
            If Trim(strReturn) <> "" Then
                strReturn = strReturn & " and " & strIsDate
            Else
                strReturn = strIsDate
            End If
            strFirst = "TO_DATE(MIN("
            If ModifyCondPer(strSelected, strFirst) Then
                strReturn = strReturn & " and " & strFirst
            End If
            strIsDate = "DECODE(ISDATE(MIN("
        Loop
        strFirst = "MIN("
        Do While ModifyCondPer(strSelected, strFirst)
            If Trim(strReturn) <> "" Then
                strReturn = strReturn & " and " & strFirst
            Else
                strReturn = strFirst
            End If
            strFirst = "MIN("
        Loop
        ModifyCond = strSelected
    End If
    '处理 Sum分组条件
    For Index = 0 To UBound(strSearch, 1)
            strSearchTemp = strSearch(Index)
            If ModifyCondPer(strSelected, strSearch(Index)) Then
                If Trim(strReturn) <> "" Then
                    strReturn = strReturn & " and " & strSearch(Index)
                Else
                    strReturn = strSearch(Index)
                End If
                '考虑＂介于＂情况
                If ModifyCondPer(strSelected, strSearchTemp) Then
                        strReturn = strReturn & " and " & strSearchTemp
                End If
            End If
    Next
    ModifyCond = strSelected
EndHandle:
End Function


'把由 strSearch(字段名) 所生成的条件从 strSelected(已选条件) 中分裂出来
Public Function ModifyCondPer(strSelected As String, strSearch As String) As Boolean
  Dim strString1 As String
  Dim strString2 As String
  Dim lngTemp As Long
'  Dim Index As Long
  Dim strFore As String
  Dim strAfter As String
    On Error GoTo EndHandle
    strString1 = UCase(Trim(strSelected))
    strString2 = UCase(Trim(strSearch))
    If strString2 = "" Then Exit Function
    '生成条件前段
    lngTemp = InStr(strString1, strString2)
    If lngTemp > 0 Then
        strFore = Trim(Left(strString1, lngTemp - 1))
        strAfter = Right(strString1, Len(strString1) - lngTemp + 1)
    Else
        Exit Function
    End If
    If Right(strFore, 4) = " AND" Then
        strFore = Trim(Left(strFore, Len(strFore) - 3))
    Else
        If Len(strFore) > 4 Then
            For lngTemp = Len(strFore) - 4 To 1 Step -1
                If Mid(strFore, lngTemp, 4) = " AND" Then
                    strAfter = Trim(Right(strFore, Len(strFore) - 3 - lngTemp)) & strAfter
                    strFore = Trim(Left(strFore, lngTemp - 1))
                    Exit For
                ElseIf lngTemp = 1 Then
                    strAfter = strFore & strAfter
                    strFore = ""
                End If
            Next
        Else
            strAfter = strFore & strAfter
            strFore = ""
        End If
    End If
    '生成条件后段和特殊条件
    
    lngTemp = InStr(strAfter, " AND ")
    
    If lngTemp > 0 Then
        strSearch = Left(strAfter, lngTemp - 1)
        strAfter = Trim(Right(strAfter, Len(strAfter) - lngTemp - 4))
    Else
        If InStr(strAfter, "(") < lngTemp Then
            Dim PositionPreKH As Long, CountKH As Long
                CountKH = 1
                PositionPreKH = InStr(strAfter, "(")
                For lngTemp = PositionPreKH + 1 To Len(strAfter)
                    If Mid(strAfter, lngTemp, 1) = "(" Then
                        CountKH = CountKH + 1
                    ElseIf Mid(strAfter, lngTemp, 1) = ")" Then
                        CountKH = CountKH - 1
                        If CountKH = 0 Then
                            strSearch = Left(strAfter, lngTemp)
                            strAfter = Trim(Right(strAfter, Len(strAfter) - lngTemp))
                            If Left(strAfter, 4) = "AND " Then
                                strAfter = Trim(Right(strAfter, Len(strAfter) - 4))
                            End If
                            Exit For
                        End If
                    End If
                Next
        Else
            strSearch = strAfter
            strAfter = ""
        End If
    End If
    '生成总条件
    If Trim(strFore) <> "" Then
        If Trim(strAfter) <> "" Then
            strSelected = strFore & " AND " & strAfter
        Else
            strSelected = strFore
        End If
    Else
        If Trim(strAfter) <> "" Then
            strSelected = strAfter
        Else
            strSelected = ""
        End If
    End If
    ModifyCondPer = True
EndHandle:
End Function

'字符串替代函数
'功能:把 strSelected 中的 strString 字符串,用 strReplace 字符串来代替
Public Function ModifyTableName(ByVal strSelected As String, ByVal strString As String, ByVal strReplace As String) As String
  Dim strTableName As String
  Dim strBiaTableName As String
  Dim strFore As String
  Dim strAfter As String
  Dim lngTemp As Long
  Dim strTemp As String
    strAfter = strSelected
    strTableName = strString
    strBiaTableName = strReplace
    lngTemp = InStr(strAfter, strTableName)
    Do While lngTemp > 0
        strFore = Left(strAfter, lngTemp - 1)
        strAfter = Right(strAfter, Len(strAfter) - lngTemp - Len(strTableName) + 1)
        strTemp = strTemp & strFore & strBiaTableName
        lngTemp = InStr(strAfter, strTableName)
    Loop
    strAfter = strTemp & strAfter
    
'    strTableName = "[" & Left(strString, Len(strString) - 1) & "]!"
    strTableName = Left(strString, Len(strString) - 1) & "."