📄 frmadvancedquery.frm

📁 通用书店管理系统
💻 FRM
📖 第 1 页 / 共 3 页
字号:
上一页 1 23
    
End Sub

Private Sub setGridOrder()
    '给Grid排序
    
    Dim i%
    For i = 1 To fg.Rows - 1
        fg.Cell(flexcpText, i, 0) = "C" & i
    Next i
End Sub

Private Sub setCompleteCondition()
    Dim i%, str$
    Dim chrMark$
    Dim strFileds$
    Dim strBefValue$
    Dim strBckValue$
    Dim intFieldType%
    
    '与关系
    If Me.optAndOr(0).Value Then
        For i = 1 To fg.Rows - 1
            
            '输入内容特殊处理
            strBefValue = Trim(fg.Cell(flexcpText, i, 3))
            strBefValue = Replace(strBefValue, "'", "''")
            
            strBckValue = Trim(fg.Cell(flexcpText, i, 4))
            strBckValue = Replace(strBckValue, "'", "''")
            
       
            If Mid(fg.Cell(flexcpText, i, 1), 1, 1) = "[" Then
                intFieldType = arrDataFieldsType(Val(Right(fg.Cell(flexcpText, i, 1), Len(fg.Cell(flexcpText, i, 1)) - 1)))
            Else
                intFieldType = arrInnerFieldsType(Val(Right(fg.Cell(flexcpText, i, 1), Len(fg.Cell(flexcpText, i, 1)) - 1)))
            End If
            
            Select Case intFieldType
            
            Case ADODB.DataTypeEnum.adBSTR, ADODB.DataTypeEnum.adChar, ADODB.DataTypeEnum.adDate, ADODB.DataTypeEnum.adDBDate, ADODB.DataTypeEnum.adDBTime, _
                 ADODB.DataTypeEnum.adDBTimeStamp, ADODB.DataTypeEnum.adVarChar, ADODB.DataTypeEnum.adLongVarWChar, ADODB.DataTypeEnum.adVarChar, ADODB.DataTypeEnum.adVarWChar, ADODB.DataTypeEnum.adWChar
                
                chrMark = "'"
            Case Else
                chrMark = ""
            End Select
            
            Select Case Trim(fg.Cell(flexcpText, i, 2))
            Case "等于"
                str = str & IIf(Trim(str) = "", "", " AND ") & "(" & fg.Cell(flexcpText, i, 1) & " = " & chrMark & Trim(strBefValue) & chrMark & ")"
                strFileds = strFileds & IIf(Trim(strFileds) = "", "", " AND ") & "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " = " & chrMark & Trim(strBefValue) & chrMark & ")"
            Case "类似"
                str = str & IIf(Trim(str) = "", "", " AND ") & "(" & fg.Cell(flexcpText, i, 1) & " Like '%" & Trim(strBefValue) & "%'" & ")"
                strFileds = strFileds & IIf(Trim(strFileds) = "", "", " AND ") & "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " Like '%" & Trim(strBefValue) & "%'" & ")"
            Case "大于"
                str = str & IIf(Trim(str) = "", "", " AND ") & "(" & fg.Cell(flexcpText, i, 1) & " > " & chrMark & Trim(strBefValue) & chrMark & ")"
                strFileds = strFileds & IIf(Trim(strFileds) = "", "", " AND ") & "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " > " & chrMark & Trim(strBefValue) & chrMark & ")"
                
            Case "小于"
                str = str & IIf(Trim(str) = "", "", " AND ") & "(" & fg.Cell(flexcpText, i, 1) & " < " & chrMark & Trim(strBefValue) & chrMark & ")"
                strFileds = strFileds & IIf(Trim(strFileds) = "", "", " AND ") & "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " < " & chrMark & Trim(strBefValue) & chrMark & ")"
            Case "不等于"
                str = str & IIf(Trim(str) = "", "", " AND ") & "(" & fg.Cell(flexcpText, i, 1) & " <> " & chrMark & Trim(strBefValue) & chrMark & ")"
                strFileds = strFileds & IIf(Trim(strFileds) = "", "", " AND ") & "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " <> " & chrMark & Trim(strBefValue) & chrMark & ")"
            Case "闭区间"
                str = str & IIf(Trim(str) = "", "", " AND ") & "(" & fg.Cell(flexcpText, i, 1) & " >= " & chrMark & Trim(strBefValue) & chrMark & " And " & fg.Cell(flexcpText, i, 1) & " <= " & chrMark & Trim(strBckValue) & chrMark & ")"
                strFileds = strFileds & IIf(Trim(strFileds) = "", "", " AND ") & "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " >= " & chrMark & Trim(strBefValue) & chrMark & " And " & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " <= " & chrMark & Trim(strBckValue) & chrMark & ")"
            Case "开区间"
                str = str & IIf(Trim(str) = "", "", " AND ") & "(" & fg.Cell(flexcpText, i, 1) & " > " & chrMark & Trim(strBefValue) & chrMark & " And " & fg.Cell(flexcpText, i, 1) & " < " & chrMark & Trim(strBckValue) & chrMark & ")"
                strFileds = strFileds & IIf(Trim(strFileds) = "", "", " AND ") & "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " > " & chrMark & Trim(strBefValue) & chrMark & " And " & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " < " & chrMark & Trim(strBckValue) & chrMark & ")"
            Case "(无效)"
            End Select
        Next i
    End If
    
    '或关系
    If Me.optAndOr(1).Value Then
        For i = 1 To fg.Rows - 1
            
            '输入内容特殊处理
            strBefValue = Trim(fg.Cell(flexcpText, i, 3))
            strBefValue = Replace(strBefValue, "'", "''")
            
            strBckValue = Trim(fg.Cell(flexcpText, i, 4))
            strBckValue = Replace(strBckValue, "'", "''")
            
            
            If Mid(fg.Cell(flexcpText, i, 1), 1, 1) = "[" Then
                intFieldType = arrDataFieldsType(Val(Right(fg.Cell(flexcpText, i, 1), Len(fg.Cell(flexcpText, i, 1)) - 1)))
            Else
                intFieldType = arrInnerFieldsType(Val(Right(fg.Cell(flexcpText, i, 1), Len(fg.Cell(flexcpText, i, 1)) - 1)))
            End If
            
            Select Case intFieldType
            
            Case ADODB.DataTypeEnum.adBSTR, ADODB.DataTypeEnum.adChar, ADODB.DataTypeEnum.adDate, ADODB.DataTypeEnum.adDBDate, ADODB.DataTypeEnum.adDBTime, _
                 ADODB.DataTypeEnum.adDBTimeStamp, ADODB.DataTypeEnum.adVarChar, ADODB.DataTypeEnum.adLongVarWChar, ADODB.DataTypeEnum.adVarChar, ADODB.DataTypeEnum.adVarWChar, ADODB.DataTypeEnum.adWChar
                
                chrMark = "'"
            Case Else
                chrMark = ""
            End Select
            
            Select Case Trim(fg.Cell(flexcpText, i, 2))
            Case "等于"
                str = str & IIf(Trim(str) = "", "", " OR ") & "(" & fg.Cell(flexcpText, i, 1) & " = " & chrMark & Trim(strBefValue) & chrMark & ")"
                strFileds = strFileds & IIf(Trim(strFileds) = "", "", " OR ") & "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " = " & chrMark & Trim(strBefValue) & chrMark & ")"
            Case "类似"
                str = str & IIf(Trim(str) = "", "", " OR ") & "(" & fg.Cell(flexcpText, i, 1) & " Like '%" & Trim(strBefValue) & "%'" & ")"
                strFileds = strFileds & IIf(Trim(strFileds) = "", "", " OR ") & "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " Like '%" & Trim(strBefValue) & "%'" & ")"
            Case "大于"
                str = str & IIf(Trim(str) = "", "", " OR ") & "(" & fg.Cell(flexcpText, i, 1) & " > " & chrMark & Trim(strBefValue) & chrMark & ")"
                strFileds = strFileds & IIf(Trim(strFileds) = "", "", " OR ") & "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " > " & chrMark & Trim(strBefValue) & chrMark & ")"
                
            Case "小于"
                str = str & IIf(Trim(str) = "", "", " OR ") & "(" & fg.Cell(flexcpText, i, 1) & " < " & chrMark & Trim(strBefValue) & chrMark & ")"
                strFileds = strFileds & IIf(Trim(strFileds) = "", "", " OR ") & "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " < " & chrMark & Trim(strBefValue) & chrMark & ")"
            Case "不等于"
                str = str & IIf(Trim(str) = "", "", " OR ") & "(" & fg.Cell(flexcpText, i, 1) & " <> " & chrMark & Trim(strBefValue) & chrMark & ")"
                strFileds = strFileds & IIf(Trim(strFileds) = "", "", " OR ") & "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " <> " & chrMark & Trim(strBefValue) & chrMark & ")"
            Case "闭区间"
                str = str & IIf(Trim(str) = "", "", " OR ") & "(" & fg.Cell(flexcpText, i, 1) & " >= " & chrMark & Trim(strBefValue) & chrMark & " And " & fg.Cell(flexcpText, i, 1) & " <= " & chrMark & Trim(strBckValue) & chrMark & ")"
                strFileds = strFileds & IIf(Trim(strFileds) = "", "", " OR ") & "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " >= " & chrMark & Trim(strBefValue) & chrMark & " And " & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " <= " & chrMark & Trim(strBckValue) & chrMark & ")"
            Case "开区间"
                str = str & IIf(Trim(str) = "", "", " OR ") & "(" & fg.Cell(flexcpText, i, 1) & " > " & chrMark & Trim(strBefValue) & chrMark & " And " & fg.Cell(flexcpText, i, 1) & " < " & chrMark & Trim(strBckValue) & chrMark & ")"
                strFileds = strFileds & IIf(Trim(strFileds) = "", "", " OR ") & "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " > " & chrMark & Trim(strBefValue) & chrMark & " And " & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " < " & chrMark & Trim(strBckValue) & chrMark & ")"
            Case "(无效)"
            End Select
        Next i
    End If
    
    '关系定制
    If Me.optAndOr(2).Value Then
        str = UCase(Trim(Me.txtAndOr.Text))
        strFileds = UCase(Trim(Me.txtAndOr.Text))
        For i = 1 To fg.Rows - 1
            
            '输入内容特殊处理
            strBefValue = Trim(fg.Cell(flexcpText, i, 3))
            strBefValue = Replace(strBefValue, "'", "''")
            
            strBckValue = Trim(fg.Cell(flexcpText, i, 4))
            strBckValue = Replace(strBckValue, "'", "''")
            
            
            If Mid(fg.Cell(flexcpText, i, 1), 1, 1) = "[" Then
                intFieldType = arrDataFieldsType(Val(Right(fg.Cell(flexcpText, i, 1), Len(fg.Cell(flexcpText, i, 1)) - 1)))
            Else
                intFieldType = arrInnerFieldsType(Val(Right(fg.Cell(flexcpText, i, 1), Len(fg.Cell(flexcpText, i, 1)) - 1)))
            End If
            
            Select Case intFieldType
            
            Case ADODB.DataTypeEnum.adBSTR, ADODB.DataTypeEnum.adChar, ADODB.DataTypeEnum.adDate, ADODB.DataTypeEnum.adDBDate, ADODB.DataTypeEnum.adDBTime, _
                 ADODB.DataTypeEnum.adDBTimeStamp, ADODB.DataTypeEnum.adVarChar, ADODB.DataTypeEnum.adLongVarWChar, ADODB.DataTypeEnum.adVarChar, ADODB.DataTypeEnum.adVarWChar, ADODB.DataTypeEnum.adWChar
                
                chrMark = "'"
            Case Else
                chrMark = ""
            End Select
            
            Select Case Trim(fg.Cell(flexcpText, i, 2))
            Case "等于"
                str = Replace(str, Trim(fg.Cell(flexcpText, i, 0)), "(" & fg.Cell(flexcpText, i, 1) & " = " & chrMark & Trim(strBefValue) & chrMark & ")")
                strFileds = Replace(strFileds, Trim(fg.Cell(flexcpText, i, 0)), "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " = " & chrMark & Trim(strBefValue) & chrMark & ")")
            Case "类似"
                 str = Replace(str, Trim(fg.Cell(flexcpText, i, 0)), "(" & fg.Cell(flexcpText, i, 1) & " Like '%" & Trim(strBefValue & "%'") & ")")
                 strFileds = Replace(strFileds, Trim(fg.Cell(flexcpText, i, 0)), "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " Like '%" & Trim(strBefValue & "%'") & ")")
            Case "大于"
                str = Replace(str, Trim(fg.Cell(flexcpText, i, 0)), "(" & fg.Cell(flexcpText, i, 1) & " > " & chrMark & Trim(strBefValue) & chrMark & ")")
                strFileds = Replace(strFileds, Trim(fg.Cell(flexcpText, i, 0)), "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " > " & chrMark & Trim(strBefValue) & chrMark & ")")
            Case "小于"
                str = Replace(str, Trim(fg.Cell(flexcpText, i, 0)), "(" & fg.Cell(flexcpText, i, 1) & " < " & chrMark & Trim(strBefValue) & chrMark & ")")
                strFileds = Replace(strFileds, Trim(fg.Cell(flexcpText, i, 0)), "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " < " & chrMark & Trim(strBefValue) & chrMark & ")")
            Case "不等于"
                str = Replace(str, Trim(fg.Cell(flexcpText, i, 0)), "(" & fg.Cell(flexcpText, i, 1) & " <> " & chrMark & Trim(strBefValue) & chrMark & ")")
                strFileds = Replace(strFileds, Trim(fg.Cell(flexcpText, i, 0)), "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " <> " & chrMark & Trim(strBefValue) & chrMark & ")")
            Case "闭区间"
                str = Replace(str, Trim(fg.Cell(flexcpText, i, 0)), "(" & fg.Cell(flexcpText, i, 1) & " >= " & chrMark & Trim(strBefValue) & chrMark & " And " & fg.Cell(flexcpText, i, 1) & " <= " & chrMark & Trim(strBckValue) & chrMark & ")")
                strFileds = Replace(strFileds, Trim(fg.Cell(flexcpText, i, 0)), "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " >= " & chrMark & Trim(strBefValue) & chrMark & " And " & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " <= " & chrMark & Trim(strBckValue) & chrMark & ")")
            Case "开区间"
                str = Replace(str, Trim(fg.Cell(flexcpText, i, 0)), "(" & fg.Cell(flexcpText, i, 1) & " > " & chrMark & Trim(strBefValue) & chrMark & " And " & fg.Cell(flexcpText, i, 1) & " < " & chrMark & Trim(strBckValue) & chrMark & ")")
                strFileds = Replace(strFileds, Trim(fg.Cell(flexcpText, i, 0)), "(" & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " > " & chrMark & Trim(strBefValue) & chrMark & " And " & getFieldByListItem(fg.Cell(flexcpText, i, 1)) & " < " & chrMark & Trim(strBckValue) & chrMark & ")")
            Case "(无效)"
            End Select
        Next i
    End If
    
    Me.txtCondition = str
    AdvancedCondition = strFileds
End Sub

Private Sub OKButton_Click()
    If Not setViewColumn Then Exit Sub
    Call setCompleteCondition
    
    If CheckValidate Then
        blnOK = True
        Unload Me
    End If
End Sub

Private Sub optAndOr_Click(Index As Integer)
    Select Case Index
    Case 0  '与关系
        Me.txtAndOr.Enabled = False
        Me.txtAndOr.BackColor = gclrUnEnable
    Case 1  '或关系
        Me.txtAndOr.Enabled = False
        Me.txtAndOr.BackColor = gclrUnEnable
    Case 2  '关系定制
        Me.txtAndOr.Enabled = True
        Me.txtAndOr.BackColor = gclrEnable
        Me.txtAndOr.SetFocus
        
    End Select
    Call setCompleteCondition
End Sub

Private Sub txtAndOr_Validate(Cancel As Boolean)
    If Trim(Me.txtAndOr.Text) <> "" Then setCompleteCondition
End Sub
'根据选项得到数据字段
Private Function getFieldByListItem(strListItem As String) As String
    Dim arr
    
    arr = Split(strListItem, " ")
    arr(0) = Right(arr(0), Len(arr(0)) - 1)
    If InStr(1, arr(0), "]") <> 0 Then
        getFieldByListItem = arrDataFields(Val(arr(0)))
    Else
        getFieldByListItem = arrInnerFields(Val(arr(0)))
    End If
    
End Function
'根据选项得到列头
Private Function getHeaderByListItem(strListItem As String) As String
    Dim arr
    
    arr = Split(strListItem, " ")
    arr(0) = Right(arr(0), Len(arr(0)) - 1)
    If InStr(1, arr(0), "]") <> 0 Then
        getHeaderByListItem = arrHeader(Val(arr(0)))
    Else
        getHeaderByListItem = arrDisplayFields(Val(arr(0)))
    End If
    
End Function

Private Function setViewColumn() As Boolean
    If lstView.ListCount = 0 Then
        MsgBox "“显示项目”不能为空！", vbInformation, "提示"
        setViewColumn = False
        Exit Function
    End If
    
    Dim i%
    
    ReDim arrViewHeader(lstView.ListCount - 1)
    ReDim arrViewFields(lstView.ListCount - 1)
    For i = 0 To lstView.ListCount - 1
        arrViewHeader(i) = getHeaderByListItem(lstView.List(i))
        arrViewFields(i) = getFieldByListItem(lstView.List(i))
    Next i
    
    setViewColumn = True
    
End Function

Private Function CheckValidate() As Boolean
'校验有效型
    On Error GoTo Err
    CheckValidate = False
    
    Dim strSQL$
    strSQL = " SELECT TOP 1 * From " & strFromObjects & IIf(Trim(AdvancedCondition) = "", "", " Where " & AdvancedCondition)
    Call gConnection.Execute(strSQL)
    
    CheckValidate = True
    Exit Function
Err:
    MsgBox "输入条件不合法，请校验后再应用或确认！", vbInformation
    CheckValidate = False
End Function
上一页 1 23
⌨️ 快捷键说明

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