?? 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 + -