frmadvancedquery.frm

通用书店管理系统

      End
      Begin VB.CommandButton cmdAddAll 
         Caption         =   ">>"
         Height          =   375
         Left            =   2070
         TabIndex        =   5
         Top             =   1485
         Width           =   435
      End
      Begin VB.CommandButton cmdAddOne 
         Caption         =   ">"
         Height          =   375
         Left            =   2070
         TabIndex        =   4
         Top             =   1125
         Width           =   435
      End
      Begin VB.CommandButton cmdDown 
         Caption         =   "↓"
         Height          =   375
         Left            =   4695
         TabIndex        =   3
         Top             =   870
         Width           =   435
      End
      Begin VB.CommandButton cmdUp 
         Caption         =   "↑"
         Height          =   375
         Left            =   4695
         TabIndex        =   2
         Top             =   510
         Width           =   435
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackColor       =   &H00C0C0C0&
         Caption         =   "*项目清单*"
         Height          =   180
         Index           =   0
         Left            =   570
         TabIndex        =   11
         Top             =   300
         Width           =   900
      End
      Begin VB.Label Label1 
         AutoSize        =   -1  'True
         BackColor       =   &H00C0C0C0&
         Caption         =   "*显示项目*"
         Height          =   180
         Index           =   1
         Left            =   3255
         TabIndex        =   10
         Top             =   270
         Width           =   900
      End
      Begin VB.Label Label2 
         BackColor       =   &H00C0C0C0&
         Caption         =   "对显示项目进行排序"
         Height          =   1785
         Left            =   4815
         TabIndex        =   9
         Top             =   1395
         Width           =   300
      End
   End
End
Attribute VB_Name = "frmAdvancedQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Const gclrUnEnable As Long = &HE0E0E0      '定义不可用文本颜色
Const gclrEnable As Long = vbWhite       '定义可用文本颜色

Public arrHeader As Variant                        '存放表列头
Public arrDataFields As Variant                    '存放数据字段
Public arrDataFieldsType As Variant                '存放数据字段的数据类型

Public arrDisplayFields As Variant      '显示查询字段
Public arrInnerFields As Variant        '内部查询字段
Public arrInnerFieldsType As Variant    '内部查询字段数据类型

Public AdvancedCondition As String      '查询字段数据类型
Public arrViewHeader As Variant         '最终要显示的列头
Public arrViewFields As Variant         '最终要显示的字段

Public blnOK As Boolean                 '是否确定

Public strFromObjects As String         '表或视图对象
Public gConnection As ADODB.Connection                   '定义一个工作数据库连接


Private Sub iniControl()    '控件初始化
    '文本框
    Me.txtAndOr.BackColor = gclrUnEnable
    Me.txtCondition.BackColor = gclrUnEnable
    
    'FlexGrid控件初始化
    With fg
        .Editable = flexEDKbdMouse
        
        .FixedAlignment(-1) = flexAlignCenterCenter
        .ColAlignment(0) = flexAlignLeftCenter
        .ColAlignment(1) = flexAlignLeftCenter
        .ColAlignment(2) = flexAlignRightCenter
        .ColAlignment(3) = flexAlignRightCenter
        .ColAlignment(4) = flexAlignRightCenter
        .SelectionMode = flexSelectionFree
        
        .ColComboList(2) = "(无效)|等于|类似|大于|小于|不等于|闭区间|开区间"
    
        '初始化变量
        .Rows = 1
        
    End With
    
    'listBox控件
    Dim i%, j%
    lstAll.Clear
    If TypeName(arrHeader) <> "Empty" Then
        For i = 0 To UBound(arrHeader)
            lstAll.AddItem "[" & i & "] " & Trim(arrHeader(i))
        Next i
    End If
    
    If TypeName(arrInnerFields) <> "Empty" Then
        For i = 0 To UBound(arrInnerFields)
            For j = 0 To UBound(arrHeader)
                If UCase(Trim(arrInnerFields(i))) = UCase(Trim(arrDataFields(j))) Then
                    Exit For
                End If
            Next j
            '如果不存在则添加该字段
            If j = UBound(arrHeader) + 1 Then
                lstAll.AddItem "【" & i & "】 " & Trim(arrDisplayFields(i))
            End If
        Next i
    End If
    
End Sub

Private Sub CancelButton_Click()
    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 cmdAdd_Click()
    '添加
    If lstAll.ListIndex = -1 Then
        MsgBox "请在“项目清单”中选择一个项目！", vbInformation, "提示"
        Exit Sub
    End If
    
    fg.Rows = fg.Rows + 1
    With fg
        .Cell(flexcpText, .Rows - 1, 0) = "C" & .Rows - 1
        .Cell(flexcpText, .Rows - 1, 1) = lstAll.List(lstAll.ListIndex)
        .Cell(flexcpText, .Rows - 1, 2) = "(无效)"
    End With
    
End Sub

Private Sub cmdAddAll_Click()
    '全部加入
    Dim i%
    
    lstView.Clear
    For i = 0 To lstAll.ListCount - 1
        If Left(Trim(lstAll.List(i)), 1) <> "【" Then lstView.AddItem Trim(lstAll.List(i))
    Next i
End Sub

Private Sub cmdAddOne_Click()
    '从项目清单中添加一个选项到显示项目中
    Dim i%
    
    If lstAll.ListCount = 0 Then Exit Sub
    If lstAll.ListIndex = -1 Then Exit Sub
    
    For i = 0 To lstView.ListCount - 1
        If Trim(lstView.List(i)) = Trim(lstAll.List(lstAll.ListIndex)) Then
            Exit For
        End If
    Next i
    
    If i = lstView.ListCount Then
        If Left(Trim(lstAll.List(lstAll.ListIndex)), 1) <> "【" Then lstView.AddItem Trim(lstAll.List(lstAll.ListIndex))
    End If
    
End Sub

Private Sub cmdClear_Click()
    '清空
    fg.Rows = 1
End Sub

Private Sub cmdDelete_Click()
    '删除
        
    If fg.Rows = 1 Then Exit Sub
    
    fg.RemoveItem (fg.RowSel)
    
    Call setGridOrder
    Call setCompleteCondition
    
End Sub

Private Sub cmdDown_Click()
    '向下排序
    If lstView.ListIndex = -1 Then Exit Sub
    
    Dim str$, i%
    i = lstView.ListIndex
    str = lstView.List(lstView.ListIndex)
    
    If i <> lstView.ListCount - 1 Then
        lstView.RemoveItem (lstView.ListIndex)
        lstView.AddItem str, i + 1
        lstView.Selected(i + 1) = True
    End If
    
End Sub

Private Sub cmdRemoveAll_Click()
    '清空
    lstView.Clear
End Sub

Private Sub cmdRemoveOne_Click()
    '移除一个
    If lstView.ListCount = 0 Then Exit Sub
    If lstView.ListIndex <> -1 Then lstView.RemoveItem (lstView.ListIndex)
End Sub

Private Sub cmdUp_Click()
    '向上排序
    If lstView.ListIndex = -1 Then Exit Sub
    
    Dim str$, i%
    i = lstView.ListIndex
    str = lstView.List(lstView.ListIndex)
    
    If i <> 0 Then
        lstView.RemoveItem (lstView.ListIndex)
        lstView.AddItem str, i - 1
        lstView.Selected(i - 1) = True
    End If
    
End Sub

Private Sub fg_AfterEdit(ByVal row As Long, ByVal Col As Long)
    Call setCompleteCondition
End Sub
Private Sub Form_Load()
    '初始化变量
'    arrHeader = Empty
'    arrDataFields = Empty
'    arrDataFieldsType = Empty
'
'    arrDisplayFields = Empty
'    arrInnerFields = Empty
'    arrInnerFieldsType = Empty
'
'    AdvancedCondition = ""
'    arrViewHeader = Empty
'    arrViewFields = Empty
    
    '初始化控件
    Call iniControl
End Sub

Private Sub cmdApplication_Click()
    
    Call setCompleteCondition
    Call CheckValidate