📄 guest.frm
字号:
Index = 2
Left = 3600
MouseIcon = "Guest.frx":7B0A0
MousePointer = 99 'Custom
TabIndex = 9
Top = 2040
Width = 1320
End
Begin VB.Label lblMenu
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "上海菜系"
BeginProperty Font
Name = "隶书"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00008000&
Height = 315
Index = 1
Left = 2040
MouseIcon = "Guest.frx":7B3AA
MousePointer = 99 'Custom
TabIndex = 8
Top = 2040
Width = 1320
End
Begin VB.Label lblMenu
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "北京菜系"
BeginProperty Font
Name = "隶书"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00008000&
Height = 315
Index = 0
Left = 480
MouseIcon = "Guest.frx":7B6B4
MousePointer = 99 'Custom
TabIndex = 7
Top = 2040
Width = 1320
End
Begin VB.Label lblDir
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "按菜名浏览"
BeginProperty Font
Name = "隶书"
Size = 15.75
Charset = 134
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H007C5EF9&
Height = 315
Index = 4
Left = 4920
MouseIcon = "Guest.frx":7B9BE
MousePointer = 99 'Custom
TabIndex = 6
Top = 1200
Width = 1650
End
Begin VB.Label lblDir
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "按原料分类"
BeginProperty Font
Name = "隶书"
Size = 15.75
Charset = 134
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H007C5EF9&
Height = 315
Index = 3
Left = 2040
MouseIcon = "Guest.frx":7BCC8
MousePointer = 99 'Custom
TabIndex = 5
Top = 1560
Width = 1650
End
Begin VB.Label lblDir
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "按烹饪方法分类"
BeginProperty Font
Name = "隶书"
Size = 15.75
Charset = 134
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H007C5EF9&
Height = 315
Index = 2
Left = 2160
MouseIcon = "Guest.frx":7BFD2
MousePointer = 99 'Custom
TabIndex = 4
Top = 1200
Width = 2310
End
Begin VB.Label lblDir
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "套餐系列"
BeginProperty Font
Name = "隶书"
Size = 15.75
Charset = 134
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H007C5EF9&
Height = 315
Index = 1
Left = 480
MouseIcon = "Guest.frx":7C2DC
MousePointer = 99 'Custom
TabIndex = 3
Top = 1560
Width = 1320
End
Begin VB.Label lblDir
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "各大菜系"
BeginProperty Font
Name = "隶书"
Size = 15.75
Charset = 134
Weight = 400
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H007C5EF9&
Height = 315
Index = 0
Left = 480
MouseIcon = "Guest.frx":7C5E6
MousePointer = 99 'Custom
TabIndex = 2
Top = 1200
Width = 1320
End
Begin VB.Label lblTele
AutoSize = -1 'True
BackStyle = 0 'Transparent
BeginProperty Font
Name = "隶书"
Size = 18
Charset = 134
Weight = 400
Underline = -1 'True
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 360
Left = 3840
TabIndex = 1
Top = 600
Width = 180
End
Begin VB.Label lblWelcome
AutoSize = -1 'True
BackStyle = 0 'Transparent
BeginProperty Font
Name = "隶书"
Size = 36
Charset = 134
Weight = 400
Underline = 0 'False
Italic = -1 'True
Strikethrough = 0 'False
EndProperty
ForeColor = &H0080FFFF&
Height = 720
Index = 0
Left = 3840
TabIndex = 0
Top = 0
Width = 360
End
End
Attribute VB_Name = "frmGuest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public DB As Database
Public Rec1 As Recordset
Dim Rec2 As Recordset
Dim strFieldName(4) As String
Dim curPay As Currency
Private Sub cmdAdd_Click()
If lstCustomer.ListCount = 0 Then
If Trim(txtCustomerID) = "" Then
MsgBox "请填写您的标识！", vbInformation, "订餐提示"
txtCustomerID = ""
txtCustomerID.SetFocus
Exit Sub
End If
If Trim(txtSetCount) = "" Then
MsgBox "请填写订餐套数！", vbInformation, "订餐提示"
txtSetCount = ""
txtSetCount.SetFocus
Exit Sub
End If
If Trim(txtOrderDate) = "" Then
MsgBox "请填写订餐日期！", vbInformation, "订餐提示"
txtOrderDate = ""
txtOrderDate.SetFocus
Exit Sub
Else
With txtOrderDate
If IsDate(Trim(.Text)) Then
.Text = Format(Trim(.Text), "YYYY-MM-DD")
Else
MsgBox "订餐日期无效！请按默认的日期格式填写。", vbInformation, "订餐提示"
.Text = Format(Date, "YYYY-MM-DD")
.SetFocus
.SelStart = 0
.SelLength = Len(txtOrderDate)
Exit Sub
End If
End With
End If
If Trim(txtDinnerDate) = "" Then
MsgBox "请填写用餐日期！", vbInformation, "订餐提示"
txtDinnerDate = ""
txtDinnerDate.SetFocus
Exit Sub
Else
With txtDinnerDate
If IsDate(Trim(.Text)) Then
.Text = Format(Trim(.Text), "YYYY-MM-DD")
Else
MsgBox "用餐日期无效！请按默认的日期格式填写。", vbInformation, "订餐提示"
.Text = Format(Date, "YYYY-MM-DD")
.SetFocus
.SelStart = 0
.SelLength = Len(txtOrderDate)
Exit Sub
End If
End With
End If
Rec2.FindFirst "CustomerID = '" & Trim(txtCustomerID) & "' And DinnerDate = #" & CDate(txtDinnerDate) & "#"
If Rec2.NoMatch = False Then
MsgBox "在相同的用餐日期内（" & txtDinnerDate & "），" & vbCrLf _
& "已有一位标识为“" & txtCustomerID & "”的客人。" & vbCrLf _
& "请您换一个标识吧！", vbInformation, "订餐提示"
txtCustomerID.SetFocus
txtCustomerID.SelStart = 0
txtCustomerID.SelLength = Len(txtCustomerID)
Exit Sub
End If
txtCustomerID.Locked = True
txtSetCount.Locked = True
txtOrderDate.Locked = True
txtDinnerDate.Locked = True
cmdCheck.Enabled = True
cmdPreview.Enabled = True
AddToCustomerMenu
If txtFindDate = txtDinnerDate Then
cmdFind_Click
End If
Else '如果lstCustomer中有内容的话
Dim I As Integer
For I = 0 To lstCustomer.ListCount - 1
If Trim(Mid(lstCustomer.List(I), 4)) = lstShowMenu.Text Then
lstCustomer.ListIndex = I
MsgBox "您已经选择了这道菜。如果想再加一份的话，请单击“增加一份”按钮。", vbInformation, "请餐提示"
cmdAddOne.SetFocus
Exit Sub
End If
Next I
AddToCustomerMenu
End If
End Sub
Private Sub cmdAddOne_Click()
Dim I As Integer
Dim strContent As String
Dim intNewCount As Integer
Dim curTotal As Currency
I = lstCustomer.ListIndex
strContent = lstCustomer.Text
intNewCount = Val(Left(strContent, 3)) + 1
If intNewCount > 999 Then
intNewCount = 999
MsgBox "您太喜欢这道菜了！我很高兴。您还是换一样尝尝吧！", vbInformation, "订餐提示"
End If
curTotal = Val(Trim(Right(strContent, 6))) * intNewCount * Val(txtSetCount)
lstCustomer.RemoveItem I
lstCustomer.AddItem Format(intNewCount, "000") & Mid(strContent, 4), I
lstCustomer.ListIndex = I
With Rec2
.FindFirst "CustomerID = '" & txtCustomerID & "' And DinnerDate = #" & CDate(txtDinnerDate) & "# And MenuName = '" & Trim(Mid(strContent, 8, 10)) & "'"
.Edit
.Fields("Count") = intNewCount
.Fields("TotalCount") = intNewCount * txtSetCount
.Fields("Total") = curTotal
.Update
End With
ReportTotal
End Sub
Private Sub cmdCheck_Click()
If MsgBox("结账以后的菜单不可编辑。要结账吗？", vbQuestion + vbYesNo, "结账提示") = vbNo Then
Exit Sub
End If
Dim strFind As String
strFind = "DinnerDate = #" & txtDinnerDate _
& "# And CustomerID = '" & txtCustomerID & "'"
With Rec2
.FindFirst strFind
Do Until .NoMatch
.Edit
.Fields("Checked") = 1
.Update
.FindNext strFind
Loop
End With
ReportTotal
If MsgBox("有优惠行动吗？", vbQuestion + vbYesNo, "结账提示") = vbYes Then
curPay = CCur(Val(Trim(Left(InputBox(strHotelName & "正在进行优惠大行动。" & vbCrLf & "您的消费实际价值：" & Format(curPay, "##0.00") & "元，" & vbCrLf & "但您只须付费（元）：", "优惠行动", curPay), 8))))
If curPay = 0 Then
ReportTotal
End If
End If
Dim Rec As Recordset
Set Rec = DB.OpenRecordset("Select * From Sale Order By Date")
With Rec
.AddNew
.Fields("Date") = txtDinnerDate
.Fields("CustomerID") = txtCustomerID
.Fields("Pay") = curPay
.Update
End With
Rec.Close
Set Rec = Nothing
cmdCheck.Enabled = False
cmdAdd.Enabled = False
cmdAddOne.Enabled = False
cmdDelete.Enabled = False
lblChecked = "已结账"
lblPay = "实际付费：" & Format(curPay, "##0.00") & "元"
MsgBox "客人：“" & txtCustomerID & "” 付款：" & Format(curPay, "##0.00") & "元。" & vbCrLf & "结账完毕！"⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -