📄 frmbase.frm
字号:
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 2175
Left = 390
TabIndex = 24
Top = 2340
Width = 4650
Begin VB.CommandButton cmdDeletePayment
Caption = "删除"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 3390
TabIndex = 7
Top = 390
Width = 975
End
Begin VB.CommandButton cmdAddPayment
Caption = "添加"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 2430
TabIndex = 5
Top = 390
Width = 975
End
Begin VB.ListBox lstPayment
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1230
Left = 1185
TabIndex = 6
Top = 750
Width = 3165
End
Begin 给出焦点文本框.FocusText ftPayment
Height = 300
Left = 1185
TabIndex = 4
Top = 405
Width = 1185
_ExtentX = 2090
_ExtentY = 529
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BorderStyle = 0
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
Height = 195
Left = 105
TabIndex = 25
Top = 450
Width = 1080
End
End
Begin VB.Frame Frame1
Caption = "单位分类配置"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000000&
Height = 2175
Left = 390
TabIndex = 22
Top = 270
Width = 4650
Begin VB.CommandButton cmdDelUnit
Caption = "删除"
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 3390
TabIndex = 3
Top = 390
Width = 975
End
Begin VB.ListBox lstUnitType
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1230
Left = 1200
TabIndex = 2
Top = 765
Width = 3165
End
Begin VB.CommandButton cmdAddUnit
Caption = "添加"
BeginProperty Font
Name = "宋体"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 330
Left = 2430
TabIndex = 1
Top = 390
Width = 975
End
Begin 给出焦点文本框.FocusText ftUnitType
Height = 300
Left = 1215
TabIndex = 0
Top = 405
Width = 1155
_ExtentX = 2037
_ExtentY = 529
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
BorderStyle = 0
End
Begin VB.Label Label1
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
Height = 195
Left = 120
TabIndex = 23
Top = 450
Width = 1080
End
End
End
Attribute VB_Name = "frmBase"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmbDiscount_KeyDown(KeyCode As Integer, Shift As Integer)
On Error Resume Next
If KeyCode = 13 Then
If cmdAddMenu.Enabled = True Then cmdAddMenu.Value = True
End If
End Sub
Private Sub cmdAddMenu_Click()
If Trim(ftMenu.Text) = "" Then
MsgBox "请输入菜单分类名后,再添加。 " & vbCrLf _
& "如：加家菜、红绕类、海鲜类、特色类 ... ", vbExclamation
ftMenu.SetFocus
Exit Sub
End If
If AddMenuType(Trim(ftMenu.Text), "Select * from MenuType Where Class='" & Trim(ftMenu.Text) & "'", cmbDiscount.ListIndex) = True Then
'添加到列表中
If cmbDiscount.Text = "禁止打折" Then
lstMenu.AddItem Trim(ftMenu.Text) & Space(4) & "禁止打折"
Else
lstMenu.AddItem Trim(ftMenu.Text) & Space(4) & "允许打折"
End If
End If
If lstMenu.ListCount = 0 Then
cmdDelMenu.Enabled = False
Else
cmdDelMenu.Enabled = True
End If
ftMenu.Text = ""
ftMenu.SetFocus
End Sub
Private Sub cmdAddPayment_Click()
If Trim(ftPayment.Text) = "" Then
MsgBox "请输入付款方法后,再添加。 " & vbCrLf _
& "如：现金、建设银行、招商银行 ... ", vbExclamation
ftPayment.SetFocus
Exit Sub
End If
If AddType(Trim(ftPayment.Text), "Select * from PayType Where Class='" & Trim(ftPayment.Text) & "'") = True Then
'添加到列表中
lstPayment.AddItem Trim(ftPayment.Text)
End If
If lstPayment.ListCount = 0 Then
cmdDeletePayment.Enabled = False
Else
cmdDeletePayment.Enabled = True
End If
ftPayment.Text = ""
ftPayment.SetFocus
End Sub
Private Sub cmdAddSite_Click()
If Trim(ftSite.Text) = "" Then
MsgBox "请输入座位编号与包厢费,再添加。 " & vbCrLf _
& "如：现金、紫苑阁、鸳鸯厅 ... ", vbExclamation
ftSite.SetFocus
Exit Sub
End If
If AddSiteType(Trim(ftSite.Text), ftPrice.Text, ftSupperPrice.Text, ftNightPrice.Text, "Select * from SiteType Where Class='" & Trim(ftSite.Text) & "'") = True Then
'添加到列表中
lstSite.AddItem Trim(ftSite.Text) & Space(4) & ftPrice.Text & Space(4) & ftSupperPrice.Text & Space(4) & ftNightPrice.Text
End If
If lstSite.ListCount = 0 Then
cmdDelSite.Enabled = False
Else
cmdDelSite.Enabled = True
End If
ftSite.Text = ""
ftPrice.Text = "0"
ftSupperPrice.Text = "0"
ftNightPrice.Text = "0"
ftSite.SetFocus
End Sub
Private Sub cmdAddUnit_Click()
If Trim(ftUnitType.Text) = "" Then
MsgBox "请输入单位名称后,再添加。 " & vbCrLf _
& "如：碟、盘、斤、条、瓶、杯 ... ", vbExclamation
ftUnitType.SetFocus
Exit Sub
End If
If AddType(Trim(ftUnitType.Text), "Select * from UnitType Where Class='" & Trim(ftUnitType.Text) & "'") = True Then
'添加到列表中
lstUnitType.AddItem Trim(ftUnitType.Text)
End If
If lstUnitType.ListCount = 0 Then
cmdDelUnit.Enabled = False
Else
cmdDelUnit.Enabled = True
End If
ftUnitType.Text = ""
ftUnitType.SetFocus
End Sub
Private Sub cmdDeletePayment_Click()
On Error Resume Next
If lstPayment.ListCount = 0 Then Exit Sub
If lstPayment.Text = "" Then
MsgBox "请选择需要类型,再删除。 ", vbInformation
lstPayment.ListIndex = 0
lstPayment.SetFocus
Exit Sub
End If
If MsgBox("真的要删除〖" & lstPayment.Text & "〗类型吗？(Y/N) ", vbYesNo + vbInformation) = vbNo Then Exit Sub
If DeleteType(lstPayment.Text, "Paytype") = True Then
lstPayment.RemoveItem lstPayment.ListIndex
End If
If lstPayment.ListCount = 0 Then
cmdDeletePayment.Enabled = False
Else
cmdDeletePayment.Enabled = True
End If
ftPayment.SetFocus
End Sub
Private Sub cmdDelMenu_Click()
On Error GoTo DelErr
If cmdDelMenu.Caption = "取消" Then
'保存按钮无效,删除按钮变为取消，修改变为保存(&S)
cmdDelMenu.Caption = "删除"
cmdModifyMenu.Caption = "修改"
cmdAddMenu.Enabled = True
ftMenu.Text = ""
lstMenu.Enabled = True
ftMenu.SetFocus
Exit Sub
End If
If lstMenu.ListCount = 0 Then Exit Sub
If lstMenu.Text = "" Then
MsgBox "请选择需要类型,再删除。 ", vbInformation
lstMenu.ListIndex = 0
lstMenu.SetFocus
Exit Sub
End If
Dim sTmpMenu As String
sTmpMenu = Left(lstMenu.Text, InStr(1, lstMenu.Text, Space(4), vbTextCompare) - 1)
If MsgBox("真的要删除〖" & sTmpMenu & "〗类型吗？(Y/N) ", vbYesNo + vbInformation) = vbNo Then Exit Sub
If DeleteType(sTmpMenu, "Menutype") = True Then
lstMenu.RemoveItem lstMenu.ListIndex
End If
If lstMenu.ListCount = 0 Then
cmdDelMenu.Enabled = False
Else
cmdDelMenu.Enabled = True
End If
ftMenu.SetFocus
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -