📄 frmeatlist.frm
字号:
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 195
Index = 2
Left = 7050
TabIndex = 22
Top = 885
Width = 1200
End
Begin VB.Label Label6
AutoSize = -1 'True
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 = 5760
TabIndex = 21
Top = 885
Width = 1200
End
Begin VB.Label Label6
AutoSize = -1 'True
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 = 4500
TabIndex = 20
Top = 885
Width = 1200
End
Begin VB.Label Label5
AutoSize = -1 'True
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 = 3510
TabIndex = 19
Top = 885
Width = 810
End
Begin VB.Label Label3
AutoSize = -1 'True
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 = 2535
TabIndex = 18
Top = 885
Width = 810
End
Begin VB.Label Label2
AutoSize = -1 'True
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 = 1230
TabIndex = 17
Top = 885
Width = 1200
End
Begin VB.Line Line1
BorderColor = &H00FFFFFF&
X1 = 135
X2 = 9840
Y1 = 720
Y2 = 720
End
Begin VB.Label lbStatus
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "添加新菜"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00808080&
Height = 240
Index = 1
Left = 195
TabIndex = 16
Top = 1140
Width = 960
End
Begin VB.Label lbStatus
AutoSize = -1 'True
BackColor = &H00E0E0E0&
BackStyle = 0 'Transparent
Caption = "添加新菜"
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 240
Index = 0
Left = 210
TabIndex = 15
Top = 1155
Width = 960
End
End
Begin VB.Frame Frame2
Height = 2505
Left = 135
TabIndex = 14
Top = 2160
Width = 8310
Begin MSComctlLib.ListView lstPro
Height = 1815
Left = 30
TabIndex = 7
ToolTipText = "选择菜单后,进行删除或修改操作。"
Top = 135
Width = 10365
_ExtentX = 18283
_ExtentY = 3201
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 = 6
BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Text = "助记编码"
Object.Width = 2469
EndProperty
BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 1
Text = "菜 名"
Object.Width = 2822
EndProperty
BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 2
Text = "拼音码"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 1
SubItemIndex = 3
Text = "单价"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(5) {BDD1F052-858B-11D1-B16A-00C0F0283628}
Alignment = 2
SubItemIndex = 4
Text = "单位"
Object.Width = 1764
EndProperty
BeginProperty ColumnHeader(6) {BDD1F052-858B-11D1-B16A-00C0F0283628}
SubItemIndex = 5
Text = "菜的类别"
Object.Width = 2822
EndProperty
End
End
End
Attribute VB_Name = "frmEatList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim Old_Code As String
Dim sGlobalType As String
Private Sub cmbType_Click()
AddValid
End Sub
Private Sub cmdAdd_Click()
On Error GoTo Err_Add
Dim mDB As Connection
Dim mRS As Recordset
Set mDB = CreateObject("ADODB.connection")
Set mRS = CreateObject("ADODB.Recordset")
mDB.Open Constr
If cmdAdd.Caption = "保存" Then
'查询Code,为修改的保存
If Trim(txtCode) <> Old_Code Then '与原来相符时不查
If GetCode(Trim(txtCode.Text), "MID", "EatList") = False Then
mDB.Close
Set mDB = Nothing
MsgBox "对不起，该物品的编码已经存在，请修改后再添加。", vbOKOnly + vbInformation, "代码重复"
txtCode = ""
txtCode.SetFocus
Exit Sub
End If
End If
Set mRS = CreateObject("ADODB.Recordset")
mRS.Open "Select * From EatList Where MID='" & Old_Code & "'", mDB, adOpenStatic, adLockOptimistic, adCmdText
If mRS.EOF And mRS.BOF Then
'记录不存在时,可能已经被其它操作员删除
mRS.Close: mDB.Close
Set mRS = Nothing
Set mDB = Nothing
MsgBox "原始记录不存在,可能已经被其它操作员删除？ " & vbCrLf _
& "请刷后再看看 ......", vbExclamation
Exit Sub
Else
'修改记录
mRS("MID") = Trim(txtCode.Text)
mRS("MName") = Trim(txtPM.Text)
mRS("PingYin") = Trim(txtPingYin.Text)
mRS("MPrice") = txtDJ.Text
mRS("MUnit") = Trim(txtDW.Text)
mRS("MType") = Trim(cmbType.Text)
mRS.Update
End If
'修改相关菜单编号,1为酒宴
Dim stmpSQL As String
stmpSQL = "Update tbdMenuCatDetail Set MenuName='" & Trim(txtCode.Text) & "' Where MenuName='" & Old_Code & "'"
mDB.Execute stmpSQL
'2/消费单
stmpSQL = "Update Cust Set CID='" & Trim(txtCode.Text) & "' Where CID='" & Old_Code & "'"
mDB.Execute stmpSQL
'3/临时消费单
stmpSQL = "Update tmpCust Set CID='" & Trim(txtCode.Text) & "' Where CID='" & Old_Code & "'"
mDB.Execute stmpSQL
lstPro.Enabled = True
Strip1.Enabled = True
cmdAdd.Caption = "添加输入的新菜(&A)"
cmdModify.Caption = "修改选定的菜单(&M)"
If lstPro.SelectedItem.Text <> "" Then cmdDel.Enabled = True
lstPro.SelectedItem.Text = Trim(txtCode)
lstPro.SelectedItem.SubItems(1) = Trim(txtPM.Text)
lstPro.SelectedItem.SubItems(2) = Trim(txtPingYin.Text)
lstPro.SelectedItem.SubItems(3) = Trim(txtDJ.Text)
lstPro.SelectedItem.SubItems(4) = Trim(txtDW.Text)
lstPro.SelectedItem.SubItems(5) = Trim(cmbType.Text)
txtCode = "": txtPM = "": txtPingYin = "": txtDJ = "0"
txtPM.SetFocus
'保存代码--------------------------------
mDB.Close
Set mDB = Nothing
Exit Sub
End If
'查询Code
If GetCode(Trim(txtCode.Text), "MID", "EatList") = False Then
mDB.Close
Set mDB = Nothing
MsgBox "对不起，该物品的代码已经存在，请修改后再添加。", vbOKOnly + vbInformation, "编号重复"
txtCode.Text = ""
txtCode.SetFocus
Exit Sub
End If
Set mRS = CreateObject("ADODB.Recordset")
mRS.Open "Select * From EatList", mDB, adOpenStatic, adLockOptimistic, adCmdText
'添加记录
mRS.AddNew
mRS("MID") = Trim(txtCode.Text)
mRS("MName") = Trim(txtPM.Text)
mRS("PingYin") = Trim(txtPingYin.Text)
mRS("MPrice") = txtDJ.Text
mRS("MUnit") = Trim(txtDW.Text)
mRS("MType") = Trim(cmbType.Text)
mRS.Update
mRS.Close
Set mRS = Nothing
mDB.Close
Set mDB = Nothing
If sGlobalType = Trim(cmbType.Text) Or sGlobalType = "" Then
'刷新
InsertToMenu lstPro, Trim(txtCode), Trim(txtPM.Text), Trim(txtPingYin.Text), Trim(txtDJ.Text), _
Trim(txtDW.Text), Trim(cmbType.Text)
Else
'返回所有物品
Dim xJ As Integer
For xJ = 1 To Strip1.Tabs.Count
If Strip1.Tabs.Item(xJ).Key = Trim(cmbType.Text) Then
Strip1.Tabs.Item(xJ).Selected = True
Exit For
End If
Next
'刷新
InsertToMenu lstPro, Trim(txtCode), Trim(txtPM.Text), Trim(txtPingYin.Text), Trim(txtDJ.Text), _
Trim(txtDW.Text), Trim(cmbType.Text)
End If
'恢复
txtPM = "": txtDJ = "0": txtCode = "": txtPingYin = ""
txtPM.SetFocus
Exit Sub
Err_Add:
MsgBox "添加记录错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
Private Sub cmdClose_Click()
Unload Me
End Sub
Private Sub AddValid()
If Trim(txtPM.Text) <> "" And Trim(txtDJ.Text) <> "" And Trim(txtCode) <> "" _
And cmbType.Text <> "" And txtDW.Text <> "" Then
cmdAdd.Enabled = True
Else
cmdAdd.Enabled = False
End If
End Sub
Private Sub cmdDel_Click()
On Error GoTo Err_del
If lstPro.ListItems.Count = 0 Then
MsgBox "没有菜单,操作取消。 ", vbExclamation
Exit Sub
End If
If lstPro.SelectedItem.Text = "" Then
MsgBox "没有选定删除的菜单,不能进行删除操作。 ", vbExclamation
Exit Sub
End If
' 删除
If MsgBox("真的删除 [ " & lstPro.SelectedItem.SubItems(1) & " ] 吗？ " & vbCrLf _
& "该菜关联的库存及其它内容一同删除。", vbYesNo + vbCritical) = vbNo Then
'"该菜关联的库存及其它内容将一些删除。 "
Exit Sub
End If
If DeleteEatList(lstPro.SelectedItem.Text) = True Then
lstPro.ListItems.Remove lstPro.SelectedItem.Index
lstPro.SetFocus
End If
Exit Sub
Err_del:
MsgBox "记录删除错误! " & vbCrLf & vbCrLf & Err.Description, vbCritical
End Sub
'删除
Private Function DeleteEatList(sName As String) As Boolean
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -