filter.bas

金算盘软件代码

                             End If
                        Case "货位"
                             If blnPosition = True Then
                               If strTagCond(10) <> "" Then
                                 strTagCond(10) = strTagCond(10) & " and " & strTemp
                               Else
                                 strTagCond(10) = strTemp
                               End If
                             Else
                               strSelect(8) = strTemp
                             End If
                        Case strPeriodName
                             If blnPeriod = True Then
                               strTagCond(7) = strTemp
                             Else
                               strSelect(8) = strTemp
                             End If
                        Case Else
                             strSelect(8) = strTemp
                End Select
            End If
'           TagCond CodeHandle End
            If Trim(strSelect(8)) <> "" Then
                If InStr(UCase(strSelect(8)), "SUM(") > 0 Or InStr(UCase(strSelect(8)), "MIN(") > 0 Or InStr(UCase(strSelect(8)), "AVG(") > 0 Or InStr(UCase(strSelect(8)), "MAX(") > 0 Or InStr(UCase(strSelect(8)), "FIRST(") > 0 Or InStr(UCase(strSelect(8)), "LAST(") > 0 Or InStr(UCase(strSelect(8)), "COUNT(") > 0 Then
                    If strHaving = "" Then
                       strHaving = strSelect(8)
                    Else
                       strHaving = strHaving & " And " & strSelect(8)
                    End If
                Else
                    If strWhere = "" Then
                       strWhere = strSelect(8)
                    Else
                       strWhere = strWhere & " And " & strSelect(8)
                    End If
                End If
            End If
      rs.MoveNext
     Loop
     ChineseCond = strReplace(ChineseCond, "/", "--")
     Set rs = Nothing
     GetInitWhere = strWhere
     For Index = 1 To 6          '对 '项目','货位' 和'商品' 已作了特殊处理
          If Trim(strTagCond(Index)) <> "" Then
            strTagCond(Index) = Right(strTagCond(Index), Len(strTagCond(Index)) - 4)
          End If
     Next
     
     
     '此处的“|”需要修改，与邓强联系
     
     If IntTag <> 0 Then
        strCond = strTagCond(1)
        strCond = strCond & "`" & strTagCond(2)
        strCond = strCond & "`" & strTagCond(3)
        strCond = strCond & "`" & strTagCond(4)
        strCond = strCond & "`" & strTagCond(5)
        strCond = strCond & "`" & strTagCond(6)
        strCond = strCond & "`" & strTagCond(7)
        strCond = strCond & "`" & strTagCond(8)
        strCond = strCond & "`" & strTagCond(9)
        strCond = strCond & "`" & strTagCond(10)
     End If
 End Function

'字符串合法性判断
Public Function NotValild(StrClass As String) As Boolean
    If InStr(StrClass, "'") > 0 Or InStr(StrClass, "`") > 0 Then NotValild = True
End Function

'找末级ID号.
Public Function FindAllKeyID(strCodeTableName As String, ByVal strMulCode As String) As String
  Dim strTemp As String
  Dim strSql As String
  Dim strBiaTable As String
  Dim Index As Long
  Dim rs As rdoResultset
  Dim ArrCodeTemp() As String
  Dim lngCount As Long
    On Error GoTo EndHandle
        
        ReDim ArrCodeTemp(strCount(strMulCode, " ") + 1) As String
        Dim strCode As String
        Dim lngCode As Long
        Dim IndexX As Long
        strCode = strMulCode
        lngCode = -1
        Do While Trim(strCode) <> ""
         strCode = Trim(strCode)
         IndexX = InStr(strCode, " ")
         If IndexX = 0 Then
           strTemp = strCode
           IndexX = Len(strCode)
         Else
           strTemp = Left(strCode, IndexX - 1)
         End If
         ArrCodeTemp(lngCode + 1) = strTemp
         lngCode = lngCode + 1
         strCode = Right(strCode, Len(strCode) - IndexX)
        Loop
        lngCount = lngCode + 1
    Select Case UCase(strCodeTableName)
        Case "CLASS1", "CLASS2", "CURRENCYS", "CUSTOM0", "CUSTOM1", "CUSTOM2", "CUSTOM3", "CUSTOM4", "CUSTOM5"
            strBiaTable = Left(strCodeTableName, Len(strCodeTableName) - 1)
            strSql = "select str" & strBiaTable & "Code  as a1,lng" & strBiaTable & "ID as b1 from " & strCodeTableName & " where blnisinactive=0"
        Case "BUSINESSADDRESS", "EMPLOYEETYPE", "AREA"
            strSql = "select str" & strCodeTableName & "Code  as a1, lng" & strCodeTableName & "ID as b1 from " & strCodeTableName
        Case Else
            strSql = "select str" & strCodeTableName & "Code  as a1, lng" & strCodeTableName & "ID as b1 from " & strCodeTableName & " where blnisinactive=0"
     End Select
     Set rs = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
     If rs.RowCount > 0 Then
        rs.MoveFirst
     Else
        Exit Function
     End If
     Do While Not rs.EOF
        For IndexX = 0 To UBound(ArrCodeTemp, 1) - 1
            If Left(rs!A1, Len(Trim(ArrCodeTemp(IndexX)) & "-")) = Trim(ArrCodeTemp(IndexX)) & "-" Then
                If FindAllKeyID = "" Then
                    FindAllKeyID = rs!b1
                ElseIf InStr(FindAllKeyID, "," & rs!b1 & ",") = 0 Then
                    If lngCount + strCount(FindAllKeyID, ",") + 1 > 250 Then
                        MsgBox "多选条件项目设置太多,程序已截出一部分.", vbOKOnly, App.title
                        GoTo EndHandle
                    Else
                        FindAllKeyID = FindAllKeyID & "," & rs!b1
                    End If
                End If
            End If
        Next
        rs.MoveNext
     Loop
     rs.Close
EndHandle:
End Function
'把数量转换成常用计量单位格式
Public Function QuantityFormat(ByVal strQuantity As String) As String
    If InStr(UCase(strQuantity), "DBLFACTOR") > 0 Or InStr(UCase(strQuantity), "SUM(") > 0 Or InStr(UCase(strQuantity), "MIN(") > 0 Or InStr(UCase(strQuantity), "AVG(") > 0 Or InStr(UCase(strQuantity), "MAX(") > 0 Or InStr(UCase(strQuantity), "MIN(") > 0 Or InStr(UCase(strQuantity), "LAST(") > 0 Or InStr(UCase(strQuantity), "COUNT(") > 0 Then
        QuantityFormat = strQuantity
    Else
        QuantityFormat = "(Trunc(" & strQuantity & "/ItemUnit.dblFactor) +Mod(" & strQuantity & ",ItemUnit.dblFactor)/Power(10,LENgth(ITEMUNIT.DBLFACTOR-1)))"
    End If
End Function


'初始化ImageList
Public Sub InitImageList(ImageList1 As Object)
  ImageList1.ListImages.Clear
  ImageList1.ListImages.Add , "closed", Utility.LoadRes(3004, vbResIcon)
  ImageList1.ListImages.Add , "book", Utility.LoadRes(3007, vbResIcon)
  ImageList1.ListImages.Add , "open", Utility.LoadRes(3006, vbResIcon)
End Sub
'初始化ImageList
Public Sub DestroyImageList(ImageList1 As Object)
  Utility.RemoveFormResPicture 3004
  Utility.RemoveFormResPicture 3007
  Utility.RemoveFormResPicture 3006
End Sub

'根据职员条件标志，取出条件串
 '职员条件标志 -1：所有，1：总帐类 '2：应收类 4：应付类 8：现金银行类 16：采购类 32：销售类 64：库存类 128：委托加工类
Public Function GetEmployeeWhere(EmployeeTag As Long) As String
    Dim strTemp As String
    strTemp = ""
    If EmployeeTag = -1 Then
        strTemp = " 2>1 "
    Else
        '总帐
        If EmployeeTag And 1 Then
            strTemp = " blnAccount=1 "
        End If
        '应收
        If EmployeeTag And 2 Then
            If strTemp = "" Then
                strTemp = " blnAR=1 "
            Else
                strTemp = strTemp & " blnAR=1 "
            End If
        End If
        '应付
        If EmployeeTag And 4 Then
            If strTemp = "" Then
                strTemp = " blnAP=true "
            Else
                strTemp = strTemp & " blnAP=true "
            End If
        End If
        '现金银行
        If EmployeeTag And 8 Then
            If strTemp = "" Then
                strTemp = " blnCash=1 "
            Else
                strTemp = strTemp & " or  blnCash=1 "
            End If
        End If
        '采购
        If EmployeeTag And 16 Then
            If strTemp = "" Then
                strTemp = " blnPurchase=1 "
            Else
                strTemp = strTemp & " or  blnPurchase=1 "
            End If
        End If
        '销售
        If EmployeeTag And 32 Then
            If strTemp = "" Then
                strTemp = " blnSale=1 "
            Else
                strTemp = strTemp & " or  blnSale=1 "
            End If
        End If
        '库存
        If EmployeeTag And 64 Then
            If strTemp = "" Then
                strTemp = " blnStock=1 "
            Else
                strTemp = strTemp & " or  blnStock=1 "
            End If
        End If
        '委托加工
        If EmployeeTag And 128 Then
            If strTemp = "" Then
                strTemp = " blnEntrust=1 "
            Else
                strTemp = strTemp & " or  blnEntrust=1 "
            End If
        End If
    End If
    If strTemp = "" Then
        strTemp = " 2>1 "
    Else
        strTemp = "(" & strTemp & ")"
    End If
    
    GetEmployeeWhere = strTemp
End Function