frmgeneralquery.frm

来自「通用书店管理系统」· FRM 代码 · 共 560 行 · 第 1/2 页

FRM
560 行
字号
12
    'FlexGrid控件初始化
    With fg
        .Editable = flexEDKbdMouse
        
        .FixedAlignment(-1) = flexAlignCenterCenter
        .ColAlignment(0) = flexAlignLeftCenter
        .ColAlignment(1) = flexAlignLeftCenter
        .ColAlignment(2) = flexAlignRightCenter
        .ColAlignment(3) = flexAlignRightCenter
        .ColAlignment(4) = flexAlignRightCenter
        
        .ColComboList(2) = "(无效)|等于|类似|大于|小于|不等于|闭区间|开区间"
    
        '初始化变量
        If TypeName(arrDisplayFields) <> "Empty" Then
            .Rows = UBound(arrDisplayFields) + 2
            Dim i%
            For i = 1 To .Rows - 1
                .Cell(flexcpText, i, 0) = "C" & i
                .Cell(flexcpText, i, 1) = Trim(arrDisplayFields(i - 1))
                .Cell(flexcpText, i, 2) = "(无效)"
            Next i
        End If
        
    End With
    
End Sub

Private Sub CancelButton_Click()
    blnCallAdvanced = False
    blnOK = False
    Unload Me
End Sub

Private Sub chkCustom_Click()
    If Me.chkCustom.Value = vbChecked Then
        Me.txtCondition.Enabled = True
        Me.txtCondition.BackColor = gclrEnable
    Else
        Me.txtCondition.Enabled = False
        Me.txtCondition.BackColor = gclrUnEnable
    End If
End Sub

Private Sub cmdAdvanced_Click()
    '调用高级查询
    blnCallAdvanced = True
    blnOK = False
    Unload Me
    
End Sub

Private Sub cmdApplication_Click()
    Call setCompleteCondition
    Call CheckValidate
End Sub

Private Sub fg_AfterEdit(ByVal row As Long, ByVal Col As Long)
    Call setCompleteCondition
End Sub

Private Sub Form_Load()
    '初始化变量
'    arrDisplayFields = Empty
'    arrInnerFields = Empty
'    GeneralCondition = Empty
'    blnCallAdvanced = False
'    blnOK = False
    
    Call iniControl         '初始化控件
    
End Sub

Private Sub OKButton_Click()
    Call setCompleteCondition
    If CheckValidate Then
        blnCallAdvanced = False
        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 setCompleteCondition()
    Dim i%, str$
    Dim chrMark$
    Dim strFileds$
    Dim strBefValue$
    Dim strBckValue$
    
    '与关系
    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, "'", "''")
            
            Select Case arrInnerFieldsType(i - 1)
           
            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 ") & "(" & arrInnerFields(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 ") & "(" & arrInnerFields(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 ") & "(" & arrInnerFields(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 ") & "(" & arrInnerFields(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 ") & "(" & arrInnerFields(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 ") & "(" & arrInnerFields(i - 1) & " >= " & chrMark & Trim(strBefValue) & chrMark & " And " & arrInnerFields(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 ") & "(" & arrInnerFields(i - 1) & " > " & chrMark & Trim(strBefValue) & chrMark & " And " & arrInnerFields(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, "'", "''")
            
            Select Case arrInnerFieldsType(i - 1)
           
            
            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 ") & "(" & arrInnerFields(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 ") & "(" & arrInnerFields(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 ") & "(" & arrInnerFields(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 ") & "(" & arrInnerFields(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 ") & "(" & arrInnerFields(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 ") & "(" & arrInnerFields(i - 1) & " >= " & chrMark & Trim(strBefValue) & chrMark & " And " & arrInnerFields(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 ") & "(" & arrInnerFields(i - 1) & " > " & chrMark & Trim(strBefValue) & chrMark & " And " & arrInnerFields(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, "'", "''")
            
            Select Case arrInnerFieldsType(i - 1)
           
            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)), "(" & arrInnerFields(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)), "(" & arrInnerFields(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)), "(" & arrInnerFields(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)), "(" & arrInnerFields(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)), "(" & arrInnerFields(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)), "(" & arrInnerFields(i - 1) & " >= " & chrMark & Trim(strBefValue) & chrMark & " And " & arrInnerFields(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)), "(" & arrInnerFields(i - 1) & " > " & chrMark & Trim(strBefValue) & chrMark & " And " & arrInnerFields(i - 1) & " < " & chrMark & Trim(strBckValue) & chrMark & ")")
            Case "(无效)"
            End Select
        Next i
    End If
    
    Me.txtCondition = str
    GeneralCondition = strFileds
End Sub

Private Sub txtAndOr_Validate(Cancel As Boolean)
    If Trim(Me.txtAndOr.Text) <> "" Then setCompleteCondition
End Sub
Private Function CheckValidate() As Boolean
'校验有效型
    On Error GoTo Err
    CheckValidate = False
    
    Dim strSQL$
    strSQL = " SELECT TOP 1 * From " & strFromObjects & IIf(Trim(GeneralCondition) = "", "", " Where " & GeneralCondition)
    Call gConnection.Execute(strSQL)
    
    CheckValidate = True
    Exit Function
Err:
    MsgBox "输入条件不合法，请校验后再应用或确认！", vbInformation
    CheckValidate = False
End Function
12

frmgeneralquery.frm - 源码说明

本页面展示了「通用书店管理系统」中的 frmgeneralquery.frm 源码文件，采用 FRM 编程语言编写，共 560 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫下载站收录了大量与书店管理系统相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

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