📄 frmbrowserbook.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmBrowserBook
Caption = "浏览预订信息"
ClientHeight = 5565
ClientLeft = 60
ClientTop = 630
ClientWidth = 8760
Icon = "frmBrowserBook.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MDIChild = -1 'True
ScaleHeight = 5565
ScaleWidth = 8760
WindowState = 2 'Maximized
Begin VB.Frame Frame1
Height = 735
Left = 150
TabIndex = 5
Top = 0
Width = 9630
Begin VB.CommandButton cmdFindAll
Caption = "显示所有预订(&A)"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 105
TabIndex = 1
Top = 165
Width = 1725
End
Begin VB.CommandButton cmdPrint
Caption = "打印预订列表(&P)"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 3585
TabIndex = 3
Top = 165
Width = 1725
End
Begin VB.CommandButton cmdFind
Caption = "查询预订单(&F)"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 1845
TabIndex = 2
Top = 165
Width = 1725
End
Begin VB.CommandButton cmdClose
Cancel = -1 'True
Caption = "关闭(&Exit)"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 7380
TabIndex = 4
Top = 165
Width = 1410
End
End
Begin MSComctlLib.ListView lstPro
Height = 4065
Left = 135
TabIndex = 0
ToolTipText = "双击查看预订信息"
Top = 780
Width = 8685
_ExtentX = 15319
_ExtentY = 7170
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = -1 'True
AllowReorder = -1 'True
FullRowSelect = -1 'True
GridLines = -1 'True
_Version = 393217
ForeColor = -2147483640
BackColor = -2147483643
BorderStyle = 1
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 10
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "编号"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "预订餐桌"
Object.Width = 2205
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 2
SubItemIndex = 2
Text = "时间"
Object.Width = 970
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 2
SubItemIndex = 3
Text = "预订日期"
Object.Width = 2028
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 4
Text = "创建时间"
Object.Width = 2028
EndProperty
BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 5
Text = "创建时间"
Object.Width = 1587
EndProperty
BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 6
Text = "会员编号"
Object.Width = 1587
EndProperty
BeginProperty ColumnHeader(8) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 7
Text = "联系人"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(9) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 8
Text = "联系电话"
Object.Width = 2646
EndProperty
BeginProperty ColumnHeader(10) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 9
Text = "人数"
Object.Width = 970
EndProperty
End
Begin VB.Menu mnuOperator
Caption = "预订操作(&O)"
Begin VB.Menu mnuVIew
Caption = "查看预订信息(&V)"
End
Begin VB.Menu abcd
Caption = "-"
End
Begin VB.Menu mnuFInd
Caption = "查询预订单(&F)"
Shortcut = {F3}
End
Begin VB.Menu mnuAll
Caption = "显示所有预订(&A)"
Shortcut = ^A
End
Begin VB.Menu jjjjj
Caption = "-"
End
Begin VB.Menu mnuCancel
Caption = "取消预订(&C)"
Shortcut = {F5}
End
Begin VB.Menu afsd
Caption = "-"
End
Begin VB.Menu mnuPrint
Caption = "打印预订列表(&P)"
Shortcut = ^P
End
End
End
Attribute VB_Name = "frmBrowserBook"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdFind_Click()
frmBookFind.Show 1
If QueryStr = "" Then
'刷新预订信息,显示所有预订信息
'Me.MousePointer = 11
'RefreshBook "Select * from tbdBOOK"
'Me.MousePointer = 0
Else
'刷新预订信息,显示所有预订信息
Me.MousePointer = 11
RefreshBook "Select * from tbdBOOK " & QueryStr
Me.MousePointer = 0
End If
End Sub
Private Sub cmdFindAll_Click()
'刷新预订信息,显示所有预订信息
Me.MousePointer = 11
RefreshBook "Select * from tbdBOOK"
Me.MousePointer = 0
End Sub
Private Sub cmdPrint_Click()
If lstPro.ListItems.Count = 0 Then Exit Sub
'打印列表
If MsgBox("真的要打印【预订单】列表吗？(Y/N) " & vbCrLf _
& "请设置打印机的纸张：A4 纵向 ", vbInformation + vbYesNo) = vbNo Then
Exit Sub
End If
Dim ptGrid As listViewPrint
'建立打印对象
On Error GoTo Err1
Dim strPageLeft As String
Dim strPageTop As String
Dim PageTop As Long
Dim PageLeft As Long
Set ptGrid = New listViewPrint
ptGrid.N_Border = 1
ptGrid.N_Cols = "1,2,3,4,5,6,7,8,9,10"
Set ptGrid.N_Grid = lstPro
ptGrid.N_TiTle = "【预订单】"
ptGrid.N_Head10 = "制表人：" & UserText
ptGrid.N_Head2 = "制表时间：" & Now
ptGrid.N_PageLeft = XLeft
ptGrid.N_PageTop = XTop
ptGrid.N_PageHeight = 290
ptGrid.N_PageWidth = 200
ptGrid.N_RowHeight = 6
ptGrid.PrintPage
Set ptGrid = Nothing
Exit Sub
Err1:
MsgBox "对不起,打印列表错误。 " & vbCrLf & vbCrLf & Err.Description, vbInformation
Exit Sub
End Sub
Private Sub Form_Activate()
'刷新预订信息,显示所有预订信息
frmMain.lbControl.Caption = "客户预订信息浏览"
Me.MousePointer = 11
RefreshBook "Select * from tbdBOOK"
Me.MousePointer = 0
End Sub
Private Sub Form_Load()
GetFormSet Me, frmMain
BrowserBookFocus = True
End Sub
Private Sub Form_Resize()
On Error Resume Next
If Me.WindowState = 1 Then Exit Sub
'常规时
If Me.WindowState = 0 Then
Me.Move 1, 1, frmMain.Width - (frmMain.picTool.Width + 200), frmMain.Height - (frmMain.picADV.Height + 1150)
End If
'浏览带
lstPro.Left = 100
lstPro.Width = Me.Width - 300
lstPro.Height = Me.Height - Frame1.Height - 550
Frame1.Width = Me.Width - 350
cmdClose.Left = Me.Width - cmdClose.Width - 400
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
SaveFormSet Me
BrowserBookFocus = False
frmMain.lbControl.Caption = "收银控制中心"
End Sub
Private Sub lstPro_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
On Error Resume Next
'排序操作
If lstPro.ListItems.Count > 0 Then
lstPro.SortKey = ColumnHeader.Index - 1
lstPro.Sorted = True
If lstPro.SortOrder = lvwAscending Then
lstPro.SortOrder = lvwDescending
Else
lstPro.SortOrder = lvwAscending
End If
End If
End Sub
Private Sub RefreshBook(sOrder As String)
On Error GoTo LoadERR
Me.MousePointer = 11
Dim DB As Connection
Dim EF As Recordset
Dim lColor As Long
Dim x As Integer
Dim sTime As String
Set DB = CreateObject("ADODB.Connection")
Set EF = CreateObject("ADODB.Recordset")
DB.Open Constr
EF.Open sOrder, DB, adOpenStatic, adLockReadOnly, adCmdText
lstPro.Visible = False
lstPro.ListItems.Clear
If Not (EF.EOF And EF.BOF) Then
Do While Not EF.EOF
Select Case EF("DatePart")
Case 1
sTime = "中午"
Case 2
sTime = "下午"
Case 3
sTime = "晚上"
End Select
InsertToBook lstPro, EF.Fields("ID"), EF.Fields("Class"), sTime, _
EF.Fields("ExpireDate"), EF.Fields("BookDate"), NullValue(EF.Fields("ExpireTime")), NullValue(EF.Fields("CID")), EF.Fields("CName"), _
NullValue(EF.Fields("Tel")), EF.Fields("Num")
DoEvents
EF.MoveNext
Loop
End If
lstPro.Visible = True
EF.Close
Set EF = Nothing
DB.Close
Set DB = Nothing
Me.MousePointer = 0
Exit Sub
LoadERR:
Me.MousePointer = 0
MsgBox "给出预定列表错误:" & Err.Description, vbExclamation
Exit Sub
End Sub
'添加到预订列表中
Private Sub InsertToBook(tmpView As ListView, sText1 As String, sText2 As String, sText3 As String _
, sText4 As String, sText5 As String, sText6 As String, sText7 As String, sText8 As String, sText9 As String, sText10 As String)
On Error Resume Next
If Trim(sText1) = "" Then Exit Sub
Dim lstTmp As ListItem
Set lstTmp = tmpView.ListItems.Add
lstTmp.Text = Trim(sText1)
lstTmp.SubItems(1) = Trim(sText2)
lstTmp.SubItems(2) = Trim(sText3)
lstTmp.SubItems(3) = Trim(sText4)
lstTmp.SubItems(4) = Trim(sText5)
lstTmp.SubItems(5) = Trim(sText6)
lstTmp.SubItems(6) = Trim(sText7)
lstTmp.SubItems(7) = Trim(sText8)
lstTmp.SubItems(8) = Trim(sText9)
lstTmp.SubItems(9) = Trim(sText10)
'lstTmp.SubItems(10) = Trim(sText11)
End Sub
Private Sub lstPro_DblClick()
Call mnuView_Click
End Sub
Private Sub lstPro_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If lstPro.ListItems.Count = 0 Then Exit Sub
If lstPro.SelectedItem.Text = "" Then
mnuCancel.Enabled = False
mnuView.Enabled = False
Else
mnuCancel.Enabled = True
mnuView.Enabled = True
End If
If Button = 2 Then
PopupMenu mnuOperator
End If
End Sub
Private Sub mnuAll_Click()
Call cmdFindAll_Click
End Sub
Private Sub mnuCancel_Click()
On Error GoTo CancelERR
If lstPro.SelectedItem.Text = "" Then
MsgBox "预订的座位为空，不能取消预订。 ", vbInformation
Exit Sub
End If
If CancelBook(lstPro.SelectedItem.Text) = True Then
'刷新所有预订
lstPro.ListItems.Remove lstPro.SelectedItem.Index
End If
Exit Sub
CancelERR:
MsgBox "取消错误:" & Err.Description, vbExclamation
End Sub
Private Sub mnuFInd_Click()
Call cmdFind_Click
End Sub
Private Sub mnuOperator_Click()
If lstPro.ListItems.Count = 0 Then Exit Sub
If lstPro.SelectedItem.Text = "" Then
mnuCancel.Enabled = False
mnuView.Enabled = False
Else
mnuCancel.Enabled = True
mnuView.Enabled = True
End If
End Sub
Private Sub mnuPrint_Click()
Call cmdPrint_Click
End Sub
Private Sub mnuView_Click()
If lstPro.ListItems.Count = 0 Then Exit Sub
If lstPro.SelectedItem.Text = "" Then
MsgBox "预订编号为空，不能查看预订内容。 ", vbInformation
Exit Sub
End If
ViewBook lstPro.SelectedItem.Text
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -