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