clsfilter.cls

金算盘软件代码

                    Case "小于等于"
                       mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " <= " & "'" & frmFilterSet.TxtFromFilt.Text & "'"
                    Case "打头字符为"
                       mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " like " & "'" & Trim(frmFilterSet.TxtFromFilt.Text) & "%' "
                    Case "包含字符"
                       mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " like " & "'" & "%" & Trim(frmFilterSet.TxtFromFilt.Text) & "%'"
                    Case "类似于"
                       mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " like " & "'" & frmFilterSet.TxtFromFilt.Text & "'"
                    Case "不等于"
                       mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " <> " & "'" & frmFilterSet.TxtFromFilt.Text & "'"
                 End Select
             Else
                 MsgBox "无效输入"
                 Exit Sub
             End If
          '** END OF IF 3 **
          End If
             mstrSelected(mlngCurentline, 5) = frmFilterSet.ReferText1Filt.Text
             mstrSelected(mlngCurentline, 6) = frmFilterSet.TxtFromFilt.Text
             AddSelectedTag
             frmFilterSet.MsgFilt.TextMatrix(mlngCurentline, 1) = frmFilterSet.ReferText1Filt.Text & " " & mstrSelected(mlngCurentline, 6)
             AddMsgFilt
        '** END OF IF 2 **
        End If
  '** ELSE OF IF 1 **.
  Else
     If frmFilterSet.ReferText1Filt.Text <> "介于" And Left(frmFilterSet.tvwFilt.Nodes(mlngCurLineOfSelect).Tag, 1) = "*" Then
        '删去当前行
        DelCurentline
     End If
  '** END OF IF 1
  End If
End Sub


'加上已选标记
Private Sub AddSelectedTag()
'   Insert One Line Into MsgFilt
    If Left(frmFilterSet.tvwFilt.Nodes(mlngCurLineOfSelect).Tag, 1) <> "*" Then
          frmFilterSet.tvwFilt.Nodes(mlngCurLineOfSelect).Tag = "*" & frmFilterSet.tvwFilt.Nodes(mlngCurLineOfSelect).Tag
          frmFilterSet.MsgFilt.Rows = frmFilterSet.MsgFilt.Rows + 1
          frmFilterSet.MsgFilt.RowHeight(frmFilterSet.MsgFilt.Rows - 1) = 0
          mintMaxSelLines = frmFilterSet.MsgFilt.Rows - 2
    End If

End Sub

'删去当前行
Private Sub DelCurentline()
  Dim Index As Long
  Dim index2 As Long

  On Error Resume Next
  With frmFilterSet
    .tvwFilt.Nodes(mlngCurLineOfSelect).Tag = Right(.tvwFilt.Nodes(mlngCurLineOfSelect).Tag, Len(.tvwFilt.Nodes(mlngCurLineOfSelect).Tag) - 1)
    .MsgFilt.RemoveItem (mlngCurentline)
    Index = mlngCurentline
    Do While Index < .MsgFilt.Rows - 1
         For index2 = 1 To ConNumPerSel
             mstrSelected(Index, index2) = mstrSelected(Index + 1, index2)
         Next
         Index = Index + 1
    Loop
    .MsgFilt.RowHeight(.MsgFilt.Rows - 1) = 0
    mintMaxSelLines = .MsgFilt.Rows - 2
    If .MsgFilt.Rows - 1 > mlngCurentline Then
       .MsgFilt.Row = mlngCurentline
       MsgFilt_click
    Else
       If mlngCurentline > 1 Then
          .MsgFilt.Row = mlngCurentline - 1
          MsgFilt_click
       End If
    End If
 End With
End Sub



'把当前行加入已选 msgFiter
Private Sub AddMsgFilt()
With frmFilterSet
     .MsgFilt.RowHeight(mlngCurentline) = 255
     .MsgFilt.TextMatrix(mlngCurentline, 0) = mstrSelected(mlngCurentline, 1)
     .MsgFilt.RowData(mlngCurentline) = mstrSelected(mlngCurentline, 9)
     .MsgFilt.ColAlignment(1) = 1
     .MsgFilt.Row = mlngCurentline
     If Not .MsgFilt.RowIsVisible(mlngCurentline) Then
        If mlngCurentline > 5 Then
            .MsgFilt.TopRow = mlngCurentline - 4
        Else
            .MsgFilt.TopRow = mlngCurentline
        End If
     End If
End With
End Sub

'把当前行加入已选数组
Private Sub ModifyReferText1Filt()
  Dim strtemps() As String
  Dim strChineseTemp() As String
  Dim Index As Long
  Dim index2 As Long
        If mblnSelected = False Then
           ReDim strtemps(frmFilterSet.MsgFilt.Rows - 1, 1 To ConNumPerSel) As String
           ReDim strChineseTemp(frmFilterSet.MsgFilt.Rows - 1)
           For Index = 1 To frmFilterSet.MsgFilt.Rows - 2
             For index2 = 1 To ConNumPerSel
                strtemps(Index, index2) = mstrSelected(Index, index2)
             Next
             On Error Resume Next
             strChineseTemp(Index) = mstrChineseCond(Index)
           Next
           ReDim mstrSelected(1 To frmFilterSet.MsgFilt.Rows - 1, 1 To ConNumPerSel)
           ReDim mstrChineseCond(frmFilterSet.MsgFilt.Rows - 1)
           For Index = 1 To frmFilterSet.MsgFilt.Rows - 2
             For index2 = 1 To ConNumPerSel
               mstrSelected(Index, index2) = strtemps(Index, index2)
             Next
             mstrChineseCond(Index) = strChineseTemp(Index)
           Next
        End If
        frmFilterSet.MsgFilt.RowHeight(mlngCurentline) = 255
        mstrSelected(mlngCurentline, 1) = mCurstrTemp(1)
        mstrSelected(mlngCurentline, 2) = mCurstrTemp(2)
        mstrSelected(mlngCurentline, 3) = UCase(mCurstrTemp(3))
        mstrSelected(mlngCurentline, 4) = mCurstrTemp(4)
        mstrSelected(mlngCurentline, 9) = mCurstrTemp(5)
        mstrSelected(mlngCurentline, 10) = mCurstrTemp(6)
        mstrSelected(mlngCurentline, 11) = mCurstrTemp(7)
        mstrSelected(mlngCurentline, 12) = mCurstrTemp(8)
        mstrSelected(mlngCurentline, 13) = mCurstrTemp(9)
End Sub

Private Sub EnumHandle(ByVal NodeIndex%)
  Dim Index As Integer
  Dim resCord As rdoResultset
  Dim strSql As String
    frmFilterSet.ReferText1Filt.ClearRefer
    Index = Position(NodeIndex)
    mlngCurentline = Index
    frmFilterSet.ReferText1Filt.ColAlignment(0) = 1
    frmFilterSet.ReferText1Filt.SeekCol = "-1,1"
    '加第2类数据
    Select Case UCase(mCurstrTemp(1))
        Case "税率"
            strSql = "select distinct Tax.strTaxname || ' ' || Tax.dblPurchaseTaxRate || '%' || ' ' || Tax.dblSaleTaxRate || '%' from Tax"
        Case Else
            strSql = "select strEnumNumber from EnumTable WHERE " & "LTrim( Rtrim(Enumtable.strViewFieldDesc) )='" & mCurstrTemp(1) & "' " & strCondVersionEnum
    End Select
    Set resCord = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    Set frmFilterSet.ReferText1Filt.Recordset = resCord
    If resCord.RowCount > 0 Then
        frmFilterSet.ReferText1Filt.ColWidth(1) = 2500
        resCord.MoveLast
        resCord.Close
    End If
   '加第1类数据
    frmFilterSet.ReferText1Filt.AddRefer "所有"
    If frmFilterSet.ReferText1Filt.Referrows > 4 Then
                frmFilterSet.ReferText1Filt.AddRefer "选择项目"
    End If
  If mblnSelected = True Then
      If InStr(mstrSelected(mlngCurentline, 5), ",") > 0 Then
        frmFilterSet.ReferText1Filt.Text = "选择项目"
      Else
        frmFilterSet.ReferText1Filt.Text = mstrSelected(mlngCurentline, 5)
      End If
  Else
      frmFilterSet.ReferText1Filt.ReferRow = 0
  End If
  Exit Sub
End Sub


'字符串型处理
Private Sub StringHandle(NodeIndex%)
 Dim Index  As Long
   frmFilterSet.ReferText1Filt.ClearRefer
   frmFilterSet.ReferText1Filt.SeekCol = "-1,1"
   frmFilterSet.ReferText1Filt.AddRefer "任意"
   frmFilterSet.ReferText1Filt.AddRefer "等于"
   frmFilterSet.ReferText1Filt.AddRefer "大于"
   frmFilterSet.ReferText1Filt.AddRefer "小于"
   frmFilterSet.ReferText1Filt.AddRefer "不等于"
   frmFilterSet.ReferText1Filt.AddRefer "大于等于"
   frmFilterSet.ReferText1Filt.AddRefer "小于等于"
   frmFilterSet.ReferText1Filt.AddRefer "打头字符为"
   frmFilterSet.ReferText1Filt.AddRefer "包含字符"
   frmFilterSet.ReferText1Filt.Referrows = 9
   frmFilterSet.ReferText1Filt.AddRefer "类似于"
   frmFilterSet.ReferText1Filt.ColWidth(1) = 1000
'   frmFilterSet.ReferText1Filt.ColWidth(2) = 0
    Index = Position(NodeIndex)
    mlngCurentline = Index
    If mblnSelected = True Then
       frmFilterSet.TxtFromFilt.Visible = True
       frmFilterSet.ReferText1Filt.Text = mstrSelected(Index, 5)
       frmFilterSet.TxtFromFilt.Text = mstrSelected(mlngCurentline, 6)
    Else
       frmFilterSet.ReferText1Filt.ReferRow = 0
    End If
End Sub

'查找当前树接点对应的已选数组行
Private Function Position(NodeIndex) As Long
  Dim Index As Long
  If frmFilterSet.MsgFilt.Rows <= 2 Then
    Position = 1
    Exit Function
  End If
  For Index = 1 To frmFilterSet.MsgFilt.Rows - 2
    If mstrSelected(Index, 9) = NodeIndex Then
        Position = Index
        Exit Function
    End If
  Next
  Position = frmFilterSet.MsgFilt.Rows - 1
End Function

'数字型处理
Private Sub NumberHandle(NodeIndex%)
 Dim Index As Long
 With frmFilterSet
   .ReferText1Filt.SeekCol = "-1,1"
   .ReferText1Filt.AddRefer "任意"
   .ReferText1Filt.AddRefer "零或空值"
   .ReferText1Filt.AddRefer "等于"
   .ReferText1Filt.AddRefer "大于"
   .ReferText1Filt.AddRefer "小于"
   .ReferText1Filt.AddRefer "不等于"
   .ReferText1Filt.AddRefer "大于等于"
   .ReferText1Filt.AddRefer "小于等于"
   .ReferText1Filt.Referrows = 8
   .ReferText1Filt.AddRefer "介于"
     Index = Position(NodeIndex)
     mlngCurentline = Index
  If mblnSelected = True Then
     .ReferText1Filt.Text = mstrSelected(Index, 5)
     If .ReferText1Filt.Text <> "零或空值" Then
        .TxtFromFilt.Visible = True
        If .ReferText1Filt.Text = "介于" Then
           .TxtFromFilt.Text = mstrSelected(mlngCurentline, 6)
           .TxtToFilt.Text = mstrSelected(mlngCurentline, 7)
           .TxtToFilt.Visible = True
           .lblFromFilt.Visible = True
           .lblToFilt.Visible = True
        Else
           .TxtFromFilt.Text = mstrSelected(mlngCurentline, 6)
        End If
    End If
  Else
     .ReferText1Filt.ReferRow = 0
  End If
 End With
End Sub


Public Sub TxtToFilt_KeyDown(KeyCode As Integer, Shift As Integer)
 If KeyCode = vbKeyReturn Then
    With frmFilterSet
        If .TxtFromFilt.Text = "" Then
         .TxtFromFilt.SetFocus
        Else
         .tvwFilt.SetFocus
        End If
     End With
 End If
End Sub

Public Sub TxtToFilt_lostfocus()
With frmFilterSet
    If mItemNotExit = True Then Exit Sub
    If Trim(.ReferText1Filt.Text) <> "介于" Then Exit Sub
    .TxtToFilt.Text = Trim(.TxtToFilt.Text)
    .TxtFromFilt.Text = Trim(.TxtFromFilt.Text)
    If .ActiveControl.Name = "txtFromFilt" Or .ActiveControl.Name = "ReferText1Filt" Then Exit Sub
    If .TxtToFilt.Text = "" Then
      Exit Sub
    ElseIf Not IsNumeric(.TxtToFilt.Text) Or Right(.TxtToFilt.Text, 1) = "-" Or InStr(frmFilterSet.TxtToFilt.Text, ",") > 0 Then
      MsgBox "输入的不是数字"
      Exit Sub
    End If
    If IsNumeric(.TxtFromFilt.Text) And InStr(.TxtFromFilt.Text, ",") = 0 Then
       If CDbl(.TxtFromFilt.Text) > CDbl(.TxtToFilt.Text) Then
           MsgBox ("请输入一个大于起始值的值")
           Exit Sub
        Else
        If UCase(mCurstrTemp(3)) = "INTEGER" Then
           If InStr(frmFilterSet.TxtToFilt.Text, ".") > 0 Then
               MsgBox "请输入整数"
               Exit Sub
           End If
        End If
         '把当前行加入已选数组
          ModifyReferText1Filt
          mstrSelected(mlngCurentline, 5) = .ReferText1Filt.Text
          mstrSelected(mlngCurentline, 6) = Trim(.TxtFromFilt.Text)
          mstrSelected(mlngCurentline, 7) = Trim(.TxtToFilt.Text)
          mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & " >= " & Trim(mstrSelected(mlngCurentline, 6)) & " and " & mstrSelected(mlngCurentline, 2) & " <= " & Trim(mstrSelected(mlngCurentline, 7))
          AddSelectedTag
          .MsgFilt.TextMatrix(mlngCurentline, 1) = mstrSelected(mlngCurentline, 5) & "  (" & Trim(.TxtFromFilt.Text) & " ," & Trim(mstrSelected(mlngCurentline, 7)) & ")"
          AddMsgFilt
        End If
     End If
End With
End Sub


'初始化树
Private Sub InitTree()
    frmFilterSet.ReferText1Filt.Locked = False
    frmFilterSet.tvwFilt.Sorted = False
    frmFilterSet.tvwFilt.LabelEdit = tvwManual
    frmFilterSet.tvwFilt.SingleSel = False
   #If conVersionType = 1 Then
        strCondVersionField = " And (ViewField.bytVersion IN (1,3,7,5,9,11,13,15,17,19,21,23,25,27,29,31))"
        strCondVersionEnum = " And (EnumTable.bytVersion IN (1,3,7,5,9,11,13,15,17,19,21,23,25,27,29,31))"
        strCondVersion = "(1,3,5,7,9,11,13,15,17,19,21,23,25,27,29,31)"
   #Else
      #If conVersionType = 2 Then
      #Else
        #If conVersionType = 4 Then
            strCondVersionField = " And (ViewField.bytVersion IN (4,5,6,7,12,13,14,15,20,21,22,23,28,29,30,31))"
            strCondVersionEnum = " And (EnumTable.bytVersion IN (4,5,6,7,12,13,14,15,20,21,22,23,28,29,30,31))"
            strCondVersion = "(4,5,6,7,12,13,14,15,20,21,22,23,28,29,30,31)"
        #ElseIf conVersionType = 8 Then
            strCondVersionField = " And (ViewField.bytVersion IN (8,9,10,11,12,13,14,15,24,25,26,27,28,29,30,31))"
            strCondVersionEnum = " And (EnumTable.bytVersion IN (8,9,10,11,12,13,14,15,24,25,26,27,28,29,30,31))"
            strCondVersion = "(8,9,10,11,12,13,14,15,24,25,26,27,28,29,30,31)"
        #Else