frmfilter.frm

金算盘软件代码

Private Sub tvwFilter_Expand(ByVal Node As msComctlLib.Node)
 Dim RsCord As rdoResultset
 Dim strSql As String
 Dim lngNodeIndex As Long
 Dim Index As Long
 Dim OthTableName As String
    Node.iMage = "open"
    If Node.Child.Text = "Null" Then
        OthTableName = Right(Node.Tag, Len(Node.Tag) - InStr(Node.Tag, "@"))
        lngNodeIndex = Node.Index
        strSql = "select * from viewfield where blnisfilter=1 and lngviewId =" & Node.Child.Tag & strCondVersionField & "  order by  ViewField.lngViewFieldNo "
        Set RsCord = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        RsCord.MoveFirst
        '替代第一个空子接点
        Set mNode = Node.Child
        mNode.Key = Node.Key & "/" & RsCord!strViewFieldDesc
        mNode.Text = RsCord!strViewFieldDesc
        mNode.iMage = "book"
        mNode.Tag = Trim(RsCord.rdoColumns("strViewFielddesc") & "`" & IIf(UCase(RsCord!strFieldType) = "CODE", RsCord!strKeyField, RsCord.rdoColumns("strFieldName")) & "`" & RsCord.rdoColumns("strTableName") & "`" & RsCord.rdoColumns("strFieldType") & "`" & RsCord.rdoColumns("lngViewFieldID") & "`" & OthTableName & "@" & RsCord!strBiaTableName)
        '遍历已选条件,对未置已选标志的树接点置相应标志
        Index = 1
        For Index = 1 To MsgFilter.Rows - 2
            If MsgFilter.RowData(Index) = 0 Then
                If mstrSelected(Index, 11) = mNode.Key Then
                    mNode.Tag = "*" & mNode.Tag
                    MsgFilter.RowData(Index) = mNode.Index
                    mstrSelected(Index, 9) = mNode.Index
                    Exit For
                End If
            End If
        Next
        If RsCord!lngCodeViewID > 0 And RsCord!blnIschildCond = 1 Then
               mNode.iMage = "closed"
               Set mNode = tvwFilter.Nodes.Add(mNode.Index, tvwChild, "/rschild" & mNode.Index & RsCord.AbsolutePosition, "Null", "book")
               mNode.Tag = RsCord!lngCodeViewID
        End If
        
        '加其他子接点
        On Error GoTo EndHandle
        RsCord.MoveNext
        Do While Not RsCord.EOF
            Set mNode = tvwFilter.Nodes.Add(lngNodeIndex, tvwChild, Node.Key & "/" & RsCord!strViewFieldDesc, RsCord!strViewFieldDesc, "book")
            mNode.Tag = Trim(RsCord.rdoColumns("strViewFielddesc") & "`" & IIf(UCase(RsCord!strFieldType) = "CODE", RsCord!strKeyField, RsCord.rdoColumns("strFieldName")) & "`" & RsCord.rdoColumns("strTableName") & "`" & RsCord.rdoColumns("strFieldType") & "`" & RsCord.rdoColumns("lngViewFieldID") & "`" & OthTableName & "@" & RsCord!strBiaTableName)
           '遍历已选条件,对未置已选标志的树接点置相应标志
            Index = 1
            For Index = 1 To MsgFilter.Rows - 2
                If MsgFilter.RowData(Index) = 0 Then
                    If mstrSelected(Index, 11) = mNode.Key Then
                        mNode.Tag = "*" & mNode.Tag
                        MsgFilter.RowData(Index) = mNode.Index
                        mstrSelected(Index, 9) = mNode.Index
                        Exit For
                    End If
                End If
            Next
            If RsCord!lngCodeViewID > 0 And RsCord!blnIschildCond Then
                   mNode.iMage = "closed"
                   Set mNode = tvwFilter.Nodes.Add(mNode.Index, tvwChild, "/rschild" & mNode.Index & RsCord.AbsolutePosition, "Null", "book")
                   mNode.Tag = RsCord!lngCodeViewID
            End If
            RsCord.MoveNext
        Loop
EndHandle:
        RsCord.Close
    End If
End Sub

'单击树或者,MsgFilter.Row 改变或者单击
Private Sub tvwFilter_nodeClick(ByVal Node As msComctlLib.Node)
 '当前行参数变量
 Dim strViewFieldDesc As String
 Dim strFieldName As String
 Dim strFieldType As String
 Dim strTableName As String
 Dim strViewFieldID As String
 Dim strPath As String
 Dim strBiaTableName As String
 Dim strOthTableName As String

 Dim strTemp As String
 Dim lngTemp As Long
 
 Dim Index As Long
    picAccount.Enabled = False
    picDate.Enabled = False
    '树接点索引值
    mCurLineOfSelect = Node.Index
    mblnSelected = False
    mblnRefertext1 = False
    mblnRefertext2 = False
    mItemNotExit = False
 
    '初始化当前行参数
    strPath = Node.Key
    strTemp = Trim(Node.Tag)
    lngTemp = InStr(strTemp, "@")
    strOthTableName = Right(strTemp, Len(strTemp) - lngTemp)
    strTemp = Left(strTemp, lngTemp - 1)
    lngTemp = InStr(strTemp, "`")
    strViewFieldDesc = Trim(Left(strTemp, lngTemp - 1))
    strTemp = Right(strTemp, Len(strTemp) - lngTemp)
    lngTemp = InStr(strTemp, "`")
    strFieldName = Trim(Left(strTemp, lngTemp - 1))
    strTemp = Trim(Right(strTemp, Len(strTemp) - lngTemp))
    lngTemp = InStr(strTemp, "`")
    strTableName = Trim(Left(strTemp, lngTemp - 1))
    strTemp = Trim(Right(strTemp, Len(strTemp) - lngTemp))
    lngTemp = InStr(strTemp, "`")
    strFieldType = Trim(Left(strTemp, lngTemp - 1))
    strTemp = Trim(Right(strTemp, Len(strTemp) - lngTemp))
    lngTemp = InStr(strTemp, "`")
    strViewFieldID = Trim(Left(strTemp, lngTemp - 1))
    strTemp = Trim(Right(strTemp, Len(strTemp) - lngTemp))
    strBiaTableName = strTemp
    
    
    If Left(strViewFieldDesc, 1) = "*" Then
       mblnSelected = True
       strViewFieldDesc = Right(strViewFieldDesc, Len(strViewFieldDesc) - 1)
    Else
       If MsgFilter.Rows > 26 Then
            MsgBox "你设置的条件已经有25个之多了,你将不能再多设条件,只能修改或者减少已设条件."
            Exit Sub
       End If
    End If
    '暂存单前行参数
    mCurstrTemp(1) = strViewFieldDesc
    mCurstrTemp(2) = strFieldName
    mCurstrTemp(3) = UCase(strFieldType)
    mCurstrTemp(4) = strTableName
    mCurstrTemp(5) = Node.Index
    mCurstrTemp(6) = strViewFieldID
    mCurstrTemp(7) = strPath
    mCurstrTemp(8) = strBiaTableName
    mCurstrTemp(9) = strOthTableName
    
    ReferText1.ClearRefer
    ReferText1.Referrows = 0
    TxtFrom.Text = ""
    TxtTo.Text = ""
    TxtFrom.Visible = False
    TxtTo.Visible = False
    lblFrom2.Visible = False
    lblTo2.Visible = False
    ReferText1.CodeSort = False
    Select Case UCase(strFieldType)
      Case "CODE"
         picAccount.ZOrder 0
         picAccount.Enabled = True
         Lblsel.Caption = strViewFieldDesc & "(&D)"
         ReferText1.CodeSort = True
         CodeHandle Node.Index
      Case "ENUM"
         picAccount.ZOrder 0
         picAccount.Enabled = True
         Lblsel.Caption = strViewFieldDesc & "(&D)"
         EnumHandle Node.Index
      Case "STRING"
         picAccount.ZOrder 0
         picAccount.Enabled = True
         Lblsel.Caption = strViewFieldDesc & "(&D)"
         TxtFrom.MaxLength = 254
         TxtTo.MaxLength = 254
         StringHandle Node.Index
        If strViewFieldDesc = "进入时间" Or strViewFieldDesc = "退出时间" Then
             ReferText1.ToolTipText = "约定时间格式为 hh:mm:ss 如:" & Format(Time, "hh:mm:ss")
             picAccount.ToolTipText = "约定时间格式为 hh:mm:ss 如:" & Format(Time, "hh:mm:ss")
        Else
            ReferText1.ToolTipText = ""
            picAccount.ToolTipText = ""
        End If
      Case "LONG", "DOUBLE", "INTEGER"
         picAccount.ZOrder 0
         picAccount.Enabled = True
         Lblsel.Caption = strViewFieldDesc & "(&D)"
         TxtFrom.MaxLength = 18
         TxtTo.MaxLength = 18
         NumberHandle Node.Index
      Case "PERIOD"
         picDate.ZOrder 0
         picDate.Enabled = True
         LblTerm.Caption = strViewFieldDesc & "(&D)"
         lblFrom.Visible = True
         lblTo.Visible = True
         PeriodHandle Node.Index
      Case "DATE"
         picDate.ZOrder 0
         picDate.Enabled = True
         LblTerm.Caption = strViewFieldDesc & "(&D)"
         DateHandle Node.Index
      Case "BOOLEAN"
         picAccount.ZOrder 0
         picAccount.Enabled = True
         Lblsel.Caption = strViewFieldDesc & "(&D)"
         BooleanHandle Node.Index
      Case Else
         Exit Sub
  End Select
'当前行已选时,使对应 MsgFilterLine 可见
  If mblnSelected Then
        MsgFilter.Row = mCurentline
  Else
        MsgFilter.Row = MsgFilter.Rows - 1
  End If
  If Not MsgFilter.RowIsVisible(mCurentline) Then
    If mCurentline > MsgFilter.TopRow Then
      MsgFilter.TopRow = mCurentline - 3
    Else
      MsgFilter.TopRow = mCurentline
     End If
  End If
'  With MsgFilter
'    On Error Resume Next
'    .SetFocus
'    .col = 0
'    .ColSel = 1
'  End With
End Sub
 
'区间型处理
Private Sub PeriodHandle(NodeIndex As Long)
  Dim Index As Long
     ReferText2.ZOrder 0
     ReferText2.Visible = True
     DateOne.Visible = False
     DateFrom.Visible = True
     DateTo.Visible = True
     DateFrom.Text = ""
     DateTo.Text = ""
     ReferText2.ClearRefer
     If mCurstrTemp(1) <> "出生日期" Then
        Utility.InitDate ReferText2
        ReferText2.ColWidth(1) = 1000
     Else
        ReferText2.AddRefer "所有"
        ReferText2.AddRefer "自定义"
        ReferText2.ColWidth(1) = 600
     End If
     Index = Position(NodeIndex)
     mCurentline = Index
     If mblnSelected Then
        ReferText2.Text = mstrSelected(Index, 5)
        DateFrom.Text = Format(mstrSelected(Index, 6), "yyyy-mm-dd")
        DateTo.Text = Format(mstrSelected(Index, 7), "yyyy-mm-dd")
     Else
         ReferText2.ReferRow = 0
     End If
 End Sub
 
'单一日期型处理
Private Sub DateHandle(NodeIndex As Long)
  Dim Index As Long
        ReferText2.Visible = False
        lblFrom.Visible = False
        lblTo.Visible = False
        DateFrom.Visible = False
        DateTo.Visible = False
        DateOne.ZOrder 0
        DateOne.Visible = True
        DateOne.Text = ""
        Index = Position(NodeIndex)
        mCurentline = Index
        If mblnSelected Then
            DateOne.Text = Format(mstrSelected(Index, 5), "yyyy-mm-dd")
        Else
            DateOne.Text = ""
        End If
End Sub

'定位当前选择行(msgFilter中)到树接点的位置
Private Function PositionNode(strSinglePath() As String, maxIndex As Long) As Long
 Dim blnFinded As Boolean
 Dim Index As Long
 Dim index2 As Long
 Dim strTemp As String
    index2 = 1
    For Index = 1 To maxIndex - 1
        Set mNode = tvwFilter.Nodes(index2)
        blnFinded = False
        '定位第Index级接点
        Do While index2 < tvwFilter.Nodes.Count + 1 And blnFinded = False
            If tvwFilter.Nodes(index2).Key <> strSinglePath(Index) Then
                index2 = index2 + 1
            Else
                blnFinded = True
            End If
        Loop
        If tvwFilter.Nodes(index2).Children > 0 Then tvwFilter_Expand tvwFilter.Nodes(index2)  '加第Index级子接点
        index2 = tvwFilter.Nodes(index2).Child.Index
    Next
    Do While index2 <= tvwFilter.Nodes.Count
        '定位最后位置
        If tvwFilter.Nodes(index2).Key <> strSinglePath(maxIndex) Then
            index2 = index2 + 1
        Else
            Exit Do
        End If
    Loop
    PositionNode = index2
    mstrSelected(MsgFilter.Row, 9) = index2
End Function

Private Sub MsgFilter_click()
 Dim MaxNodesNumber As Long
 Dim Index As Long
 Dim index2 As Long
 Dim lngTemp As Long
 Dim strPath As String