⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 formcond.cls

📁 金算盘软件代码
💻 CLS
📖 第 1 页 / 共 5 页
字号:
      Case "PERIOD"
         .picDate.ZOrder 0
         .picDate.Enabled = True
         .LblTerm.Caption = strViewFieldDesc & "(&D)"
         .lblFrom.Visible = True
         .lblTo.Visible = True
         PeriodHandle frmFilterSet, Node.Index
      Case "DATE"
         .picDate.ZOrder 0
         .picDate.Enabled = True
         .LblTerm.Caption = strViewFieldDesc & "(&D)"
         DateHandle frmFilterSet, Node.Index
      Case "BOOLEAN"
         .ReferText1.width = .MsgFilter.width / 3 + 200
         .picAccount.ZOrder 0
         .picAccount.Enabled = True
         .Lblsel.Caption = strViewFieldDesc & "(&D)"
         BooleanHandle frmFilterSet, Node.Index
      Case Else
         Exit Sub
  End Select
 End With
'当前行已选时,使对应 MsgFilterLine 可见
  If mblnSelected Then
        frmFilterSet.MsgFilter.Row = mlngCurentline
  Else
        frmFilterSet.MsgFilter.Row = frmFilterSet.MsgFilter.Rows - 1
  End If
  If Not frmFilterSet.MsgFilter.RowIsVisible(mlngCurentline) Then
    If mlngCurentline > frmFilterSet.MsgFilter.TopRow Then
      frmFilterSet.MsgFilter.TopRow = mlngCurentline - 3
    Else
      frmFilterSet.MsgFilter.TopRow = mlngCurentline
     End If
  End If
'  With frmFilterSet.MsgFilter
'    On Error Resume Next
'    .SetFocus
'    .col = 0
'    .ColSel = 1
'  End With
End Sub
 
'区间型处理
Private Sub PeriodHandle(frmFilterSet As Form, NodeIndex As Long)
  Dim Index As Long
  With frmFilterSet
     .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(frmFilterSet, NodeIndex)
     mlngCurentline = 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 With
 End Sub
 
'单一日期型处理
Private Sub DateHandle(frmFilterSet As Form, NodeIndex As Long)
  Dim Index As Long
  With frmFilterSet
        .DateOne.ZOrder 0
        .ReferText2.Visible = False
        .DateOne.Visible = True
        .DateOne.Text = ""
        .lblFrom.Visible = False
        .lblTo.Visible = False
        .DateFrom.Visible = False
        .DateTo.Visible = False
        Index = Position(frmFilterSet, NodeIndex)
        mlngCurentline = Index
        If mblnSelected Then
            .DateOne.Text = Format(mstrSelected(Index, 5), "yyyy-mm-dd")
        Else
            .DateOne.Text = ""
        End If
  End With
End Sub

'ADD
Private Function PositionNode(frmFilterSet As Form, 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 mFilterNode = frmFilterSet.tvwFilter.Nodes(index2)
        blnFinded = False
        Do While index2 < frmFilterSet.tvwFilter.Nodes.Count + 1 And blnFinded = False
            If frmFilterSet.tvwFilter.Nodes(index2).Key <> strSinglePath(Index) Then
                index2 = index2 + 1
            Else
                blnFinded = True
            End If
        Loop
        If frmFilterSet.tvwFilter.Nodes(index2).Children > 0 Then tvwFilter_Expand frmFilterSet, frmFilterSet.tvwFilter.Nodes(index2)
        index2 = frmFilterSet.tvwFilter.Nodes(index2).Child.Index
    Next
    Do While index2 <= frmFilterSet.tvwFilter.Nodes.Count
        If frmFilterSet.tvwFilter.Nodes(index2).Key <> strSinglePath(maxIndex) Then
            index2 = index2 + 1
        Else
            Exit Do
        End If
    Loop
    PositionNode = index2
    mstrSelected(frmFilterSet.MsgFilter.Row, 9) = index2
End Function

Public Sub MsgFilter_click(frmFilterSet As Form)
 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 frmFilterSet.MsgFilter.Row = 0 Or frmFilterSet.MsgFilter.Row = frmFilterSet.MsgFilter.Rows - 1 Then Exit Sub
 Index = frmFilterSet.MsgFilter.RowData(frmFilterSet.MsgFilter.Row)
 If Index = 0 Then
    strPath = mstrSelected(frmFilterSet.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(frmFilterSet, strSinglePath, index2 + 1)
 
 Else
    If Not frmFilterSet.tvwFilter.SelectedItem Is Nothing Then
       If Index = frmFilterSet.tvwFilter.SelectedItem.Index Then Exit Sub
    End If
 End If
'使对应的树接点可见
 mMaxNodesNumber = frmFilterSet.tvwFilter.Nodes.Count
 If Index >= 0 And Index < mMaxNodesNumber + 1 Then
    frmFilterSet.tvwFilter.Nodes(Index).EnsureVisible
    frmFilterSet.tvwFilter.Nodes(Index).Selected = True
   '初始化界面
    tvwFilter_nodeClick frmFilterSet, frmFilterSet.tvwFilter.Nodes(Index)
 End If
 With frmFilterSet.MsgFilter
  On Error Resume Next
  .SetFocus
  .col = 0
  .ColSel = 1
 End With
End Sub



Public Sub refertext1_Choose(frmFilterSet As Form)
 Dim Index As Long
 Dim blnMulAccount As Boolean
     mItemNotExit = False
     If mblnRefertext1 = False Then Exit Sub
     mblnRefertext1 = False
  With frmFilterSet
     .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(mlngCurLineOfSelect).Tag, 1) = "*" Then
                '清除当前行
                DelCurentline frmFilterSet
            End If
            Exit Sub
        Case "介于"
            .txtTo.Visible = True
            .txtFrom.Visible = True
            .lblFrom2.Visible = True
            .lblTo2.Visible = True
            .txtFrom.SetFocus
            Exit Sub
        Case "空值", "零或空值"
            '把当前行加入已选数组
            .txtTo.Visible = False
            .txtFrom.Visible = False
            .lblFrom2.Visible = False
            .lblTo2.Visible = False
            Modifyrefertext1 frmFilterSet
            mstrSelected(mlngCurentline, 5) = .ReferText1.Text
            mstrSelected(mlngCurentline, 6) = ""
            mstrSelected(mlngCurentline, 7) = ""
            If .ReferText1.Text = "空值" Then
                mstrSelected(mlngCurentline, 8) = "(Rtrim(" & mstrSelected(mlngCurentline, 2) & ") is NULL ) "
            Else
                mstrSelected(mlngCurentline, 8) = "(" & mstrSelected(mlngCurentline, 2) & " Is NULL or " & mstrSelected(mlngCurentline, 2) & "=0) "
            End If
            AddSelectedTag frmFilterSet
            .MsgFilter.TextMatrix(mlngCurentline, 1) = .ReferText1.Text
            AddMsgFilter frmFilterSet
            Exit Sub
        Case "是", "否"
            '把当前行加入已选数组
            Modifyrefertext1 frmFilterSet
            mstrSelected(mlngCurentline, 5) = .ReferText1.Text
            If Trim(.ReferText1.Text) = "是" Then
                 mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & "=" & "1"
            Else
                 mstrSelected(mlngCurentline, 8) = mstrSelected(mlngCurentline, 2) & "=" & "0"
            End If
            AddSelectedTag frmFilterSet
            .MsgFilter.TextMatrix(mlngCurentline, 1) = .ReferText1.Text
            AddMsgFilter frmFilterSet
            Exit Sub
        Case "一级科目"
            '把当前行加入已选数组
            Modifyrefertext1 frmFilterSet
            mstrSelected(mlngCurentline, 5) = .ReferText1.Text
            mstrSelected(mlngCurentline, 6) = "一级科目"
            mstrSelected(mlngCurentline, 8) = Trim(mstrSelected(mlngCurentline, 4)) & ".intLevel=1"
            AddSelectedTag frmFilterSet
            .MsgFilter.TextMatrix(mlngCurentline, 1) = .ReferText1.Text
            AddMsgFilter frmFilterSet
            Exit Sub
        Case "选择项目"
            Dim strMulsel As String
            Dim strKeyCode As String
            Dim blnOK As Boolean
            If Left(.tvwFilter.Nodes(mlngCurLineOfSelect).Tag, 1) = "*" Then
                If frmFilterSet.MsgFilter.Rows > 2 Then
                    If UCase(mCurstrTemp(3)) = "CODE" Then
                        strKeyCode = Trim(mstrSelected(mlngCurentline, 6))
                        If Not IsNumeric(strKeyCode) Then
                           If Not IsNumeric(Left(strKeyCode, InStr(strKeyCode, ","))) Then strKeyCode = ""
                        End If
                     Else
                        strKeyCode = Trim(mstrSelected(mlngCurentline, 5))
                     End If
                Else
                    strKeyCode = ""
                End If
            Else
                strKeyCode = ""
            End If
            '把当前行加入已选数组
            Modifyrefertext1 frmFilterSet
            If Left(.tvwFilter.Nodes(mlngCurLineOfSelect).Tag, 1) <> "*" Then
                .MsgFilter.RowHeight(mlngCurentline) = 0
            End If
            
            '调用多选界面
            Dim FrmMultiSelect As frmAccountFilter
            Set FrmMultiSelect = New frmAccountFilter
            If UCase(mCurstrTemp(3)) = "CODE" Then
                FrmMultiSelect.AccountFilter mstrSelected(mlngCurentline, 2), strKeyCode, , mlngViewID, , , mEmployeeTag
                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
                    blnMulAccount = True
                Else

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -