generalquery.cls

来自「通用书店管理系统」· CLS 代码 · 共 271 行

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "GeneralQuery"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private gConnection As ADODB.Connection                   '定义一个工作数据库连接

Private arrHeader  As Variant                       '存放表列头
Private strHeaderMerge As String                    '列头合并处理
Private arrDataFields  As Variant                   '存放数据字段
Private arrDataFieldsType As Variant                '存放数据字段的数据类型
Private strFromObjects As String                    '存放表对象
Private strSQLGroupOrder As String                  'SQL中进行分组或排序

Private arrDisplayFields As Variant                 '存放查询交互显示字段
Private arrInnerFields As Variant                   '存放查询数据字段
Private arrInnerFieldsType As Variant               '存放查询数据字段数据类型

Private strConstCondition As String                 '存放常量查询条件

Private strReturnSQL As String                      '存放返回SQL语句
Private rstReturnRecordsets As ADODB.Recordset      '存放返回数据记录集

Private strGeneralCondition As String               '存放常用查询生成的条件语句

Private defPrintInfo As New DefinePrintInfo             '定义打印信息

Private arrGroup As Variant                             '分组
Private arrResizeColWidth As Variant                    '自动列宽缩放
Private arrResizeRowHeight As Variant                   '自动行高缩放
Private arrSort As Variant                              '排序
Private arrSubtotal As Variant                          '汇总

Private blnOnlyShowNormal As Boolean    '设置是否只显示Normal窗体

'设置打印信息
Public Property Set PrintInfo(ByVal vNewValue As DefinePrintInfo)
    Set defPrintInfo = vNewValue
End Property

'设置列头合并串
Public Property Let HeaderMerge(ByVal vNewValue As String)
    strHeaderMerge = vNewValue
End Property

'得到一个数据库连接
Public Property Get Connection() As ADODB.Connection
    Set Connection = gConnection
End Property

'设置一个数据库连接
Public Property Set Connection(ByVal vNewValue As ADODB.Connection)
    Set gConnection = vNewValue
End Property

'设置表列头
Public Property Let Header(ByVal vNewValue As Variant)
    arrHeader = vNewValue
End Property

'设置数据字段
Public Property Let DataFields(ByVal vNewValue As Variant)
    arrDataFields = vNewValue
End Property

'设置字段数据类型
Public Property Let DataFieldsType(ByVal vNewValue As Variant)
    arrDataFieldsType = vNewValue
End Property

'设置表对象
Public Property Let FromObjects(ByVal vNewValue As String)
    strFromObjects = vNewValue
End Property

'设置可视用户操作字段
Public Property Let DisplayFields(ByVal vNewValue As Variant)
    arrDisplayFields = vNewValue
End Property

'设置内部用户操作字段
Public Property Let InnerFields(ByVal vNewValue As Variant)
    arrInnerFields = vNewValue
End Property

'设置内部用户字段数据类型
Public Property Let InnerFieldsType(ByVal vNewValue As Variant)
    arrInnerFieldsType = vNewValue
End Property


'设置固定条件
Public Property Let ConstCondition(ByVal vNewValue As String)
    strConstCondition = vNewValue
End Property

'调用常用查询窗体方法
Public Function ShowGeneralQuery(ByVal AdvancedQuery As Boolean) As Boolean
    Dim frm As New frmGeneralQuery
    
    With frm
        .arrDisplayFields = arrDisplayFields
        .arrInnerFields = arrInnerFields
        .arrInnerFieldsType = arrInnerFieldsType
        .strFromObjects = strFromObjects
        
        If blnOnlyShowNormal Then .cmdAdvanced.Visible = False
        
        Set .gConnection = gConnection
        .Show vbModal
    End With
    
    If frm.blnOK Then
        strGeneralCondition = frm.GeneralCondition
        Call ShowQueryResult    '显示结果
        
    ElseIf frm.blnCallAdvanced Then
        Call ShowAdvancedQuery  '调用高级查询
    End If
    
    Set frm = Nothing
    ShowGeneralQuery = True
End Function

'调用高级查询方法
Private Function ShowAdvancedQuery()
    Dim aq As New AdvancedQuery
    With aq
        Set aq.Connection = gConnection
        .Header = arrHeader
        .DataFields = arrDataFields
        .DataFieldsType = arrDataFieldsType
        .FromObjects = strFromObjects
        .SQLGroupOrder = strSQLGroupOrder
        .ConstCondition = strConstCondition
        .DisplayFields = arrDisplayFields
        .InnerFields = arrInnerFields
        .InnerFieldsType = arrInnerFieldsType
        .HeaderMerge = strHeaderMerge
        
        .Group = arrGroup
        .Sort = arrSort
        .ResizeColWidth = arrResizeColWidth
        .ResizeRowHeight = arrResizeRowHeight
        .Subtotal = arrSubtotal
            
    Set .PrintInfo = defPrintInfo
        .ShowAdvancedQuery
    End With
        
    Set aq = Nothing
    
End Function

'调用显示查询结果方法
Private Function ShowQueryResult()
    
    Dim rstWork As New ADODB.Recordset
    strReturnSQL = ReturnResultSQL(arrHeader, arrDataFields, strFromObjects, strGeneralCondition, strConstCondition)
    Set rstReturnRecordsets = New ADODB.Recordset
    rstReturnRecordsets.Open strReturnSQL, gConnection, adOpenKeyset, adLockBatchOptimistic
    Set rstWork = rstReturnRecordsets
    
    Dim qr As New QueryResult
    If rstWork.RecordCount > 0 Then qr.InputArray = rstWork.GetRows
    
    With qr
        
        .Header = arrHeader
        .HeaderMerge = strHeaderMerge
        .DataFieldsType = arrDataFieldsType
        
        .arrGroup = arrGroup
        .arrResizeColWidth = arrResizeColWidth
        .arrResizeRowHeight = arrResizeRowHeight
        .arrSort = arrSort
        .arrSubtotal = arrSubtotal
        
        .ShowQueryResult
        
    End With
    
    Set rstWork = Nothing
End Function

'得到SQL结果
Public Property Get ReturnSQL() As String
    ReturnSQL = strReturnSQL
End Property

'得到结果记录集
Public Property Get ReturnRecordsets() As ADODB.Recordset
    Set ReturnRecordsets = rstReturnRecordsets
End Property

'得到相应的结果语句
Private Function ReturnResultSQL(arrHeader As Variant, arrDataFields As Variant, strFromObjects As String, strCondition As String, strConstCondition As String)
     
     Dim i%, tmp$, tmpHeader$, tmpCondition$
     '给字段名加上别名
     
     For i = 0 To UBound(arrHeader)
        tmpHeader = Trim(arrHeader(i))
        tmpHeader = "'" & Replace(tmpHeader, "'", "''") & "'"
        tmp = tmp & arrDataFields(i) & " AS " & tmpHeader & ","
     Next i
     If Trim(tmp) <> "" Then tmp = Left(tmp, Len(tmp) - 1)
     
     '追加表对象
     tmp = "SELECT " & tmp & " FROM " & strFromObjects
     '追加条件
     If Trim(strCondition) <> "" Then tmpCondition = tmpCondition & " WHERE " & strCondition
     If Trim(tmpCondition) <> "" Then
        If Trim(strConstCondition) <> "" Then
            tmpCondition = tmpCondition & " AND " & strConstCondition
        End If
     Else
        If Trim(strConstCondition) <> "" Then _
            tmpCondition = " WHERE " & strConstCondition
     End If
     tmp = tmp & tmpCondition
     
     '追加分组和排序
     tmp = tmp & " " & strSQLGroupOrder
     
     ReturnResultSQL = tmp
End Function

'预处理属性
Public Property Let Group(ByVal vNewValue As Variant)
    arrGroup = vNewValue
End Property
Public Property Let ResizeColWidth(ByVal vNewValue As Variant)
    arrResizeColWidth = vNewValue
End Property
Public Property Let ResizeRowHeight(ByVal vNewValue As Variant)
    arrResizeRowHeight = vNewValue
End Property
Public Property Let Sort(ByVal vNewValue As Variant)
    arrSort = vNewValue
End Property
Public Property Let Subtotal(ByVal vNewValue As Variant)
    arrSubtotal = vNewValue
End Property

'SQL中进行分组或排序--读取
Public Property Get SQLGroupOrder() As Variant
    SQLGroupOrder = strSQLGroupOrder
End Property

'SQL中进行分组或排序--设置
Public Property Let SQLGroupOrder(ByVal vNewValue As Variant)
    strSQLGroupOrder = vNewValue
End Property

'设置只显示Normal窗体
Public Property Let OnlyShowNormal(ByVal vNewValue As Boolean)
     blnOnlyShowNormal = vNewValue
End Property