📄 frmboxform.frm
字号:
Left = 4260
TabIndex = 18
Top = 240
Width = 2535
End
Begin VB.Label Label2
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 = &H00404040&
Height = 195
Index = 4
Left = 360
TabIndex = 17
Top = 240
Width = 2535
End
Begin VB.Image Image3
Height = 480
Index = 1
Left = 3855
Picture = "frmBoxForm.frx":48A1
Top = 135
Width = 480
End
Begin VB.Image Image3
Height = 480
Index = 0
Left = -60
Picture = "frmBoxForm.frx":49F3
Top = 135
Width = 480
End
Begin VB.Label Label2
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 = 4245
TabIndex = 16
Top = 255
Width = 2535
End
Begin VB.Label Label2
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 = 2
Left = 345
TabIndex = 15
Top = 255
Width = 2535
End
End
Begin VB.Menu mnuSystem
Caption = "包厢点菜系统(&S)"
Begin VB.Menu mnuDC
Caption = "预点菜(&D)"
Shortcut = {F9}
End
Begin VB.Menu mnuLD
Caption = "落单(&L)"
Shortcut = {F11}
End
Begin VB.Menu dsdsddsd
Caption = "-"
End
Begin VB.Menu mnuClean
Caption = "清除所有预点菜(&C)"
End
End
End
Attribute VB_Name = "frmBoxForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim bDel As Boolean
Dim sCustType As String
Public sBoxSite As String '包厢名
Dim IsRunning As Boolean '正在运行时
Public LDUser As String '落单人员
Private Sub cmdCancel_Click()
Unload Me
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub cmdClean_Click()
On Error GoTo DelErr
If MsgBox("真要删除所有预点酒菜吗？(Y/N)", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then Exit Sub
Dim DDB As Connection
Set DDB = CreateObject("ADODB.Connection")
DDB.Open Constr
DDB.Execute "Delete from tmpBox Where Site='" & sBoxSite & "'"
DDB.Close
ConfigGridPre
MsgBox "清除完毕！ ", vbInformation
Exit Sub
DelErr:
MsgBox "清除预点酒菜错误:" & Err.Description, vbCritical
Exit Sub
End Sub
Private Sub cmdOK_Click()
On Error GoTo ERR_HZ
If sBoxSite = "" Then
MsgBox "座位为空不能继续？ ", vbInformation
Exit Sub
End If
If lbStatus.Caption <> "『已经开台』,可以使用。" Then
MsgBox "该桌没有上台或者正在结帐，不能落单。", vbInformation
Exit Sub
End If
'没有预点菜时，不能落单
If GetPreMenu() = False Then
MsgBox "没有预点菜，不能落单。", vbInformation
cmdDC.SetFocus
Exit Sub
End If
'落单人员为空
LDUser = ""
frmBoxLogin.Show 1
If LDUser = "" Then
MsgBox "非法操作员，不能落单。 " & vbCrLf & "请确认工号与密码匹配。 ", vbExclamation
Exit Sub
End If
If MsgBox("是否确认落单，落单之后，包厢将不能修改。", vbInformation + vbYesNo) = vbNo Then
Exit Sub
End If
Me.MousePointer = 11
'落单操作，将 tmpBox中内容加入到tmpCust中
Dim CDB As Connection
Dim sTMp As String
Set CDB = CreateObject("ADODB.Connection")
CDB.Open Constr
CDB.BeginTrans
'1插入到点菜明细表中
CDB.Execute "Insert into tmpCust Select * from tmpBox Where Site='" & sBoxSite & "'"
'3插入到飞单机中
Dim Plane As Recordset
Dim Box As Recordset
Set Plane = CreateObject("ADODB.Recordset")
Set Box = CreateObject("ADODB.Recordset")
Plane.Open "ptCust", CDB, adOpenStatic, adLockOptimistic, adCmdTable
Box.Open "Select * from tmpBox", CDB, adOpenStatic, adLockReadOnly, adCmdText
If Not (Box.EOF And Box.BOF) Then
Do While Not Box.EOF
Plane.AddNew
Plane("ID") = Box("ID")
Plane("Site") = Box("Site")
Plane("Name") = Box("Name")
Plane("CID") = Box("CID")
Plane("Pingyin") = Box("Pingyin")
Plane("Unit") = Box("Unit")
Plane("Price") = Box("Price")
Plane("Quanty") = Box("Quanty")
Plane("JGF") = Box("JGF")
Plane("Amo") = Box("Amo")
Plane("Amos") = Box("Amos")
Plane("DType") = Box("DType")
Plane("SheelID") = Box("SheelID")
Plane("CDiscount") = Box("CDiscount")
Plane("YFAmo") = Box("YFAmo")
Plane.Update
Box.MoveNext
Loop
End If
Box.Close
Plane.Close
'If DeletePre = True Then
'4删除预点内容
CDB.Execute "Delete from tmpBox Where Site='" & sBoxSite & "'"
'End If
'2更新到飞单机中
CDB.Execute "Update ptCust Set AtTime='" & Time & "',DOper='" & LDUser & "' Where Site='" & sBoxSite & "' And DOper Is Null"
CDB.CommitTrans
CDB.Close
Set CDB = Nothing
Me.MousePointer = 0
'刷新菜单列表
ConfigGrid
ConfigGridPre
Exit Sub
ERR_HZ:
Me.MousePointer = 0
MsgBox "落单错误： " & vbCrLf & vbCrLf & Err.Description, vbInformation
On Error Resume Next
CDB.RollbackTrans
CDB.Close
Set CDB = Nothing
Exit Sub
End Sub
Private Function GetPreMenu() As Boolean
On Error GoTo GetEDrr
Dim PDB As Connection
Dim PRS As Recordset
Set PDB = CreateObject("ADODB.COnnection")
Set PRS = CreateObject("ADODB.Recordset")
PDB.Open Constr
PRS.Open "Select * from tmpBOX", PDB, adOpenStatic, adLockReadOnly, adCmdText
If PRS.EOF And PRS.BOF Then
GetPreMenu = False
Else
GetPreMenu = True
End If
PRS.Close
PDB.Close
Set PRS = Nothing
Set PDB = Nothing
Exit Function
GetEDrr:
MsgBox "检测是否有预点菜单错误。:" & Err.Description, vbCritical
GetPreMenu = False
End Function
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub cmdDC_Click()
On Error GoTo ERR_HZ
If sBoxSite = "" Then
MsgBox "座位为空不能继续？ ", vbInformation
Exit Sub
End If
'查询该座位是否能点菜=2时，才可以
Dim CDB As Connection
Dim cRS As Recordset
Set CDB = CreateObject("ADODB.Connection")
Set cRS = CreateObject("ADODB.Recordset")
CDB.Open Constr
cRS.Open "Select * from SiteType Where Class='" & sBoxSite & "'", CDB, adOpenStatic, adLockReadOnly, adCmdText
If cRS.EOF And cRS.BOF Then
cRS.Close
CDB.Close
Set cRS = Nothing
Set CDB = Nothing
MsgBox "餐桌号没有找到？ ", vbInformation
cmdCancel.SetFocus
Exit Sub
End If
Select Case cRS("SiteStatus")
Case 0
cRS.Close
CDB.Close
Set cRS = Nothing
Set CDB = Nothing
MsgBox "餐桌还没有『开台』，请通知收银处开台。", vbInformation
Exit Sub
Case 1
cRS.Close
CDB.Close
Set cRS = Nothing
Set CDB = Nothing
MsgBox "餐桌还没有『开台』，请通知收银处开台。", vbInformation
Exit Sub
Case 2
'点菜开始
cRS.Close
CDB.Close
Set cRS = Nothing
Set CDB = Nothing
Case 3
cRS.Close
CDB.Close
Set cRS = Nothing
Set CDB = Nothing
MsgBox "餐桌『正在结帐』，现在不能点菜。", vbInformation
Exit Sub
Case 4
cRS.Close
CDB.Close
Set cRS = Nothing
Set CDB = Nothing
MsgBox "餐桌『维修中』，现在不能上台或点菜。", vbInformation
Exit Sub
End Select
frmBoxDC.sBoxSite = sBoxSite
frmBoxDC.Show 1
'刷新菜单列表
ConfigGrid
ConfigGridPre
Exit Sub
ERR_HZ:
MsgBox "点菜错误： " & vbCrLf & vbCrLf & Err.Description, vbInformation
Exit Sub
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
Select Case KeyCode
Case 13
If cmdDC.Enabled = True Then cmdDC.Value = True '回车键时点菜
'Case 116 'F5
' If cmdPast.Enabled = True Then cmdPast.Value = True 'Click
'Case 117 'F6
' If cmdCancel.Enabled = True Then cmdCancel.Value = True
Case 120 'F9 'F9点菜
If cmdDC.Enabled = True Then cmdDC.Value = True
Case 121 'F10 'F10清除
If cmdClean.Enabled = True Then cmdClean.Value = True
Case 122 'F11
If cmdOK.Enabled = True Then cmdOK.Value = True
'Case 123
End Select
End Sub
Private Sub Form_Load()
On Error GoTo Err_Load
GetFormSet Me, Screen
lbStatus.Caption = "正在给出餐桌状态..."
shpCirCle.FillColor = &H808000
cmbSite.Text = sBoxSite
'配置菜单分类表
ConfigType
frmMain.lbControl.Caption = "包厢点菜系统"
'给出餐桌的实时状态
GetSiteStatus
Screen.MousePointer = 11
'配置点菜
ConfigGrid
'配置预点菜
ConfigGridPre
Screen.MousePointer = 0
Exit Sub
Err_Load:
MsgBox "表单加载错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
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
Frame1.Width = Me.Width - 260
Frame1.Height = Me.Height - Frame2.Height - 800
Strip1.Width = Frame1.Width
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -