📄 frmboxdctype.frm
字号:
VERSION 5.00
Begin VB.Form frmBoxDCType
BorderStyle = 3 'Fixed Dialog
Caption = "选择菜单类型"
ClientHeight = 3780
ClientLeft = 45
ClientTop = 330
ClientWidth = 5865
Icon = "frmBoxDCType.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3780
ScaleWidth = 5865
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin VB.Frame Frame1
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 3315
Left = 225
TabIndex = 3
Top = 195
Width = 5355
Begin VB.CommandButton cmdClose
Cancel = -1 'True
Caption = "关闭返回(&C)"
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 3615
TabIndex = 2
Top = 540
Width = 1560
End
Begin VB.ComboBox cmbWaiter
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 765
TabIndex = 0
Top = 570
Width = 2805
End
Begin VB.ListBox lstMenuNO
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1425
Left = 720
MouseIcon = "frmBoxDCType.frx":030A
MousePointer = 99 'Custom
TabIndex = 1
ToolTipText = "双击进入菜单区"
Top = 1380
Width = 4440
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "双击点菜？"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00404040&
Height = 1620
Index = 1
Left = 180
TabIndex = 12
Top = 1290
Width = 315
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "双击点菜？"
BeginProperty Font
Name = "MS Sans Serif"
Size = 12
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 1620
Index = 0
Left = 195
TabIndex = 11
Top = 1305
Width = 315
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
X1 = 645
X2 = 645
Y1 = 270
Y2 = 2880
End
Begin VB.Image Image2
Height = 480
Left = 5010
Picture = "frmBoxDCType.frx":045C
Top = 3000
Width = 480
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "如果上面类型为空，请在基本配置中添加菜单类型。"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 195
Index = 5
Left = 900
TabIndex = 8
Top = 2940
Width = 4485
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "i"
BeginProperty Font
Name = "Webdings"
Size = 9.75
Charset = 2
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 270
Index = 6
Left = 660
TabIndex = 7
Top = 2895
Width = 195
End
Begin VB.Image Image1
Height = 480
Left = 105
Picture = "frmBoxDCType.frx":05AE
Top = 525
Width = 480
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "::::::::::: 营业员列表 ::::::::::::::::::"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 195
Index = 4
Left = 720
TabIndex = 5
Top = 240
Width = 4335
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "::::::::::: 营业员列表 ::::::::::::::::::"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 195
Index = 3
Left = 735
TabIndex = 4
Top = 225
Width = 4335
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "【双击】下面的菜单类型->进行点菜或点酒水"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 195
Index = 0
Left = 735
TabIndex = 6
Top = 1065
Width = 3915
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "如果上面类型为空，请在基本配置中添加菜单类型。"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 195
Index = 1
Left = 915
TabIndex = 10
Top = 2925
Width = 4485
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "i"
BeginProperty Font
Name = "Webdings"
Size = 9.75
Charset = 2
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 270
Index = 2
Left = 645
TabIndex = 9
Top = 2880
Width = 195
End
Begin VB.Shape Shape1
FillColor = &H000080FF&
FillStyle = 0 'Solid
Height = 300
Left = 720
Top = 1020
Width = 4440
End
End
End
Attribute VB_Name = "frmBoxDCType"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmbWaiter_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
lstMenuNO.SetFocus
End If
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 27 Then
Unload Me
End If
End Sub
Private Sub Form_Load()
GetFormSet Me, Screen
'给出单号类型列表+++++++++++++++++++++++++++++++++++++++++
GetTypeList "MenuNoClass", lstMenuNO
'列表员工姓名
GetEmployList cmbWaiter
'给出服务员
Dim sWaiter As String
sWaiter = GetWaiter(sPubSite)
Label1(3).Caption = ":::::::【" & sPubSite & "】餐桌服务员： " & sWaiter & ":::::::::"
Label1(4).Caption = ":::::::【" & sPubSite & "】餐桌服务员： " & sWaiter & ":::::::::"
cmbWaiter.Text = sWaiter
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo SaveERR
SaveFormSet Me
'判断该桌是否已经点菜,如果有上台成功
'查询是否已经建立
Dim DB As Connection
Dim EF As Recordset
Dim sTmp As String
Screen.MousePointer = 11
Set DB = CreateObject("AdODb.Connection")
DB.Open Constr
Set EF = CreateObject("ADODB.Recordset")
sTmp = "Select * from tmpCust Where Site='" & sPubSite & "'"
EF.Open sTmp, DB, adOpenStatic, adLockReadOnly, adCmdText
'没有点菜时，返回
If EF.EOF And EF.BOF Then
EF.Close
DB.Close
Set EF = Nothing
Set DB = Nothing
Screen.MousePointer = 0
Exit Sub
End If
EF.Close
'否则有点菜时，建立上台标记/////////////////////////////////////
sTmp = "Select * from tmpSite Where Site='" & sPubSite & "'"
EF.Open sTmp, DB, adOpenStatic, adLockOptimistic, adCmdText
'还没有建立上台记录时
If EF.EOF And EF.BOF Then
EF.AddNew
EF.Fields("ID") = GetFixNo("座位号")
EF.Fields("CheckOutMan") = UserText
EF.Fields("Site") = sPubSite
EF.Fields("Date") = Date
EF.Fields("lHour") = Hour(Time) '给出小时
EF.Fields("lMinute") = Minute(Time) '给出分
EF.Fields("Waiter") = Trim(cmbWaiter.Text) '服务员
EF.Update
Else
'更新服务员名称
If Trim(cmbWaiter.Text) <> "" Then
EF.Fields("Waiter") = Trim(cmbWaiter.Text)
EF.Update
End If
End If
EF.Close
Set EF = Nothing
'显示当前台已经上台
sTmp = "Update SiteType Set SiteStatus=2 Where Class='" & sPubSite & "'"
DB.Execute sTmp
'删除预订内容，如果有的话
DB.Execute "Delete from tbdBook Where Class='" & sPubSite & "'"
DB.Close
Set DB = Nothing
Screen.MousePointer = 0
Exit Sub
SaveERR:
Screen.MousePointer = 0
MsgBox "保存上台信息错误:" & Err.Description, vbCritical
End Sub
Private Sub lstMenuNO_dblClick()
On Error GoTo ERRIT
If lstMenuNO.ListCount = 0 Then
MsgBox "", vbInformation
Exit Sub
End If
'点菜或加菜操作,或酒水单等等
sPubType = lstMenuNO.Text
'显示点菜单
Load frmDC
frmDC.Caption = sPubType & "【" & sPubSite & "】"
Screen.MousePointer = 0
frmDC.Show 1
Exit Sub
ERRIT:
Screen.MousePointer = 0
MsgBox "点菜时错误:" & Err.Description, vbCritical
End Sub
Private Sub lstMenuNO_KeyDown(KeyCode As Integer, Shift As Integer)
'回车进入
If KeyCode = 13 Then
lstMenuNO_dblClick
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -