📄 frmconsumedetail.frm
字号:
End
Begin VB.Frame Frame1
Caption = "菜单明细"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00404040&
Height = 3915
Left = 135
TabIndex = 13
Top = 1590
Width = 9315
Begin MSComctlLib.ListView lstCust
Height = 3660
Left = 45
TabIndex = 12
ToolTipText = "消费点菜明细"
Top = 210
Width = 9210
_ExtentX = 16245
_ExtentY = 6456
View = 3
LabelEdit = 1
LabelWrap = -1 'True
HideSelection = 0 'False
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 = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
NumItems = 9
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "编号"
Object.Width = 1411
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "助记编码"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "菜 名"
Object.Width = 2469
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 2
SubItemIndex = 3
Text = "单位"
Object.Width = 1235
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 4
Text = "单价"
Object.Width = 1411
EndProperty
BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 5
Text = "数量"
Object.Width = 1411
EndProperty
BeginProperty ColumnHeader(7) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 2
SubItemIndex = 6
Text = "加工费"
Object.Width = 1587
EndProperty
BeginProperty ColumnHeader(8) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 7
Text = "金额"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(9) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 2
SubItemIndex = 8
Text = "餐桌"
Object.Width = 2540
EndProperty
End
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "VB中国网：http://www.vb-code.net"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 195
Index = 1
Left = 405
TabIndex = 29
Top = 5580
Width = 3300
End
Begin VB.Shape Shape1
BorderColor = &H00FFFFFF&
FillColor = &H00808080&
FillStyle = 0 'Solid
Height = 195
Left = 120
Shape = 3 'Circle
Top = 5565
Width = 255
End
Begin VB.Label Label3
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "VB中国网：http://www.vb-code.net"
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 = 390
TabIndex = 28
Top = 5565
Width = 3300
End
End
Attribute VB_Name = "frmConsumeDetail"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public sViewSite As String
Public nViewID As Long
Private Sub ConfigGrid()
' On Error GoTo Err_init
Dim sSQL As String
'当前座位,当前菜单中内容,每ID代表一桌消费
sSQL = "Select * From Cust Where SheelID=" & nViewID
Me.MousePointer = 11
lstCust.ListItems.Clear
Dim DB As Connection, EF As Recordset
Dim curJGF As Currency, curQuanty As Currency, curAmos As Currency
curJGF = 0: curQuanty = 0: curAmos = 0
Set DB = CreateObject("ADODB.Connection")
Set EF = CreateObject("ADODB.Recordset")
DB.Open Constr
EF.Open sSQL, DB, adOpenStatic, adLockReadOnly, adCmdText
If Not (EF.EOF And EF.BOF) Then
Do While Not EF.EOF()
curJGF = curJGF + EF("JGF")
curQuanty = curQuanty + EF("Quanty")
curAmos = curAmos + EF("AMOS")
InsertToCust lstCust, EF("ID"), EF("CID"), EF("Name"), NullValue(EF("Unit")), _
EF("Price"), EF("Quanty"), EF("JGF"), EF("AMOS"), EF("Site")
EF.MoveNext
Loop
'插入小计
InsertToCust lstCust, " ", " ", "【 小 计 】", " ", Chr(10), Trim(CStr(curQuanty)), Trim(CStr(curJGF)), Trim(CStr(curAmos)), " "
'插入包厢费
InsertToCust lstCust, " ", " ", "", " ", Chr(10), Chr(10), "包厢费", ftBXF.Text, " "
'插入合计总额
InsertToCust lstCust, " ", " ", "【 合 计 】", " ", Chr(10), Chr(10), "", CStr(CCur(ftBXF.Text) + curAmos), " "
End If
EF.Close
Set EF = Nothing
DB.Close
Set DB = Nothing
Me.MousePointer = 0
Exit Sub
Err_init:
Me.MousePointer = 0
MsgBox "给出餐桌的单据错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub Form_Activate()
'给出餐桌错误
GetConsume
ConfigGrid
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
End Sub
Private Sub Form_Unload(Cancel As Integer)
SaveFormSet Me
End Sub
Private Sub GetConsume()
On Error GoTo Err_init
Dim sSQL As String
'当前座位,当前菜单中内容,每ID代表一桌消费
sSQL = "Select Site.Site,Site.Date,Site.lHour,Site.lMinute,Site.CheckOutman,Site.MID," _
& "tbdMember.Name,Site.JeAmo,Site.SFAmo,Site.Waiter,Site.BXF,Site.Discount " _
& " From Site Left Join tbdMember On Site.MID=tbdMember.ID Where Site.ID=" & nViewID
Me.MousePointer = 11
Dim DB As Connection, EF As Recordset
Set DB = CreateObject("ADODB.Connection")
Set EF = CreateObject("ADODB.Recordset")
DB.Open Constr
EF.Open sSQL, DB, adOpenStatic, adLockReadOnly, adCmdText
If Not (EF.EOF And EF.BOF) Then
ftSite.Text = EF("Site")
ftDate.Text = EF("Date")
ftHour.Text = EF("lHour")
ftMinute.Text = EF("lMinute")
ftOperator.Text = NullValue(EF("checkOutMan"))
ftMID.Text = NullValue(EF("MID"))
ftName.Text = NullValue(EF("Name"))
ftJeAmo.Text = EF("JEAmo")
ftSFAmo.Text = EF("SFAmo")
ftWaiter.Text = NullValue(EF("Waiter"))
ftBXF.Text = NullValue(EF("BXF"))
ftDiscount.Text = EF("Discount") & "%"
End If
EF.Close
Set EF = Nothing
DB.Close
Set DB = Nothing
Me.MousePointer = 0
Exit Sub
Err_init:
Me.MousePointer = 0
MsgBox "给出餐桌内容错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub InsertToCust(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)
On Error Resume Next
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)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -