frmqueryreport.frm

VB数据库设计的代码。需要根据自己的数据库再作调整

VERSION 5.00
Begin VB.Form frmQueryReport 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "报表查询条件设定"
   ClientHeight    =   2235
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   2235
   ScaleWidth      =   4680
   StartUpPosition =   1  '所有者中心
   Begin VB.TextBox txtDate 
      Height          =   300
      Left            =   720
      TabIndex        =   7
      Text            =   "txtDate"
      Top             =   840
      Width           =   3495
   End
   Begin VB.ComboBox cmbShopName 
      Height          =   300
      Left            =   720
      Style           =   2  'Dropdown List
      TabIndex        =   6
      Top             =   240
      Width           =   3495
   End
   Begin VB.CommandButton cmdClose 
      Caption         =   "关闭"
      Height          =   375
      Left            =   3593
      TabIndex        =   5
      Top             =   1560
      Width           =   855
   End
   Begin VB.CommandButton cmdPrint 
      Caption         =   "打印"
      Height          =   375
      Left            =   2473
      TabIndex        =   4
      Top             =   1560
      Width           =   855
   End
   Begin VB.CommandButton cmdPrePrint 
      Caption         =   "预览"
      Height          =   375
      Left            =   1353
      TabIndex        =   3
      Top             =   1560
      Width           =   855
   End
   Begin VB.CommandButton cmdQuery 
      Caption         =   "查询"
      Height          =   375
      Left            =   233
      TabIndex        =   2
      Top             =   1560
      Width           =   855
   End
   Begin VB.Label lblErrorInfo 
      Caption         =   "lblErrorInfo"
      ForeColor       =   &H000000FF&
      Height          =   255
      Left            =   240
      TabIndex        =   8
      Top             =   1200
      Width           =   3975
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "日期"
      Height          =   180
      Left            =   240
      TabIndex        =   1
      Top             =   900
      Width           =   360
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "店名"
      Height          =   180
      Left            =   240
      TabIndex        =   0
      Top             =   300
      Width           =   360
   End
End
Attribute VB_Name = "frmQueryReport"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public Enum UserClickButton
    QUERYBUTTON = 1
    PREPRINTBUTTON = 2
    PRINTBUTTON = 3
    CLOSEBUTTON = 4
End Enum


'设定条件
Public g_ShopId As Integer '店ID
Public g_QueryDate As Date '查询日期
Public g_ButtonSel As UserClickButton '用户操作选择

'***********************************************************************
'* 过程名：IniComboxShop
'* 功  能：初始化连锁店下拉框
'* 参  数：
'* 版  本：2006.01.06 颜志军 初版
'***********************************************************************
Private Sub IniComboxShop()
    '变量定义
    Dim shopList As clsMembershopSet        '连锁店集合
    Dim singleShop As clsMembershop         '连锁店
    Dim index As Integer                    '索引
    Dim curIndex As Integer                 '当前显示项
    
    '生成类别集合
    Set shopList = New clsMembershopSet
    
    '初始化COMBOX列表
    index = 0
    curIndex = 0
    For Each singleShop In shopList
        cmbShopName.AddItem singleShop.shopName, index
        cmbShopName.ItemData(index) = singleShop.shopId
        If g_currentUser.shopId = singleShop.shopId Then
            curIndex = index
        End If
        index = index + 1
    Next
    
    '初始化显示项
    If cmbShopName.ListCount > 0 Then
        cmbShopName.ListIndex = curIndex
    End If
    
    '店操作员不允许更改店名
    If g_currentUser.userRank = 4 Then
        cmbShopName.Enabled = False
    End If
End Sub

'***********************************************************************
'* 过程名：cmdClose_Click
'* 功  能：关闭按钮CLICK事件响应
'* 参  数：
'* 版  本：2006.01.06 颜志军 初版
'***********************************************************************
Private Sub cmdClose_Click()
    Me.Hide
End Sub

'***********************************************************************
'* 过程名：cmdPrePrint_Click
'* 功  能：预览按钮CLICK事件响应
'* 参  数：
'* 版  本：2006.01.06 颜志军 初版
'***********************************************************************
Private Sub cmdPrePrint_Click()
    UserClick
    g_ButtonSel = PREPRINTBUTTON
End Sub

'***********************************************************************
'* 过程名：cmdPrint_Click
'* 功  能：打印按钮CLICK事件响应
'* 参  数：
'* 版  本：2006.01.06 颜志军 初版
'***********************************************************************
Private Sub cmdPrint_Click()
    UserClick
    g_ButtonSel = PRINTBUTTON
End Sub

'***********************************************************************
'* 过程名：cmdQuery_Click
'* 功  能：查询按钮CLICK事件响应
'* 参  数：
'* 版  本：2006.01.06 颜志军 初版
'***********************************************************************
Private Sub cmdQuery_Click()
    UserClick
    g_ButtonSel = QUERYBUTTON
End Sub

'***********************************************************************
'* 过程名：Form_Load
'* 功  能：窗体LOAD事件响应
'* 参  数：
'* 版  本：2006.01.06 颜志军 初版
'***********************************************************************
Private Sub Form_Load()
    g_ButtonSel = CLOSEBUTTON
    IniComboxShop
    txtDate.Text = CStr(Date)
    lblErrorInfo.Caption = ""
End Sub

'***********************************************************************
'* 过程名：UserClick
'* 功  能：用户按下按钮
'* 参  数：
'* 版  本：2006.01.06 颜志军 初版
'***********************************************************************
Private Sub UserClick()
    '检查日期输入
    If IsEmpty(Trim(txtDate.Text)) Or Trim(txtDate.Text) = "" Then
        lblErrorInfo.Caption = "请输入日期！"
        Exit Sub
    End If
    
    g_ShopId = cmbShopName.ItemData(cmbShopName.ListIndex)
    
    On Error GoTo DSPERRINFO:
    g_QueryDate = CDate(txtDate.Text)
    
    Me.Hide
    Exit Sub
DSPERRINFO:
    lblErrorInfo.Caption = "输入的日期不合法！"
End Sub