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

📄 frmfilter.frm

📁 金算盘软件代码
💻 FRM
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
         Width           =   1725
      End
   End
End
Attribute VB_Name = "frmFilter"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'
'  作者:王佥
'  功能:  采用树结构设置筛选条件并返回筛选Where字句.
'  使用范围: 由Filter 模块调用.
'  接口:
'    １．ShowFilter( LngFilterID, lngType , IntTag, strCond, strPeriodName,strSpecial,lngReceiptTypeID)
'   　　　　 LngFilterID为筛选ID号(如帐册ID号)
'   　　　　 lngType为类型号 1:ListClass 2:ReportClass
'    　　　　IntTag为特殊条件类:0:所有 1:科目 2:单位 4:部门 8:员工
'                       16:工程项目 32:统计 64:期间 128:商品 256:项目 512:货位.......
'    strPeriodName 区间型字段汉字名
'    strSpecial 对特殊代码型和期间型字段赋初值 如:"科目/101 现金/1" 其中科目:字段描述 101 现金:代码号+名字(或者 代码号串) 1:ID号
'                                               "会计期间/自定义/1998-6-12,1998-7-12"
'    2．strCond 特殊条件类返回参数
'    3．mChineseCond 返回汉语条件
'    4. mstrWhere
'              当mIntTag=1时返回筛选的全部Where字句, 否则返回除去特殊
'              条件类后的部分strWhere字句.
'    5.mblnOK 确定返回标志
'    6.lngReceiptTypeID 单据模板所属的单据类型ID
'  备注:特殊条件类和strSpecial赋初值等都只针对第一级树接点
'  日期:1998年6月20日
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

Const ConNumPerSel = 14                    '当前行的参数个数

Private mlngViewID As Long                 '总的视图ID号
Private strCondVersionField As String      'ViewField的版本号条件
Private strCondVersionEnum As String       'Enum的版本号条件
Private strCondHospital As String          '行政医疗条件
Private strCondVersion As String           '单据类型的版本号条件

Private mlngKeyType As Long                '1:list;2:report
Private mlngKeyID As Long                  'input ID
Private mCurentline As Long                '当前行
Private mCurLineOfSelect  As Long          '当前行对应的树接点号
Private WithEvents mclsHook As Hook        '响应msgFilter中vbUp 和vbDown 事件
Attribute mclsHook.VB_VarHelpID = -1
Private mblnRefertext1 As Boolean          'Refertext1_Choose时　Refertext1_click　响应标志
Private mblnRefertext2 As Boolean          'Refertext1_Choose时　Refertext1_click　响应标志
Private mItemNotExit As Boolean

Dim mCurstrTemp(1 To 9) As String          '当前行的参数 1:字段描述 2:字段名 3:字段类型 4:表名 5:树接点索引号 6:字段ID号 7:路径 8:表别名 9:子接点表别名

Dim mstrSelected() As String               '当前行的参数(MaxLine,1 To ConNumPerSel)
                                           '当前行的参数 1:字段描述 2:字段名 3:字段类型 4:表名 5,6,7:操作符和操作值 8:strWhere子句 9:树接点索引号 10:字段ID号 11:路径 12:表别名 13:子接点表别名 14:编码型类别标志
'Dim mstrViewKey As String
Dim mNode As msComctlLib.Node
Dim mblnSelected As Boolean                '当前行已设置条件标志

'对特殊代码型或期间型字段赋初值
Dim mstrSpecialTable As String             '字段汉字描述
Dim mstrSpecialFieldName As String         '代码型的 代码号+名字(或者 代码号串) 期间型的 期间名
Dim mstrSpecialID As String                '代码型的 ID号                      期间型的 日期值
Private mblnIsSimpleCustomer As Boolean                '瘦身型条件，对字节点供应商起作用

Dim blnAccount As Boolean
Dim blnCustomer As Boolean
Dim blnDepartment As Boolean
Dim blnEmployee As Boolean
Dim blnJob As Boolean
Dim blnClass1 As Boolean
Dim blnClass2 As Boolean
Dim blnItem As Boolean
Dim blnPeriod As Boolean
Dim blnPosition As Boolean
Dim mstrPeriodName As String
Dim mIntTag As Integer
Dim mlngReceiptTypeID As Long
Dim mstrReceiptTypeID As String

Public mstrWhere As String                '返回的<mstrWhere>字句
Public mstrCond As String                 '返回特殊条件字符串
Public mblnOk As Boolean                  '确定返回标志
Public mChineseCond As String             '返回汉语条件
Private mEmployeeTag As Long                  '职员条件标志 -1：所有，1：总帐类
                                              '2：应收类 4：应付类 8：现金银行类 16：采购类 32：销售类 64：库存类 128：委托加工类
Public mstrWhereing As String
Public mstrHaving As String
Private Sub CmdHelp_Click()
     HtmlHelp.HtmlHelp Me.hwnd, App.HelpFile, 15, 10007
End Sub

Private Sub cmdOK_Click()
Dim Index As Long
    '生成中文条件
    mChineseCond = ""
    For Index = 1 To MsgFilter.Rows - 2
         If mstrSelected(Index, 5) = "自定义" Or mstrSelected(Index, 5) = "介于" Then
                If mChineseCond = "" Then
                    mChineseCond = Trim(mstrSelected(Index, 11)) & " 介于 （" & mstrSelected(Index, 6) & "," & mstrSelected(Index, 7) & ")"
                Else
                    mChineseCond = mChineseCond & "       " & Trim(mstrSelected(Index, 11)) & " 介于 （" & mstrSelected(Index, 6) & "," & mstrSelected(Index, 7) & ")"
                End If
         ElseIf mstrSelected(Index, 5) = "空值" Then
                mChineseCond = Trim(mstrSelected(Index, 11)) & ": 空值 "
         Else
                Select Case UCase(Trim(mstrSelected(Index, 3)))
                   Case "ENUM", "CODE", "BOOLEAN", "DATE", "PERIOD"
                       If mChineseCond = "" Then
                           mChineseCond = Trim(mstrSelected(Index, 11)) & ": " & MsgFilter.TextMatrix(Index, 1)
                       Else
                           mChineseCond = mChineseCond & "       " & Trim(mstrSelected(Index, 11)) & ": " & MsgFilter.TextMatrix(Index, 1)
                       End If
                   Case Else
                       If mChineseCond = "" Then
                           mChineseCond = Trim(mstrSelected(Index, 11)) & " " & MsgFilter.TextMatrix(Index, 1)
                       Else
                           mChineseCond = mChineseCond & "       " & Trim(mstrSelected(Index, 11)) & " " & MsgFilter.TextMatrix(Index, 1)
                       End If
                End Select
         End If
    Next
    mChineseCond = strReplace(mChineseCond, "/", "--")
    '修改数据库
    ModifyCondTable
    mblnOk = True
    Unload Me
End Sub

'字符转换为数字,字符串的 “介于” 操作符为10
Private Function CondStrToNum(ByVal strOperate As String) As String
    Select Case Trim(strOperate)
        Case "等于", "今天"
           CondStrToNum = "1"
        Case "大于", "本周"
           CondStrToNum = "2"
        Case "小于", "本周至今日"
           CondStrToNum = "3"
        Case "大于等于", "本期"
           CondStrToNum = "4"
        Case "小于等于", "本期至今日"
           CondStrToNum = "5"
        Case "打头字符为", "介于", "本月"
           CondStrToNum = "6"
        Case "包含字符", "本月至今日", "零或空值"   '数字型的空值
           CondStrToNum = "7"
        Case "类似于", "本季度"
           CondStrToNum = "8"
        Case "本季至今日", "不等于"
           CondStrToNum = "9"
        Case "本年"
           CondStrToNum = "10"
        Case "本年至今日", "空值"
           CondStrToNum = "11"
        Case "上周"
           CondStrToNum = "12"
        Case "上期"
           CondStrToNum = "13"
        Case "上月"
           CondStrToNum = "14"
        Case "上季度"
           CondStrToNum = "15"
        Case "去年"
           CondStrToNum = "16"
        Case "自定义"
           CondStrToNum = "17"
        Case "所有"
           CondStrToNum = "18"
     End Select
End Function

'修改数据库
Private Sub ModifyCondTable()
 Dim rs As rdoResultset
 Dim rsMultiCond As rdoResultset
 Dim Index As Long
 Dim strTable As String
 Dim strSql As String
 Dim strsql2 As String
 Dim strKey As String
 Dim strRootRath As String
 Dim lngTemp As Long
 Dim blnSpec As Boolean
 Dim mstrTagCond(1 To 10) As String          'TagCond 字符数组 1:科目 2:单位 3:部门 4:员工 5:工程项目 6:统计 7:期间或单一日期 8:商品 9:项目 10: 货位
  On Error GoTo ErrHandle
  If mlngKeyType = 1 Then
     strTable = "ListCond"
     strKey = "lngListId"
  Else
     strTable = "ReportCond"
     strKey = "lngReportId"
  End If
  
  Filter.DelSelectedCond mlngKeyID, mlngKeyType
  gclsBase.BaseWorkSpace.BeginTrans
  Set rs = gclsBase.BaseDB.OpenResultset("Select * From " & strTable, rdOpenDynamic, 4)
  Index = 1
  Do While Index < MsgFilter.Rows - 1
    If blnPeriod = True And mstrSelected(Index, 11) = mstrPeriodName Then
        mstrSelected(Index, 8) = mstrSelected(Index, 2) & " , " & mstrSelected(Index, 5) & " , " & mstrSelected(Index, 6) & " , " & mstrSelected(Index, 7)
    End If
    If Trim(mstrSelected(Index, 12)) <> "" Then
        mstrSelected(Index, 8) = Filter.ModifyTableName(mstrSelected(Index, 8), mstrSelected(Index, 4) & ".", mstrSelected(Index, 12) & ".")
    End If
    If UCase(mstrSpecialTable) <> UCase(mstrSelected(Index, 11)) Then
         '加一条条件到数据库
         rs.AddNew
         rs.rdoColumns(strKey) = mlngKeyID
         rs!lngViewFieldID = CLng(Trim(mstrSelected(Index, 10)))
         rs!strPath = mstrSelected(Index, 11)
         rs!strOthTableName = IIf(mstrSelected(Index, 12) = "", " ", mstrSelected(Index, 12))
         If InStr(rs!strPath, "/") <> 0 Then rs!blnHavefathernode = 1
         Select Case UCase(Trim(mstrSelected(Index, 3)))
             Case "STRING"
             '字符串的 “介于” 操作符为10
                 If mstrSelected(Index, 5) = "介于" Then
                    mstrSelected(Index, 5) = 10
                    rs!strString2 = mstrSelected(Index, 7)
                 Else
                    mstrSelected(Index, 5) = CondStrToNum(mstrSelected(Index, 5))
                 End If
                 rs!strStringOP = mstrSelected(Index, 5)
                 rs!strString1 = IIf(mstrSelected(Index, 6) = "", " ", mstrSelected(Index, 6))
             Case "ENUM"
                    rs!strString1 = mstrSelected(Index, 5)
                    rs!strString2 = mstrSelected(Index, 6)
             Case "LONG", "INTEGER", "DOUBLE"
                 mstrSelected(Index, 5) = CondStrToNum(mstrSelected(Index, 5))
                 rs!strDoubleOP = mstrSelected(Index, 5)
                 If mstrSelected(Index, 5) = "7" Then '零或空值
                    rs!dbldouble1 = 0
                 Else
                    rs!dbldouble1 = CDbl(mstrSelected(Index, 6))
                    If mstrSelected(Index, 5) = "6" Then
                        rs!dbldouble2 = CDbl(mstrSelected(Index, 7))
                    End If
                 End If
             Case "BOOLEAN"
                  rs!blnBoolean = IIf(Trim(mstrSelected(Index, 5)) = "是", 1, 0)
             Case "DATE"
                  rs!strDateOp = 0
                  rs!dtmDate1 = mstrSelected(Index, 5)
             Case "PERIOD"
                  mstrSelected(Index, 5) = CondStrToNum(mstrSelected(Index, 5))
                  rs!strDateOp = mstrSelected(Index, 5)
                  rs!dtmDate1 = mstrSelected(Index, 6)
                  rs!dtmDate2 = mstrSelected(Index, 7)
             Case "CODE"
                  If Trim(mstrSelected(Index, 5)) = "选择项目" Then
                    rs!blnismulicond = 1
                    If mlngKeyType = 1 Then
                        Set rsMultiCond = gclsBase.BaseDB.OpenResultset("SELECT * from listMultiIDCond ", rdOpenStatic, 4)
                    Else
                        Set rsMultiCond = gclsBase.BaseDB.OpenResultset("SELECT * from ReportMultiIDCond ", rdOpenStatic, 4)
                    End If
                    rsMultiCond.AddNew
                    If mlngKeyType = 1 Then
                        rsMultiCond!lngListID = mlngKeyID
                    Else
                        rsMultiCond!lngReportID = mlngKeyID
                    End If
                    rsMultiCond!strPath = mstrSelected(Index, 11)
                    rsMultiCond!strCodeID = mstrSelected(Index, 6)
                    rsMultiCond!strKeyName = mstrSelected(Index, 7)
                    rsMultiCond!bLNISCODETYPE = 0
                    rsMultiCond.Update
                    rsMultiCond.Close
'                         strSql = "insert into listMultiIDCond( LNGLISTID, STRPATH, STRCODEID, STRKEYNAME, BLNISCODETYPE ) values('" & mlngKeyID & "','" & mstrSelected(Index, 11) & "','" & mstrSelected(Index, 6) & "','" & mstrSelected(Index, 7) & "','0')"
'                    Else
'                         strSql = "insert into ReportMultiIDCond( LNGREPORTID, STRPATH, STRCODEID, STRKEYNAME, BLNISCODETYPE ) values('" & mlngKeyID & "','" & mstrSelected(Index, 11) & "','" & mstrSelected(Index, 6) & "','" & mstrSelected(Index, 7) & "','0')"
'                    End If
                  Else
                    rs!blnismulicond = 0
                    If mlngKeyType = 1 Then
                        Set rsMultiCond = gclsBase.BaseDB.OpenResultset("SELECT * from listMultiIDCond ", rdOpenStatic, 4)
                    Else
                        Set rsMultiCond = gclsBase.BaseDB.OpenResultset("SELECT * from ReportMultiIDCond ", rdOpenStatic, 4)
                    End If
                    rsMultiCond.AddNew
                    If mlngKeyType = 1 Then
                        rsMultiCond!lngListID = mlngKeyID
                    Else
                        rsMultiCond!lngReportID = mlngKeyID
                    End If
                    rsMultiCond!strPath = mstrSelected(Index, 11)
                    rsMultiCond!strCodeID = mstrSelected(Index, 6)
                    rsMultiCond!strKeyName = mstrSelected(Index, 5)
                    rsMultiCond!bLNISCODETYPE = IIf(mstrSelected(Index, 14) = "1", "1", "0")
                    rsMultiCond.Update
                    rsMultiCond.Close
'                    If mlngKeyType = 1 Then
'                         strSql = "insert into listMultiIDCond( LNGLISTID, STRPATH, STRCODEID, STRKEYNAME, BLNISCODETYPE ) values('" & mlngKeyID & "','" & mstrSelected(Index, 11) & "','" & mstrSelected(Index, 6) & "','" & mstrSelected(Index, 5) & "','" & IIf(mstrSelected(Index, 14) = "1", "1", "0") & "')"
'                    Else
'                         strSql = "insert into ReportMultiIDCond( LNGREPORTID, STRPATH, STRCODEID, STRKEYNAME, BLNISCODETYPE )  values('" & mlngKeyID & "','" & mstrSelected(Index, 11) & "','" & mstrSelected(Index, 6) & "','" & mstrSelected(Index, 5) & "','" & IIf(mstrSelected(Index, 14) = "1", "1", "0") & "')"
'                    End If
                  End If
'                  gclsBase.BaseDB.Execute strSql
        End Select
        rs.Update
        '执行加入一条新记录
   End If
   '判断,加入到特殊否
   If mIntTag <> 0 Then
       strRootRath = mstrSelected(Index, 11)
       lngTemp = InStr(strRootRath, "/")
12345

⌨️ 快捷键说明

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