【分享函数】设置窗体默认的过滤条件

admin

'===============================================================================-----天鸣科技--->>>>>>>>
'-函数名称:         gt_GetDefaultFilter
'-功能描述:         设置默认的过滤条件
'-输入参数:         参数1:rstrFormName String 窗体名称
'-返回参数:         无
'-使用示例:         gt_GetDefaultFilter "frmMainMenu"
'-相关调用:         无
'-使用注意:         暂时只适用静态条件，不能取动态条件，如只能取3月流水帐，不能取当月流水帐资料
'-兼 容 性:         97,2000,XP,2003 compatible
'-参考资料:
'-作    者:         王宇虹  修改：王宇虹
'-创建日期;         2002-08-26  更新日期: 2012-05-01
'-图    解:
'===============================================================================--<>>>>>
Public Function gt_GetDefaultFilter(rstrFrmName As String) As String

    Dim rstTemp As New ADODB.Recordset
    Dim strDftFltName As String
    Dim strWhere As String
    rstTemp.Open "select ffiltername from tblZstmFilterSave where fform='" & rstrFrmName & "' and fuser='" & gt_strUserName & "' and fisdefault=true ", CodeProject.Connection, adOpenStatic, adLockReadOnly
    If rstTemp.RecordCount > 0 Then
        strDftFltName = rstTemp.Fields("ffiltername")
    Else
        strDftFltName = ""
    End If
    rstTemp.Close
    'strDftFltName = Nz(DLookup("ffiltername", "tblZstmFilterSave", "fform='" & Me.Name & "' and fuser='" & gt_strUserName & "' and fisdefault=true "))
    CodeDb.Execute "delete * from tblZstmFilter"
    CodeDb.Execute "insert into tblZstmFilter (FId, FSeq, Fform, FName, FRela, FField, FCaption, FLogic, FValue, FType) select FId, FSeq, fform, FName, FRela, FField, FCaption, FLogic, FValue, FType from tblZstmFilterSaveDetail where ffiltername='" & strDftFltName & "' and fform='" & rstrFrmName & "' and fuser='" & gt_strUserName & "'"


    Dim varName As Variant
    Dim strTmp As String
    Dim i, j As Integer

    Dim strCtlL, strValue, strLogic, pPara As String

    Dim strSql As String
    strSql = "select * from tblZstmFilter  where fform='" & rstrFrmName & "' order by fseq"
    rstTemp.Open strSql, CodeProject.Connection, adOpenStatic, adLockReadOnly

    pPara = ""
    Do While Not rstTemp.EOF
        i = i + 1
        If i = 1 Then
            strCtlL = " "
        Else
            strCtlL = IIf(rstTemp("FRela") = "或", " or ", " and ")
        End If
        strValue = rstTemp("FValue")
        strLogic = Trim(rstTemp("FLogic"))
        If strLogic = "$" Then
            strValue = "*" & strValue & "*"
            strLogic = " LIKE "
        End If
        If strLogic = "=" Then
            strValue = strValue & "*"
            strLogic = " like "
        End If
        pPara = pPara & strCtlL & rstTemp("FField")


        Select Case rstTemp("FType")
        Case "Text", "Memo"

            If strLogic = "IN" Then

                varName = Split(strValue, ",")
                strTmp = ""
                For j = 0 To UBound(varName)
                    If j = 0 Then
                        strTmp = strTmp & " like  '" & varName(j) & "*' "
                    Else
                        strTmp = strTmp & " or " & rstTemp("FField") & " like  '" & varName(j) & "*' "
                    End If
                Next
                'strTmp = Left(strTmp, Len(strTmp) - 1)
                strValue = strTmp
                strLogic = " IN "
                pPara = pPara & strTmp
            Else
                pPara = pPara & strLogic & " '" & strValue & "'"
            End If

        Case "Longint", "Int", "Double", "Currency", "Boolean", "Autoid"



            If strLogic = "IN" Then

                varName = Split(strValue, ",")
                strTmp = ""
                For j = 0 To UBound(varName)
                    strTmp = strTmp & varName(j) & ","
                Next
                strTmp = left(strTmp, Len(strTmp) - 1)
                strValue = strTmp
                strLogic = " IN "
                pPara = pPara & strLogic & "(" & strValue & ")"
            Else
                pPara = pPara & strLogic & strValue
            End If

        Case "Date"



            If strLogic = "IN" Then

                varName = Split(strValue, ",")
                strTmp = ""
                For j = 0 To UBound(varName)
                    varName(j) = "20" & left(varName(j), 2) & "/" & Mid(varName(j), 3, 2) & "/" & right(varName(j), 2)
                    strTmp = strTmp & "'" & varName(j) & "',"
                Next
                strTmp = left(strTmp, Len(strTmp) - 1)
                strValue = strTmp
                strLogic = " IN "
                pPara = pPara & strLogic & "(" & strValue & ")"
            Else
                If rstTemp("FValue") <> "当天" Then
                    strValue = "20" & left(strValue, 2) & "/" & Mid(strValue, 3, 2) & "/" & right(strValue, 2)

                    pPara = pPara & strLogic & " '" & strValue & "' "
                Else
                    pPara = pPara & strLogic & " '" & Date & "' "
                End If
            End If
        End Select

        rstTemp.MoveNext
    Loop
    If pPara = "" Then pPara = " true "
    'CurrentProject.Application.Forms(rstrFrmName).Tag = pPara
    gt_GetDefaultFilter = pPara
End Function

Henry D. Sy

坐个沙发