clsfilter.cls

金算盘软件代码

      Case "ENUM"
         .LblselFilt.Caption = strViewFieldDesc
         EnumHandle Node.Index
      Case "STRING"
         .LblselFilt.Caption = strViewFieldDesc
         StringHandle Node.Index
      Case "LONG", "DOUBLE", "INTEGER"
         .LblselFilt.Caption = strViewFieldDesc
         .TxtFromFilt.MaxLength = 18
         .TxtToFilt.MaxLength = 18
         NumberHandle Node.Index
      Case Else
         Exit Sub
  End Select
 End With
'当前行已选时,使对应 MsgFiltLine 可见
  If mblnSelected Then
        frmFilterSet.MsgFilt.Row = mlngCurentline
  Else
        frmFilterSet.MsgFilt.Row = frmFilterSet.MsgFilt.Rows - 1
  End If
  If Not frmFilterSet.MsgFilt.RowIsVisible(mlngCurentline) Then
    If mlngCurentline > frmFilterSet.MsgFilt.TopRow Then
      frmFilterSet.MsgFilt.TopRow = mlngCurentline - 3
    Else
      frmFilterSet.MsgFilt.TopRow = mlngCurentline
     End If
  End If
  With frmFilterSet.MsgFilt
    On Error Resume Next
    .SetFocus
    .col = 0
    .ColSel = 1
  End With
End Sub

'ADD
Private Function PositionNode(strPath As String) As Long
 Dim blnFinded As Boolean
 Dim Index As Long
 Dim index2 As Long
 Dim strTemp As String
    index2 = 1
    Set mFilterNode = frmFilterSet.tvwFilt.Nodes(index2)
    blnFinded = False
    Do While index2 < frmFilterSet.tvwFilt.Nodes.Count + 1 And blnFinded = False
        If frmFilterSet.tvwFilt.Nodes(index2).Key <> strPath Then
            index2 = index2 + 1
        Else
            blnFinded = True
        End If
    Loop
    PositionNode = index2
    mstrSelected(frmFilterSet.MsgFilt.Row, 9) = index2
End Function

Public Sub MsgFilt_click()
 Dim Index As Long
 Dim index2 As Long
 Dim lngTemp As Long
 Dim strPath As String
 Dim strTemp As String
 Dim strSinglePath() As String
 mblnReferText1Filt = False
 If frmFilterSet.MsgFilt.Row = 0 Or frmFilterSet.MsgFilt.Row = frmFilterSet.MsgFilt.Rows - 1 Then Exit Sub
 Index = frmFilterSet.MsgFilt.RowData(frmFilterSet.MsgFilt.Row)
 If Index = 0 Then
    strPath = mstrSelected(frmFilterSet.MsgFilt.Row, 11)
    Index = PositionNode(strPath)

 Else
    If Not frmFilterSet.tvwFilt.SelectedItem Is Nothing Then
       If Index = frmFilterSet.tvwFilt.SelectedItem.Index Then Exit Sub
    End If
 End If
'使对应的树接点可见
 mMaxNodesNumber = frmFilterSet.tvwFilt.Nodes.Count
 If Index >= 0 And Index < mMaxNodesNumber + 1 Then
    frmFilterSet.tvwFilt.Nodes(Index).EnsureVisible
    frmFilterSet.tvwFilt.Nodes(Index).Selected = True
   '初始化界面
    tvwFilt_nodeClick frmFilterSet.tvwFilt.Nodes(Index)
 End If
 With frmFilterSet.MsgFilt
  On Error Resume Next
  .SetFocus
  .col = 0
  .ColSel = 1
 End With
End Sub



Public Sub refertext1Filt_Choose()
 Dim Index As Long
 Dim blnMulAccount As Boolean
     mItemNotExit = False
     If mblnReferText1Filt = False Then Exit Sub
     mblnReferText1Filt = False
  With frmFilterSet
     .TxtFromFilt.Text = ""
     .TxtToFilt.Text = ""
     .lblFromFilt.Visible = False
     .lblToFilt.Visible = False
     Select Case Trim(.ReferText1Filt.Text)
         Case ""
            .TxtFromFilt.Visible = False
            .TxtToFilt.Visible = False
            Exit Sub
         Case "任意", "所有"
            .TxtFromFilt.Visible = False
            .TxtToFilt.Visible = False
            If Left(.tvwFilt.Nodes(mlngCurLineOfSelect).Tag, 1) = "*" Then
                '清除当前行
                DelCurentline
            End If
            Exit Sub
        Case "零或空值"
            '把当前行加入已选数组
            .TxtFromFilt.Visible = False
            .TxtToFilt.Visible = False
            ModifyReferText1Filt
            mstrSelected(mlngCurentline, 5) = .ReferText1Filt.Text
            mstrSelected(mlngCurentline, 6) = ""
            mstrSelected(mlngCurentline, 7) = ""
            mstrSelected(mlngCurentline, 8) = "(" & mstrSelected(mlngCurentline, 2) & " IS NULL or " & mstrSelected(mlngCurentline, 2) & "=0) "
            AddSelectedTag
            .MsgFilt.TextMatrix(mlngCurentline, 1) = .ReferText1Filt.Text
            AddMsgFilt
            Exit Sub
        Case "介于"
            .TxtToFilt.Visible = True
            .TxtFromFilt.Visible = True
            .TxtFromFilt.SetFocus
            .lblFromFilt.Visible = True
            .lblToFilt.Visible = True
            Exit Sub
        Case "选择项目"
            Dim strMulsel As String
            Dim strKeyCode As String
            Dim blnOK As Boolean
            If Left(.tvwFilt.Nodes(mlngCurLineOfSelect).Tag, 1) = "*" Then
                If frmFilterSet.MsgFilt.Rows > 2 Then
                        strKeyCode = Trim(mstrSelected(mlngCurentline, 5))
                Else
                    strKeyCode = ""
                End If
            Else
                strKeyCode = ""
            End If
            '把当前行加入已选数组
            ModifyReferText1Filt
            If Left(.tvwFilt.Nodes(mlngCurLineOfSelect).Tag, 1) <> "*" Then
                .MsgFilt.RowHeight(mlngCurentline) = 0
            End If

            '调用多选界面
            Dim FrmMultiSelect As frmAccountFilter
            Set FrmMultiSelect = New frmAccountFilter
            Dim strTemp As String
                FrmMultiSelect.AccountFilter mstrSelected(mlngCurentline, 1), strKeyCode, True
                If FrmMultiSelect.mTagShow = True Then
                    FrmMultiSelect.Show vbModal
                End If
                strMulsel = FrmMultiSelect.strCodeTerm
                strKeyCode = FrmMultiSelect.strOK
                blnOK = FrmMultiSelect.mblnOk
                Set FrmMultiSelect = Nothing
                If blnOK = False Then
                    Exit Sub
                End If
                If Trim(strMulsel) <> "" Then
                    strTemp = Trim(strKeyCode)
                    mstrSelected(mlngCurentline, 5) = strKeyCode
                    mstrSelected(mlngCurentline, 6) = Trim(strMulsel)
                    mstrSelected(mlngCurentline, 8) = Trim(mstrSelected(mlngCurentline, 2)) & " IN (" & Trim(strMulsel) & ")"
                    AddSelectedTag
                    .MsgFilt.TextMatrix(mlngCurentline, 1) = strKeyCode
                    AddMsgFilt
                ElseIf Left(.tvwFilt.Nodes(mlngCurLineOfSelect).Tag, 1) = "*" Then
                    DelCurentline
                    Exit Sub
                End If
        Exit Sub
        'NOT MulSel CodeClass　Handle
        Case Else
            '把当前行加入已选数组
            '** IF 1 **
            If UCase(mCurstrTemp(3)) = "CODE" Or UCase(mCurstrTemp(3)) = "ENUM" Then
                 ModifyReferText1Filt
                 mstrSelected(mlngCurentline, 5) = .ReferText1Filt.Text
                 .ReferText1Filt.SelStart = 0
                    mstrSelected(mlngCurentline, 6) = "'" & Trim(mstrSelected(mlngCurentline, 5)) & "'"
                    mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " in (" & Trim(mstrSelected(mlngCurentline, 6)) & ")"
NextHandle:
                 AddSelectedTag
                 .MsgFilt.TextMatrix(mlngCurentline, 1) = Trim(mstrSelected(mlngCurentline, 5))
                 AddMsgFilt
                 Exit Sub
            Else
                .TxtFromFilt.Visible = True
                .TxtToFilt.Visible = False
                .TxtFromFilt.SetFocus
            End If
     End Select
   End With
End Sub

Public Sub txtfromFilt_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then
      KeyCode = vbKeyClear
      If frmFilterSet.TxtFromFilt.Text <> "" Then
        If frmFilterSet.TxtToFilt.Visible = True Then
             frmFilterSet.TxtToFilt.SetFocus
        Else
             frmFilterSet.tvwFilt.SetFocus
        End If
      End If
  End If
End Sub
Public Sub txtToFilt_Change()
  With frmFilterSet
    If Not IsNumeric(.TxtToFilt.Text) And Trim(.TxtToFilt.Text) <> "" And Trim(.TxtToFilt.Text) <> "-" Then
        .TxtToFilt.Text = Left(.TxtToFilt.Text, Len(.TxtToFilt.Text) - 1)
        SendKeys "{ENd}", True
    End If
  End With
End Sub
Public Sub txtFromFilt_Change()
 With frmFilterSet
  If UCase(mCurstrTemp(3)) = "LONG" Or UCase(mCurstrTemp(3)) = "DOUBLE" Or UCase(mCurstrTemp(3)) = "INTEGER" Then
      If Not IsNumeric(.TxtFromFilt.Text) And Trim(.TxtFromFilt.Text) <> "" And Trim(.TxtFromFilt.Text) <> "-" Then
        .TxtFromFilt.Text = Left(.TxtFromFilt.Text, Len(.TxtFromFilt.Text) - 1)
        SendKeys "{ENd}", True
      End If
  End If
 End With
End Sub

Public Sub txtfromFilt_LostFocus()
  If mItemNotExit = True Then Exit Sub
  '** IF 1 **
  If frmFilterSet.ActiveControl.Name = "txtToFilt" Or frmFilterSet.ActiveControl.Name = "ReferText1Filt" Then Exit Sub
  If Trim(frmFilterSet.TxtFromFilt.Text) <> "" Then
      frmFilterSet.TxtFromFilt.Text = Trim(frmFilterSet.TxtFromFilt.Text)
      '** IF 2 **
      If frmFilterSet.ReferText1Filt.Text = "介于" Then
           If Not IsNumeric(frmFilterSet.TxtFromFilt.Text) Or Right(frmFilterSet.TxtFromFilt.Text, 1) = "-" Or InStr(frmFilterSet.TxtFromFilt.Text, ",") > 0 Then
               MsgBox "输入的不是数字"
               Exit Sub
           Else
              If UCase(mCurstrTemp(3)) = "INTEGER" Then
                If InStr(frmFilterSet.TxtFromFilt.Text, ".") > 0 Then
                   MsgBox "请输入整数."
                   Exit Sub
                End If
              End If
              If (Not IsNumeric(frmFilterSet.TxtToFilt.Text)) Or InStr(frmFilterSet.TxtToFilt.Text, ",") > 0 Then
                 Exit Sub
              Else
                 If CDbl(frmFilterSet.TxtFromFilt.Text) > CDbl(frmFilterSet.TxtToFilt.Text) Then
                      MsgBox ("请输入一个小于截止值的值")
                      Exit Sub
                 End If
              End If
           End If
           '把当前行加入已选数组
           ModifyReferText1Filt
           mstrSelected(mlngCurentline, 5) = frmFilterSet.ReferText1Filt.Text
           mstrSelected(mlngCurentline, 6) = frmFilterSet.TxtFromFilt.Text
           mstrSelected(mlngCurentline, 7) = frmFilterSet.TxtToFilt.Text
           mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " >= " & Trim(mstrSelected(mlngCurentline, 6)) & " and " & mstrSelected(mlngCurentline, 2) & " <= " & Trim(mstrSelected(mlngCurentline, 7))
           AddSelectedTag
           frmFilterSet.MsgFilt.TextMatrix(mlngCurentline, 1) = frmFilterSet.ReferText1Filt.Text & " (" & frmFilterSet.TxtFromFilt.Text & " , " & frmFilterSet.TxtToFilt.Text & ")"
           AddMsgFilt
           Exit Sub
      '** ELSE OF IF 2 **
      Else
          '** IF 3 **
          If UCase(mCurstrTemp(3)) = "LONG" Or UCase(mCurstrTemp(3)) = "DOUBLE" Or UCase(mCurstrTemp(3)) = "INTEGER" Then
             If Not IsNumeric(frmFilterSet.TxtFromFilt.Text) Or Right(frmFilterSet.TxtFromFilt.Text, 1) = "-" Or InStr(frmFilterSet.TxtFromFilt.Text, ",") > 0 Then
                 MsgBox "输入的不是数字"
                 Exit Sub
             Else
                 If UCase(mCurstrTemp(3)) = "INTEGER" Then
                    If InStr(frmFilterSet.TxtFromFilt.Text, ".") > 0 Then
                        MsgBox "请输入整数."
                        Exit Sub
                    End If
                 End If
                 '把当前行加入已选数组
                  ModifyReferText1Filt
                  Select Case frmFilterSet.ReferText1Filt.Text
                    Case "等于"
                       mstrSelected(mlngCurentline, 5) = " = "
                    Case "大于"
                       mstrSelected(mlngCurentline, 5) = " > "
                    Case "小于"
                       mstrSelected(mlngCurentline, 5) = " < "
                    Case "大于等于"
                       mstrSelected(mlngCurentline, 5) = " >= "
                    Case "小于等于"
                       mstrSelected(mlngCurentline, 5) = " <= "
                    Case "不等于"
                       mstrSelected(mlngCurentline, 5) = " <> "
                  End Select
                  mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & mstrSelected(mlngCurentline, 5) & Trim(frmFilterSet.TxtFromFilt.Text)
                  mstrChineseCond(mlngCurentline) = mstrSelected(mlngCurentline, 11) & mstrSelected(mlngCurentline, 5) & Trim(frmFilterSet.TxtFromFilt.Text)
             End If
          '** ELSE OF IF 3 **
          Else
             If UCase(mCurstrTemp(3)) = "STRING" Then
                If Filter.NotValild(frmFilterSet.TxtFromFilt.Text) Then
                    MsgBox "输入了非法字符,如:单引号."
                    Exit Sub
                End If
                If Len(frmFilterSet.TxtFromFilt.Text) > 255 Then
                    MsgBox "输入的字符串长度超过了允许录入的最大字符个数--255,请重新录入."
                    Exit Sub
                End If
                '把当前行加入已选数组
                 ModifyReferText1Filt
                 Select Case frmFilterSet.ReferText1Filt.Text
                    Case "等于"
                       mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " = " & "'" & frmFilterSet.TxtFromFilt.Text & "'"
                    Case "大于"
                       mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " > " & "'" & frmFilterSet.TxtFromFilt.Text & "'"
                    Case "小于"
                       mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " < " & "'" & frmFilterSet.TxtFromFilt.Text & "'"
                    Case "大于等于"
                       mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " >= " & "'" & frmFilterSet.TxtFromFilt.Text & "'"