clsfilter.cls

金算盘软件代码

            strCondVersionField = " And (ViewField.bytVersion IN (16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31))"
            strCondVersionEnum = " And (EnumTable.bytVersion IN (16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31))"
            strCondVersion = "(16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31)"
        #End If
      #End If
   #End If
   If gclsBase.AccountSys = 3 Or gclsBase.AccountSys = 4 Then
        strCondHospital = " And (viewField.blnNotHospital=0) "
   Else
        strCondHospital = ""
   End If
    AddNodes
End Sub

'加条件节点
Private Sub AddNodes()
Dim rs As rdoResultset
Dim strTableName As String
Dim strkeyIdNumber As String
Dim strSql As String
Dim strCount As String
Dim lngIndex As Long
'On Error GoTo ErrHandle
'    '事务开始
'    gclsBase.BaseWorkSpace.BeginTrans
            strSql = "select * from ViewField  " & _
                     " where viewfield.lngviewid=" & mlngViewID & _
                     " and ViewField.blnIsFilt = 1  " & strCondVersionField & strCondHospital & _
                     "  order by  ViewField.lngViewFieldNo "

    Set rs = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'    gclsBase.BaseWorkSpace.CommitTrans
    '事务提交
 On Error GoTo OverHandle

    If rs.RowCount = 0 Then
        rs.Close
        ReDim mstrSelected(0, ConNumPerSel)
        ReDim mstrChineseCond(0)
        Exit Sub
    Else
        rs.MoveFirst
    End If
    '** DO 1 **
    Do While Not rs.EOF
       If rs!lngViewId = mlngViewID Then
         Set mFilterNode = frmFilterSet.tvwFilt.Nodes.Add(, tvwChild, rs!strViewFieldDesc, rs!strViewFieldDesc, "closed") 'rs!strViewFieldDesc
         mFilterNode.Tag = Trim(rs.rdoColumns("strViewFieldDesc") & "@" & IIf(UCase(rs!strFieldType) = "CODE", rs!strKeyField, rs.rdoColumns("strFieldName")) & "@" & rs.rdoColumns("strTableName") & "@" & rs.rdoColumns("strFieldType") & "@" & rs.rdoColumns("lngViewFieldID") & "@" & "`" & rs!strBiaTableName)
         lngIndex = mFilterNode.Index

       End If
         rs.MoveNext
   '** END OF DO 1 **
   Loop

   If frmFilterSet.tvwFilt.Nodes.Count = 0 Then GoTo EndHandle

    '初始化条件Grid
    InitCondGridTemp
EndHandle:
  rs.Close
  Exit Sub
ErrHandle:
'  gclsBase.BaseWorkSpace.RollBacktrans
'  MsgBox "有其他人和你同时进入条件设置,为了保证数据的正确性,请你先退出向导,稍后再进入."
'  Exit Sub
OverHandle:
End Sub


 Private Sub CondNumToString(Optional AddRefer As Boolean = False)
  Dim strRefer As String

    If AddRefer Then strRefer = "'"

    Select Case Trim(mstrSelected(mlngCurentline, 5))
            Case "1"
               mstrSelected(mlngCurentline, 5) = "等于"
               mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " = " & strRefer & Trim(mstrSelected(mlngCurentline, 6)) & strRefer
            Case "2"
               mstrSelected(mlngCurentline, 5) = "大于"
               mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " > " & strRefer & Trim(mstrSelected(mlngCurentline, 6)) & strRefer
            Case "3"
               mstrSelected(mlngCurentline, 5) = "小于"
               mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " < " & strRefer & Trim(mstrSelected(mlngCurentline, 6)) & strRefer
            Case "4"
               mstrSelected(mlngCurentline, 5) = "大于等于"
               mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " >= " & strRefer & Trim(mstrSelected(mlngCurentline, 6)) & strRefer
            Case "5"
               mstrSelected(mlngCurentline, 5) = "小于等于"
               mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " <= " & strRefer & Trim(mstrSelected(mlngCurentline, 6)) & strRefer
            Case "6"
               If UCase(Trim(mstrSelected(mlngCurentline, 3))) = "STRING" Then
                    mstrSelected(mlngCurentline, 5) = "打头字符为"
                    mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " like " & "'" & Trim(Trim(mstrSelected(mlngCurentline, 6))) & "%' "
               Else
                    mstrSelected(mlngCurentline, 5) = "介于"
                    mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " >= " & Trim(mstrSelected(mlngCurentline, 6)) & " and " & mstrSelected(mlngCurentline, 2) & " <= " & Trim(mstrSelected(mlngCurentline, 7))
               End If
            Case "7"
               If UCase(Trim(mstrSelected(mlngCurentline, 3))) = "STRING" Then
                    mstrSelected(mlngCurentline, 5) = "包含字符"
                    mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " like " & "'" & "%" & Trim(Trim(mstrSelected(mlngCurentline, 6))) & "%'"
               Else
                    mstrSelected(mlngCurentline, 5) = "零或空值"
                    mstrSelected(mlngCurentline, 8) = "(" & mstrSelected(mlngCurentline, 2) & " IS NULL or " & mstrSelected(mlngCurentline, 2) & " =0) "
               End If
            Case "8"
               mstrSelected(mlngCurentline, 5) = "类似于"
               mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " like " & "'" & Trim(mstrSelected(mlngCurentline, 6)) & "'"
            Case "9"
               mstrSelected(mlngCurentline, 5) = "不等于"
               mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " <> " & strRefer & Trim(mstrSelected(mlngCurentline, 6)) & strRefer
     End Select
End Sub
Private Sub InitCondGridTemp()
 Dim Index As Long
 Dim index2 As Long
 Dim strRoot As String
 Dim lngTemp As Long
    On Error GoTo ErrHandle
    For Index = 1 To mintMaxSelLines 'UBound(mstrSelected, 1) - 1
        mlngCurentline = Index
        strRoot = mstrSelected(mlngCurentline, 11)
        index2 = 1
        Do While index2 <= frmFilterSet.tvwFilt.Nodes.Count
            Set mFilterNode = frmFilterSet.tvwFilt.Nodes(index2)
            If mFilterNode.Key = mstrSelected(mlngCurentline, 11) Then
                mstrSelected(mlngCurentline, 9) = index2
                AddGrid False
                Exit Do
            Else
                index2 = index2 + 1
            End If
        Loop
    Next
    frmFilterSet.MsgFilt.RowHeight(frmFilterSet.MsgFilt.Rows - 1) = 0
ErrHandle:
End Sub

Private Sub AddGrid(Optional tChild As Boolean)
   With frmFilterSet.MsgFilt
      .Rows = .Rows + 1
      If .RowHeight(1) = 0 Then
          .RowHeight(1) = 255
      End If
      If tChild = False Then
        mFilterNode.Tag = "*" & mFilterNode.Tag
        .RowData(mlngCurentline) = mstrSelected(mlngCurentline, 9)
      Else
        .RowData(mlngCurentline) = 0
      End If
      .TextMatrix(mlngCurentline, 0) = mstrSelected(mlngCurentline, 1)
      Select Case UCase(Trim(mstrSelected(mlngCurentline, 3)))
            Case "ENUM"
                  If mstrSelected(mlngCurentline, 5) = "选择项目" Then
                      .TextMatrix(mlngCurentline, 1) = mstrSelected(mlngCurentline, 7)
                  Else
                      .TextMatrix(mlngCurentline, 1) = mstrSelected(mlngCurentline, 5)
                  End If
            Case Else
                 If Trim(mstrSelected(mlngCurentline, 7)) = "" Or mstrSelected(mlngCurentline, 5) <> "介于" Then
                     If mstrSelected(mlngCurentline, 5) = "零或空值" Then
                        .TextMatrix(mlngCurentline, 1) = mstrSelected(mlngCurentline, 5)
                     Else
                        .TextMatrix(mlngCurentline, 1) = mstrSelected(mlngCurentline, 5) & "  " & Trim(mstrSelected(mlngCurentline, 6))
                     End If
                 Else
                     .TextMatrix(mlngCurentline, 1) = mstrSelected(mlngCurentline, 5) & " (" & Trim(mstrSelected(mlngCurentline, 6)) & " ," & Trim(mstrSelected(mlngCurentline, 7)) & ")"
                 End If
      End Select
   End With
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'功能: 显示筛选窗口
'参数说明: LngFilterID为筛选ID号(如帐册ID号)
'          lngType为类型号 1:ListClass 2:ReportClass
'          IntTag为特殊条件类:0:所有 1:科目 2:单位 4:部门 8:员工
'                   16:工程项目 32:统计 64:期间 128:商品 256:项目
'          strCond 特殊条件类返回参数
'          strPeriodName 区间型字段名
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Function ShowFilter(ByVal LngFilterID As Long, lngType As Long) As String

Dim strKey As String
Dim strKeyName As String
Dim rs As rdoResultset
    InitChooseGrd

   mlngKeyType = lngType
   mlngKeyID = LngFilterID

   mlngViewID = Filter.FindViewId(mlngKeyID, mlngKeyType)

   If mlngViewID = 0 Then
       frmFilterSet.picAccountFilt.Enabled = False
'       MsgBox "没有可以设置过滤的项目!"
       Exit Function
   End If


   InitTree
   If frmFilterSet.tvwFilt.Nodes.Count = 0 Then
       frmFilterSet.picAccountFilt.Enabled = False
'       MsgBox "没有可以设置过滤的项目!"
       Exit Function
   End If
   GetSelectd mstrTempSelected
   If frmFilterSet.MsgFilt.Rows > 2 Then
          frmFilterSet.MsgFilt.Row = 1
          MsgFilt_click
   Else
          tvwFilt_nodeClick frmFilterSet.tvwFilt.Nodes(1)
   End If
End Function

Public Function GetCond() As String
  Dim intCount As Integer

    On Error GoTo ErrHandle
    For intCount = 1 To mintMaxSelLines
        If mstrSelected(intCount, 8) <> "" Then
            If GetCond = "" Then
               GetCond = mstrSelected(intCount, 8)
            Else
               GetCond = GetCond & " And " & mstrSelected(intCount, 8)
            End If
        End If
    Next intCount

ErrHandle:
End Function

'初始化条件数组
Public Sub InitCondArr(ByVal ReportID As Long, ByVal ViewId As Long)
  Dim rstCond As rdoResultset, rsTempTable As rdoResultset
  Dim strSql As String


    strSql = "select * from ViewField,ReportFilter" & _
             " Where (ViewField.lngViewFieldID =ReportFilter.lngviewfieldid and ReportFilter.lngReportID=" & ReportID & _
             ") And  ViewField.blnisfilt = 1 and ((viewfield.lngviewid=" & ViewId & "  and ReportFilter.blnHaveFatherNode=0)" & " or ( ReportFilter.blnHaveFatherNode=1 ))"

    Set rstCond = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)

    If rstCond.RowCount = 0 Then
        Set rstCond = Nothing
        ReDim mstrSelected(0, ConNumPerSel)
        ReDim mstrChineseCond(0)
        Exit Sub
    End If

    With rstCond
        .MoveLast
        ReDim mstrSelected(.RowCount + 1, ConNumPerSel)
        ReDim mstrChineseCond(.RowCount + 1)
        mintMaxSelLines = .RowCount
        mlngCurentline = 1
        .MoveFirst
        Do While Not .EOF
            mstrSelected(mlngCurentline, 1) = !strViewFieldDesc
            mstrSelected(mlngCurentline, 2) = IIf(UCase(!strFieldType) = "CODE", !strKeyField, .rdoColumns("strFieldName"))
            mstrSelected(mlngCurentline, 3) = UCase(!strFieldType)
            mstrSelected(mlngCurentline, 4) = !strTableName
            'mstrSelected(mlngCurentline, 9) = IIf(IsNull(!strOthTableName), "", !strOthTableName)
            mstrSelected(mlngCurentline, 10) = .rdoColumns("lngViewFieldID")
            mstrSelected(mlngCurentline, 11) = Trim(!strPath)
            mstrSelected(mlngCurentline, 12) = IIf(IsNull(!strOthTableName), "", !strOthTableName)
            mstrSelected(mlngCurentline, 13) = IIf(IsNull(!strBiaTableName), "", !strBiaTableName)

            Select Case Trim(mstrSelected(mlngCurentline, 3))
                 Case "STRING"
                    mstrSelected(mlngCurentline, 5) = !strStringOP
                    mstrSelected(mlngCurentline, 6) = !strString1
                    CondNumToString True
                 Case "ENUM"
                        mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " IN (" & Trim(!strString2) & ")"
                        mstrSelected(mlngCurentline, 5) = !strString1
                        mstrSelected(mlngCurentline, 6) = !strString2
                 Case "LONG", "INTEGER", "DOUBLE"
                        mstrSelected(mlngCurentline, 5) = Trim(!strDoubleOP)
                        mstrSelected(mlngCurentline, 6) = !dbldouble1
                        Select Case mstrSelected(mlngCurentline, 5)
                              Case "6"
                                mstrSelected(mlngCurentline, 7) = !dbldouble2
                        End Select
                        CondNumToString False
NxtHandle:
            End Select
            If Trim(mstrSelected(mlngCurentline, 12)) <> "" Then
                  mstrSelected(mlngCurentline, 8) = Filter.ModifyTableName(mstrSelected(mlngCurentline, 8), mstrSelected(mlngCurentline, 4) & ".", mstrSelected(mlngCurentline, 12) & ".")
            End If
            mlngCurentline = mlngCurentline + 1
            .MoveNext
        Loop
    End With

End Sub
'取函数中的汉语条件
Public Function GetChineseCond() As String
Dim Index As Long
    '生成中文条件
    mChineseCond = ""
    For Index = 1 To mintMaxSelLines
         If mstrSelected(Index, 5) = "自定义" Or mstrSelected(Index, 5) = "介于" Then
                If mChineseCond = "" Then
                    mChineseCond = Trim(mstrSelected(Index, 11)) & " 介于 （" & mstrSelected(Index, 6) & "," & mstrSelected(Index, 7) & ")"
                Else
                    mChineseCond = mChineseCond & "       " & Trim(mstrSelected(Index, 11)) & " 介于 （" & mstrSelected(Index, 6) & "," & mstrSelected(Index, 7) & ")"
                End If
         Else
                Select Case UCase(Trim(mstrSelected(Index, 3)))
                   Case "ENUM", "BOOLEAN", "DATE", "PERIOD"
                       If mChineseCond = "" Then
                           mChineseCond = Trim(mstrSelected(Index, 11)) & ": " & Trim(mstrSelected(Index, 5))
                       Else
                           mChineseCond = mChineseCond & "       " & Trim(mstrSelected(Index, 11)) & ": " & Trim(mstrSelected(Index, 5))
                       End If
                   Case Else
                       If mChineseCond = "" Then
                           mChineseCond = Trim(mstrSelected(Index, 11)) & " " & Trim(mstrSelected(Index, 5)) & " " & Trim(mstrSelected(Index, 6))
                       Else
                           mChineseCond = mChineseCond & "       " & Trim(mstrSelected(Index, 11)) & " " & Trim(mstrSelected(Index, 5)) & " " & Trim(mstrSelected(Index, 6))
                       End If
                End Select
         End If
    Next
    GetChineseCond = mChineseCond
End Function