form1.frm

一个很不错的风景区售票系统

      MouseIcon       =   "Form1.frx":305FF
      MousePointer    =   99  'Custom
      TabIndex        =   3
      Top             =   4800
      Width           =   1335
   End
   Begin VB.Label Label7 
      BackStyle       =   0  'Transparent
      Caption         =   "售票统计"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   600
      MouseIcon       =   "Form1.frx":30751
      MousePointer    =   99  'Custom
      TabIndex        =   2
      Top             =   4030
      Width           =   1335
   End
   Begin VB.Label Label6 
      BackStyle       =   0  'Transparent
      Caption         =   "售票查询"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   600
      MouseIcon       =   "Form1.frx":308A3
      MousePointer    =   99  'Custom
      TabIndex        =   1
      Top             =   3280
      Width           =   1335
   End
   Begin VB.Label Label5 
      BackStyle       =   0  'Transparent
      Caption         =   "景点售票"
      BeginProperty Font 
         Name            =   "楷体_GB2312"
         Size            =   15
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   375
      Left            =   620
      MouseIcon       =   "Form1.frx":309F5
      MousePointer    =   99  'Custom
      TabIndex        =   0
      Top             =   2550
      Width           =   1335
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim strsql As String '定义一个组织变量
Private Sub Form_Load()
Grid1.SetRegisterInformation "CNwinndy", "W]vyY-nonvk-u\nty-Zbl_e-`hms^" '进行注册
With Grid1
    .AllowUserResizing = True
    .DisplayFocusRect = False
    '.ExtenfjastCol = True
    .Appearance = Flat
    .FixedRowColStyle = Flat
    .ScrollBarStyle = Flat
    
    .DefaultFont.Name = "Tahoma"
    .DefaultFont.Size = 8
    .BackColorFixed = RGB(90, 158, 214)
    .BackColorFixedSel = RGB(110, 180, 230)
    .BackColorBkg = RGB(90, 158, 214)
    .BackColorScrollBar = RGB(128, 217, 193)
    .BackColor1 = RGB(231, 235, 247)
    .BackColor2 = RGB(239, 243, 255)
    .GridColor = RGB(148, 190, 231)
    .Column(0).Width = 0
    .Column(1).Width = 100
    .Column(6).Locked = True
    .Column(7).Locked = True
    .Column(9).CellType = cellCheckBox
   End With
   Label12.Caption = "系统日期：" & Date
With Grid2 '以下是对表格控件进行一些颜色和字体等设置
    .AllowUserResizing = True
    .DisplayFocusRect = False
    .ExtendLastCol = True
    .Appearance = Flat
    .FixedRowColStyle = Flat
    .ScrollBarStyle = Flat
    
    .DefaultFont.Name = "Tahoma"
    .DefaultFont.Size = 8
    .BackColorFixed = RGB(84, 201, 134) 'RGB(90, 158, 214)
    .BackColorFixedSel = RGB(84, 201, 134) 'RGB(110, 180, 230)
    .BackColorBkg = RGB(84, 201, 134) 'RGB(90, 158, 214)
    .BackColorScrollBar = RGB(231, 235, 247)
    .BackColor1 = RGB(231, 235, 247)
    .BackColor2 = RGB(239, 243, 255)
    .GridColor = RGB(148, 190, 231)
    .Column(0).Width = 0
End With
Grid2.Column(1).CellType = cellComboBox
Grid2.Column(2).CellType = cellComboBox
Grid2.Column(3).CellType = cellComboBox
Grid2.Cell(0, 1).Text = "查询模式" '将表格内添入固定内容
Grid2.Cell(0, 2).Text = "查询段"
Grid2.Cell(0, 3).Text = "条件"
Grid2.Cell(0, 4).Text = "关键字"
Grid2.Cell(0, 5).Text = "附加条件"
Grid2.ComboBox(1).AddItem "精确查询" '这里是类似combo框的操作，也是把内容添入combo控件的记录集
Grid2.ComboBox(1).AddItem "模糊查询"
fjnumber = 9
Grid1.Cols = fjnumber + 1
Set fj1 = cnn.Execute("select * from 售票记录")
For i = 1 To fjnumber
 Grid1.Cell(0, i).Text = fj1.Fields(i - 1).Name
Next
Grid1.Range(1, 1, Grid1.Rows - 1, Grid1.Cols - 1).Alignment = cellRightCenter
For i = 1 To Grid1.Cols - 1
Grid2.ComboBox(2).AddItem Grid1.Cell(0, i).Text
Next
'-----权限验证
Set fj1 = cnn.Execute("select * from 权限 where 员工号='" & adminname & "'")
If fj1.Fields(3) = "0" Then
 Label5.Enabled = False
End If
If fj1.Fields(4) = "0" Then
 Label6.Enabled = False
End If
If fj1.Fields(5) = "0" Then
 Label7.Enabled = False
End If
If fj1.Fields(6) = "0" Then
 Label8.Enabled = False
End If
If fj1.Fields(7) = "0" Then
 Label9.Enabled = False
End If
If fj1.Fields(8) = "0" Then
 Label10.Enabled = False
End If
If fj1.Fields(9) = "0" Then
 Label11.Enabled = False
End If
If fj1.Fields(10) = "0" Then
 XPButton1.Enabled = False
End If
'----------------------------------
End Sub

Private Sub Grid1_RowColChange(ByVal Row As Long, ByVal Col As Long)
hang = Row
End Sub

Private Sub Grid2_RowColChange(ByVal Row As Long, ByVal Col As Long)
On Error GoTo finish
If Grid2.Cell(1, 1).Text <> "" Then
 If Grid2.Cell(1, 1).Text = "精确查询" Then
Grid2.ComboBox(3).Clear '以下清除表格中combo集中的内容,并加入以下内容
Grid2.ComboBox(3).AddItem "="
Grid2.ComboBox(3).AddItem ">"
Grid2.ComboBox(3).AddItem "<"
Grid2.ComboBox(3).AddItem ">="
Grid2.ComboBox(3).AddItem "<="
Grid2.ComboBox(3).AddItem "<>"
Else
Grid2.ComboBox(3).Clear
Grid2.ComboBox(3).AddItem "like"
End If
End If
Exit Sub
finish:
  MsgBox Err.Description
End Sub

Private Sub Label10_Click()
lx.Show 1
End Sub

Private Sub Label11_Click()
cx.Show 1
End Sub

Private Sub Label15_Click()
End
End Sub

Private Sub Label5_Click()
Form2.Show 1
End Sub

Private Sub Label6_Click()
XPFrame1.Visible = True
End Sub

Private Sub Label7_Click()
form5.Show 1
End Sub

Private Sub Label8_Click()
Form4.Show
End Sub

Private Sub Label9_Click()
kucun.Show 1
End Sub

Private Sub XPButton1_Click() '修改记录为注销状态，这样这条销售记录就无效了
If hang <> 0 And Grid1.Cell(hang, 1).Text <> "" Then
sql = "update 售票记录 set 注销='" & Grid1.Cell(hang, 9).Text & "' where 售票日期='" & Grid1.Cell(hang, 6).Text & "' and 售票时间='" & Grid1.Cell(hang, 7).Text & "'"
'以上组织SQL中的修改语句
Set fj2 = cnn.Execute(sql) '将语句放到此处执行
MsgBox "已完成注销!"
End If
End Sub

Private Sub XPButton2_Click()
On Error GoTo finish '防错代码，防止用户组织语句的错误或其它不可预见的错误发生
Dim moshi As Integer '这是主要判断选择模式(精确还模糊)
If Grid2.Cell(1, 1).Text = "精确查询" Then
   moshi = 0
Else
   moshi = 1
End If
Select Case Grid2.Cell(1, 2).Text '以下主要通过多项选择来决定SQL语句的组织方法
 Case "人数", "单价", "打折扣率(%)", "金额"
 If moshi = 0 Then '通过已确定的模糊查询还是精确查询来决定语句的组成
  strsql = "select * from 售票记录 where " & Grid2.Cell(1, 2).Text & Grid2.Cell(1, 3).Text & Grid2.Cell(1, 4).Text
 Else
   MsgBox "数字型不支持模糊查询!", vbInformation, "提示"
   Exit Sub
 End If
Case Else
  If moshi = 0 Then
  strsql = "select * from 售票记录 where " & Grid2.Cell(1, 2).Text & Grid2.Cell(1, 3).Text & "'" & Grid2.Cell(1, 4).Text & "'"
 Else
   strsql = "select * from 售票记录 where " & Grid2.Cell(1, 2).Text & " " & Grid2.Cell(1, 3).Text & " '%" & Grid2.Cell(1, 4).Text & "%'"
 End If
End Select
   If Grid2.Cell(1, 5).Text <> "" Then '这是确定是否有附加条件，有则将其并入语句中一起执行
    strsql = strsql & " " & Grid2.Cell(1, 5).Text
   End If
Grid1.Rows = 1
Set fj1 = cnn.Execute(strsql)
Do While Not fj1.EOF '以下是将查询到的内容依次写入表格
Grid1.Rows = Grid1.Rows + 1
For i = 1 To fjnumber
Grid1.Cell(Grid1.Rows - 1, i).Text = fj1.Fields(i - 1)
Next
fj1.MoveNext
Loop
Label13.Caption = "符合条件的记录数:" & Grid1.Rows - 1 & "条!"
XPFrame1.Visible = False
Exit Sub
finish:
 MsgBox Err.Description
End Sub