frmtreefind.frm

金算盘软件代码

        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
 Dim strTemp As String
 Dim strSinglePath() As String
 mblnRefertext1 = False
 If MsgFilter.Row = 0 Or MsgFilter.Row = MsgFilter.Rows - 1 Then Exit Sub
 Index = MsgFilter.RowData(MsgFilter.Row)
 If Index = 0 Then
 '加子接点
    '分解路径
    strPath = mstrSelected(MsgFilter.Row, 11)
    index2 = strCount(strPath, "/")
    ReDim strSinglePath(0 To index2 + 1) As String
    For lngTemp = 1 To index2
        strTemp = GetNoXString(strPath, lngTemp, "/")
        strSinglePath(lngTemp) = IIf(lngTemp <> 1, strSinglePath(lngTemp - 1) & "/", "") & strTemp
    Next
    strSinglePath(index2 + 1) = strPath
    '定位当前选择行到树接点的位置
    Index = PositionNode(strSinglePath, index2 + 1)
 
 Else
    If Not tvwFilter.SelectedItem Is Nothing Then
       If Index = tvwFilter.SelectedItem.Index Then Exit Sub
    End If
 End If
'使对应的树接点可见
 MaxNodesNumber = tvwFilter.Nodes.Count
 If Index >= 0 And Index < MaxNodesNumber + 1 Then
    tvwFilter.Nodes(Index).EnsureVisible
    tvwFilter.Nodes(Index).Selected = True
   '初始化界面
    tvwFilter_nodeClick tvwFilter.Nodes(Index)
 End If
 With MsgFilter
  On Error Resume Next
  .SetFocus
  .col = 0
  .ColSel = 1
 End With
End Sub

Private Sub refertext1_Choose()
 Dim Index As Long
' Dim blnMulAccount As Boolean
     mItemNotExit = False
     If mblnRefertext1 = False Then Exit Sub
     mblnRefertext1 = False
     TxtFrom.Text = ""
     TxtTo.Text = ""
     lblFrom2.Visible = False
     lblTo2.Visible = False
     Select Case Trim(ReferText1.Text)
         Case ""
            TxtFrom.Visible = False
            TxtTo.Visible = False
            Exit Sub
         Case "任意", "所有"
            TxtFrom.Visible = False
            TxtTo.Visible = False
            If Left(tvwFilter.Nodes(mCurLineOfSelect).Tag, 1) = "*" Then
                '清除当前行
                DelCurentline
            End If
            Exit Sub
        Case "介于"
            lblFrom2.Visible = True
            lblTo2.Visible = True
            TxtFrom.Visible = True
            TxtTo.Visible = True
            TxtFrom.SetFocus
            Exit Sub
         Case "空值", "零或空值"
            '把当前行加入已选数组
            lblFrom2.Visible = False
            lblTo2.Visible = False
            TxtFrom.Visible = False
            TxtTo.Visible = False
            Modifyrefertext1
            mstrSelected(mCurentline, 5) = ReferText1.Text
            mstrSelected(mCurentline, 6) = ""
            mstrSelected(mCurentline, 7) = ""
            If ReferText1.Text = "空值" Then
                mstrSelected(mCurentline, 8) = "(" & mstrSelected(mCurentline, 2) & " is null or LTRIM(Rtrim(" & mstrSelected(mCurentline, 2) & ")) = '') "
            Else
                mstrSelected(mCurentline, 8) = "(" & mstrSelected(mCurentline, 2) & " IS NULL or " & mstrSelected(mCurentline, 2) & " = 0) "
            End If
            AddSelectedTag
            MsgFilter.TextMatrix(mCurentline, 1) = ReferText1.Text
            AddMsgFilter
            Exit Sub
        Case "是", "否"
            '把当前行加入已选数组
            Modifyrefertext1
            mstrSelected(mCurentline, 5) = ReferText1.Text
            If Trim(ReferText1.Text) = "是" Then
                 mstrSelected(mCurentline, 8) = mstrSelected(mCurentline, 2) & " = " & "1"
            Else
                 mstrSelected(mCurentline, 8) = mstrSelected(mCurentline, 2) & " = " & "0"
            End If
            AddSelectedTag
            MsgFilter.TextMatrix(mCurentline, 1) = ReferText1.Text
            AddMsgFilter
            Exit Sub
        Case "选择项目"
            Dim strMulsel As String
            Dim strKeyCode As String
            Dim blnOK As Boolean
            If Left(tvwFilter.Nodes(mCurLineOfSelect).Tag, 1) = "*" Then
                If MsgFilter.Rows > 2 Then
                    If UCase(mCurstrTemp(3)) = "CODE" Then
                        If mstrSelected(mCurentline, 14) <> "1" Then
                            strKeyCode = Trim(mstrSelected(mCurentline, 6))
                            If Not IsNumeric(strKeyCode) Then
                               If Not IsNumeric(Left(strKeyCode, InStr(strKeyCode, ","))) Then strKeyCode = ""
                            End If
                        Else
                            strKeyCode = ""
                        End If
                    Else
                        strKeyCode = Trim(mstrSelected(mCurentline, 5))
                    End If
                Else
                    strKeyCode = ""
                End If
            Else
                strKeyCode = ""
            End If
            '把当前行加入已选数组
            Modifyrefertext1
            If Left(tvwFilter.Nodes(mCurLineOfSelect).Tag, 1) <> "*" Then
                MsgFilter.RowHeight(mCurentline) = 0
            End If
            
            '调用多选界面
            Dim FrmMultiSelect As frmAccountFilter
            Set FrmMultiSelect = New frmAccountFilter
            If UCase(mCurstrTemp(3)) = "CODE" Then
                FrmMultiSelect.AccountFilter mstrSelected(mCurentline, 2), strKeyCode
                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
                '返回的strKeyCode为多选ID字符串
                If Trim(strMulsel) <> "" Then
                    mstrSelected(mCurentline, 5) = "选择项目"
                    mstrSelected(mCurentline, 6) = strKeyCode
                    mstrSelected(mCurentline, 7) = strMulsel
                    Dim strKeyField As String
                    Select Case UCase(mstrSelected(mCurentline, 2))
                        Case "CLASS1", "CLASS2", "CURRENCYS", "CUSTOM0", "CUSTOM1", "CUSTOM2", "CUSTOM3", "CUSTOM4", "CUSTOM5"
                            strKeyField = Left(mstrSelected(mCurentline, 2), Len(mstrSelected(mCurentline, 2)) - 1)
                        Case Else
                            strKeyField = mstrSelected(mCurentline, 2)
                    End Select
                    If Len(strKeyCode) > 0 Then
                        Dim strTempFindID As String
                        strTempFindID = Trim(Filter.FindAllKeyID(Trim(mstrSelected(mCurentline, 2)), strMulsel))
                        strKeyCode = IIf(strTempFindID <> "", strKeyCode & "," & strTempFindID, strKeyCode)
                    End If
                    mstrSelected(mCurentline, 8) = Trim(mstrSelected(mCurentline, 4)) & ".lng" & Trim(strKeyField) & "ID" & " IN (" & Trim(strKeyCode) & ")"
                    AddSelectedTag
                    MsgFilter.TextMatrix(mCurentline, 1) = strMulsel
                    AddMsgFilter
                ElseIf Left(tvwFilter.Nodes(mCurLineOfSelect).Tag, 1) = "*" Then
                    DelCurentline
                End If
            Else
            '对凭单类型作特殊处理
                If mstrSelected(mCurentline, 1) = "单据类型" Then
                    FrmMultiSelect.AccountFilter "凭单类型", strKeyCode, True
                Else
                    FrmMultiSelect.AccountFilter mstrSelected(mCurentline, 1), strKeyCode, True
                End If
                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
                    mstrSelected(mCurentline, 5) = strKeyCode
                    mstrSelected(mCurentline, 6) = Trim(strMulsel)
                    mstrSelected(mCurentline, 8) = Trim(mstrSelected(mCurentline, 2)) & " IN (" & Trim(strMulsel) & ")"
                    AddSelectedTag
                    MsgFilter.TextMatrix(mCurentline, 1) = strKeyCode
                    AddMsgFilter
                ElseIf Left(tvwFilter.Nodes(mCurLineOfSelect).Tag, 1) = "*" Then
                    DelCurentline
                End If
            End If
        'NOT MulSel CodeClass　Handle
        Case Else
            '把当前行加入已选数组
            '** IF 1 **
            If UCase(mCurstrTemp(3)) = "CODE" Or UCase(mCurstrTemp(3)) = "ENUM" Then
                 Modifyrefertext1
                 mstrSelected(mCurentline, 5) = ReferText1.Text
                 ReferText1.SelStart = 0
                 If UCase(mstrSelected(mCurentline, 3)) = "CODE" Then
                    If Trim(ReferText1.TextMatrix(ReferText1.ReferRow, 1)) <> "" Then
                      '  mstrSelected(mCurentline, 5) = Trim(ReferText1.TextMatrix(ReferText1.ReferRow, 2))
                        mstrSelected(mCurentline, 6) = ReferText1.TextMatrix(ReferText1.ReferRow, 1)
                        mstrSelected(mCurentline, 14) = "0"
                    Else
                        mstrSelected(mCurentline, 5) = Trim(ReferText1.TextMatrix(ReferText1.ReferRow, 2) & ReferText1.TextMatrix(ReferText1.ReferRow, 3))
                        mstrSelected(mCurentline, 6) = Trim(ReferText1.TextMatrix(ReferText1.ReferRow, 5))
                        mstrSelected(mCurentline, 8) = mstrSelected(mCurentline, 6) & " in ('" & Trim(mstrSelected(mCurentline, 5)) & "')"
                        mstrSelected(mCurentline, 14) = "1"
                        GoTo NextHandle
                    End If
                    Select Case UCase(mstrSelected(mCurentline, 2))
                        Case "CLASS1", "CLASS2", "CURRENCYS", "CUSTOM0", "CUSTOM1", "CUSTOM2", "CUSTOM3", "CUSTOM4", "CUSTOM5"
                            strKeyField = Left(mstrSelected(mCurentline, 2), Len(mstrSelected(mCurentline, 2)) - 1)
                        Case Else
                            strKeyField = mstrSelected(mCurentline, 2)
                    End Select
                    '找末级ID号.
                    strTempFindID = Trim(Filter.FindAllKeyID(Trim(mstrSelected(mCurentline, 2)), Left(mstrSelected(mCurentline, 5), InStr(mstrSelected(mCurentline, 5), " ") - 1)))
                    strKeyCode = IIf(strTempFindID <> "", Trim(mstrSelected(mCurentline, 6)) & "," & strTempFindID, Trim(mstrSelected(mCurentline, 6)))
                    mstrSelected(mCurentline, 8) = Trim(mstrSelected(mCurentline, 4)) & ".lng" & Trim(strKeyField) & "ID" & " in (" & Trim(strKeyCode) & ")"
                 Else
                    mstrSelected(mCurentline, 6) = "'" & Trim(mstrSelected(mCurentline, 5)) & "'"
                    mstrSelected(mCurentline, 8) = mstrSelected(mCurentline, 2) & " in (" & Trim(mstrSelected(mCurentline, 6)) & ")"
                 End If
NextHandle:
                 AddSelectedTag
                 MsgFilter.TextMatrix(mCurentline, 1) = Trim(mstrSelected(mCurentline, 5))
                 AddMsgFilter
                 Exit Sub
            Else
                 TxtFrom.Visible = True
                 TxtTo.Visible = False
                 TxtFrom.SetFocus
            End If
     End Select
End Sub

Private Sub txtFrom_Change()
  On Error Resume Next
  If UCase(mCurstrTemp(3)) = "LONG" Or UCase(mCurstrTemp(3)) = "DOUBLE" Or UCase(mCurstrTemp(3)) = "INTEGER" Then
      If Not IsNumeric(TxtFrom.Text) And Trim(TxtFrom.Text) <> "" And Trim(TxtFrom.Text) <> "-" Then
        TxtFrom.Text = Left(TxtFrom.Text, Len(TxtFrom.Text) - 1)
        SendKeys "{ENd}", True
      End If
  End If
End Sub

Private Sub TxtFrom_KeyDown(KeyCode As Integer, Shift As Integer)
  If KeyCode = vbKeyReturn Then
      KeyCode = vbKeyClear
      If TxtFrom.Text <> "" Then
        If TxtTo.Visible = True Then
             TxtTo.SetFocus
        Else
             tvwFilter.SetFocus
        End If
      End If
  End If
End Sub

Private Sub txtfrom_LostFocus()
  If Me.ActiveControl.Name = "CmdNo" Then Exit Sub
  If mItemNotExit = True Then Exit Sub
  '** IF 1 **
  If Trim(TxtFrom.Text) <> "" Then
        TxtFrom.Text = Trim(TxtFrom.Text)
         '** IF 2 **
        If UCase(mCurstrTemp(3)) = "LONG" Or UCase(mCurstrTemp(3)) = "DOUBLE" Or UCase(mCurstrTemp(3)) = "INTEGER" Then
         '** IF 3 **
            If Not IsNumeric(TxtFrom.Text) Or Right(TxtFrom.Text, 1) = "-" Or InStr(TxtFrom.Text, ",") > 0 Then
                MsgBox "输入的不是数字"
                Exit Sub
            Else
               If UCase(mCurstrTemp(3)) = "INTEGER" Then
                  If InStr(TxtFrom.Text, ".") > 0 Then
                      Msg