?? frmbase.frm

?? 星級酒店管理系統（附帶系統自寫控件源碼）
?? FRM
?? 第 1 頁 / 共 5 頁
字號:
上一頁 1 2 3 45
GetERR:
   AddSiteType = False
   MsgBox "添加錯誤:" & Err.Description, vbCritical
   
End Function

'給出包廂列表
Private Sub GetSiteTypeList(sTable As String, tmpList As ListBox)
  
   On Error GoTo GetERR
   
   tmpList.Clear
   
   Dim lLen As Integer
          
   Dim utDB As Connection
   Dim utRS As Recordset
   Set utDB = CreateObject("ADODB.Connection")
   Set utRS = CreateObject("ADODB.Recordset")
       utDB.Open Constr
       utRS.Open sTable, utDB, adOpenStatic, adLockReadOnly, adCmdTable
       If Not (utRS.EOF And utRS.BOF) Then
          Do While Not utRS.EOF
             tmpList.AddItem utRS("Class") & Space(4) & utRS("Price") & Space(4) & utRS("supperPrice") & Space(4) & utRS("nightPrice")
             utRS.MoveNext
          Loop
          If tmpList.ListCount > 0 Then
             tmpList.ListIndex = 0
          End If
       End If
       utRS.Close
       utDB.Close
       Set utRS = Nothing
       Set utDB = Nothing
   
   Exit Sub
GetERR:
   MsgBox "給出錯誤:" & Err.Description, vbCritical
   
End Sub

Private Sub cmdModifyMenu_Click()

 On Error GoTo ModifyERR
 
 If lstMenu.ListCount <= 0 Then
    MsgBox "沒有項目可以修改？   ", vbExclamation
    Exit Sub
 End If
 
 If lstMenu.Text = "" Then
    MsgBox "請選擇項目后,再按【修改】按鈕。  ", vbExclamation
    Exit Sub
 End If
 
 Dim sTMp As String

 If cmdModifyMenu.Caption = "修改" Then
    '保存按鈕無效,刪除按鈕變為取消，修改變為保存(&S)
     cmdDelMenu.Caption = "取消"
     cmdModifyMenu.Caption = "保存"
     cmdAddMenu.Enabled = False
     '1首先給出其名稱
      sTMp = Left(lstMenu.Text, InStr(1, lstMenu.Text, Space(4), vbTextCompare) - 1)
      ftMenu.Text = sTMp
      If Trim(Right(lstMenu.Text, 4)) = "禁止打折" Then
         cmbDiscount.ListIndex = 0
        Else
         cmbDiscount.ListIndex = 1
      End If
      lstMenu.Enabled = False
      ftMenu.SetFocus
   Else
    '保存時
    '1修改數據庫中項目,給出原始名稱
      lstMenu.Enabled = True
      sTMp = lstMenu.Text
      sTMp = Left(lstMenu.Text, InStr(1, lstMenu.Text, Space(4), vbTextCompare) - 1)
      If EditMenuType(Trim(ftMenu.Text), sTMp, "Select * from MenuType Where Class='" & sTMp & "'", cmbDiscount.ListIndex) = True Then
          '2更新列表中內容
            GetTypeBaseList "MenuType", lstMenu
      End If
     '恢復數據
      cmdDelMenu.Caption = "刪除"
      cmdModifyMenu.Caption = "修改"
      cmdAddMenu.Enabled = True
      lstMenu.Enabled = True
      ftMenu.Text = ""
      ftMenu.SetFocus
 End If
 
 Exit Sub
ModifyERR:
 MsgBox "修改數據錯誤:" & Err.Description, vbCritical
 Exit Sub
 
End Sub


Private Sub cmdModifySite_Click()
 
 On Error GoTo ModifyERR
 
 Dim sTMp As String
 Dim xTmp As Integer
 
 If lstSite.ListCount <= 0 Then
    MsgBox "沒有項目可以修改？   ", vbExclamation
    Exit Sub
 End If
 
 If lstSite.Text = "" Then
    MsgBox "請選擇項目后,再按【修改】按鈕。  ", vbExclamation
    Exit Sub
 End If
 
 If cmdModifySite.Caption = "修改" Then
    '保存按鈕無效,刪除按鈕變為取消，修改變為保存(&S)
     cmdDelSite.Caption = "取消"
     cmdModifySite.Caption = "保存"
     cmdAddSite.Enabled = False
    '1首先給出其名稱
     sTMp = lstSite.Text
     Dim tmpListSite() As String
         tmpListSite = Split(sTMp, Space(4))
      ftSite.Text = tmpListSite(0)                     '座位名稱
      ftPrice.Text = tmpListSite(1)                    '中午包廂費
      ftSupperPrice.Text = tmpListSite(2)              '下午包廂費
      ftNightPrice.Text = tmpListSite(3)               '晚上包廂費
      lstSite.Enabled = False
      ftSite.SetFocus
   Else
    '保存時
    '1修改數據庫中項目,給出原始名稱
      lstSite.Enabled = True
      sTMp = lstSite.Text
      tmpListSite = Split(sTMp, Space(4))
      sTMp = tmpListSite(0)                    '座位名稱
      If EditSiteType(Trim(ftSite.Text), sTMp, "Select * from SiteType Where Class='" & sTMp & "'", CCur(ftPrice.Text), CCur(ftSupperPrice.Text), CCur(ftNightPrice.Text)) = True Then
        '2更新列表中內容
         GetSiteTypeList "SiteType", lstSite
      End If
     '恢復數據
      cmdDelSite.Caption = "刪除"
      cmdModifySite.Caption = "修改"
      cmdAddSite.Enabled = True
     '1首先給出其名稱
      ftSite.Text = ""
      lstSite.Enabled = True
      ftPrice.Text = "0"
      ftSupperPrice.Text = "0"
      ftNightPrice.Text = "0"
      ftSite.SetFocus
      Exit Sub
 End If
 
 Exit Sub
ModifyERR:
 MsgBox "修改數據錯誤:" & Err.Description, vbCritical
 Exit Sub
End Sub

Private Sub Form_Load()

  GetFormSet Me, frmMain
  BaseFocus = True
  
  On Error Resume Next
    
  Screen.MousePointer = 11
  
  frmMain.lbControl.Caption = "基本項目配置"
  cmbDiscount.ListIndex = 0
  
 '給出單位配置列表 ++++++++++++++++++++++++++++++++++++
  GetTypeList "UnitType", lstUnitType
   If lstUnitType.ListCount = 0 Then
     cmdDelUnit.Enabled = False
    Else
     cmdDelUnit.Enabled = True
  End If
 '給出付款類型列表+++++++++++++++++++++++++++++++++++++++++
  GetTypeList "PayType", lstPayment
   If lstPayment.ListCount = 0 Then
     cmdDeletePayment.Enabled = False
    Else
     cmdDeletePayment.Enabled = True
  End If
 '給出菜類型列表+++++++++++++++++++++++++++++++++++++++++
  GetTypeBaseList "MenuType", lstMenu
    If lstMenu.ListCount = 0 Then
       cmdDelMenu.Enabled = False
     Else
       cmdDelMenu.Enabled = True
    End If
 '給出座位類型列表+++++++++++++++++++++++++++++++++++++++++
  GetSiteTypeList "SiteType", lstSite
   If lstSite.ListCount = 0 Then
     cmdDelSite.Enabled = False
    Else
     cmdDelSite.Enabled = True
  End If

  Screen.MousePointer = 0
  
End Sub

Private Sub GetTypeBaseList(sTable As String, tmpList As Object)
  
   On Error GoTo GetERR
   
   tmpList.Clear
   
   Dim utDB As Connection
   Dim utRS As Recordset
   Set utDB = CreateObject("ADODB.Connection")
   Set utRS = CreateObject("ADODB.Recordset")
       utDB.Open Constr
       utRS.Open sTable, utDB, adOpenStatic, adLockReadOnly, adCmdTable
       If Not (utRS.EOF And utRS.BOF) Then
          Do While Not utRS.EOF
             If utRS("Discount") = 0 Then
                tmpList.AddItem utRS("Class") & Space(4) & "禁止打折"
               Else
                tmpList.AddItem utRS("Class") & Space(4) & "允許打折"
             End If
             utRS.MoveNext
          Loop
       End If
       utRS.Close
       utDB.Close
       Set utRS = Nothing
       Set utDB = Nothing
       
   If tmpList.ListCount > 0 Then
      tmpList.ListIndex = 0
   End If
   
   Exit Sub
GetERR:
   MsgBox "給出錯誤:" & Err.Description, vbCritical
   
End Sub

Private Sub Form_Resize()

  On Error Resume Next
  
  If Me.WindowState = 1 Then Exit Sub
        
  '常規時
  If Me.WindowState = 0 Then
     Me.Move 1, 1, frmMain.Width - (frmMain.picTool.Width + 200), frmMain.Height - (frmMain.picADV.Height + 1150)
  End If
  
End Sub

Private Sub Form_Unload(Cancel As Integer)

  SaveFormSet Me
  frmMain.lbControl.Caption = "收銀控制中心"
  BaseFocus = False
  
End Sub



Private Sub ftNightPrice_Change()

  If ftNightPrice.Text = "" Then
     ftNightPrice.Text = "0"
     ftNightPrice.SelStart = 0
     ftNightPrice.SelLength = 1
     Exit Sub
  End If
  If ftNightPrice.Text = "." Then
     ftNightPrice.Text = "0."
     ftNightPrice.SelStart = 2
     ftNightPrice.SelLength = 0
     Exit Sub
  End If

End Sub

Private Sub ftPayment_KeyPress(KeyAscii As Integer)

  If KeyAscii = 13 And Trim(ftPayment.Text) <> "" Then
     Call cmdAddPayment_Click
  End If
  
End Sub

Private Sub ftPrice_Change()

  If ftPrice.Text = "" Then
     ftPrice.Text = "0"
     ftPrice.SelStart = 0
     ftPrice.SelLength = 1
     Exit Sub
  End If
  If ftPrice.Text = "." Then
     ftPrice.Text = "0."
     ftPrice.SelStart = 2
     ftPrice.SelLength = 0
     Exit Sub
  End If
  
End Sub



Private Sub ftPrice_KeyPress(KeyAscii As Integer)

  If KeyAscii = 13 And Trim(ftSite.Text) <> "" Then
     Call cmdAddSite_Click
  End If
  
End Sub

Private Sub ftPrice_LostFocus()

  If IsNumeric(ftPrice.Text) = False Then
     ftPrice.Text = "0"
  End If
  
End Sub

Private Sub ftSupperPrice_Change()

  If ftSupperPrice.Text = "" Then
     ftSupperPrice.Text = "0"
     ftSupperPrice.SelStart = 0
     ftSupperPrice.SelLength = 1
     Exit Sub
  End If
  If ftSupperPrice.Text = "." Then
     ftSupperPrice.Text = "0."
     ftSupperPrice.SelStart = 2
     ftSupperPrice.SelLength = 0
     Exit Sub
  End If

End Sub

Private Sub ftUnitType_KeyPress(KeyAscii As Integer)

  If KeyAscii = 13 And Trim(ftUnitType.Text) <> "" Then
     Call cmdAddUnit_Click
  End If
  
End Sub


Private Sub lstMenu_Click()
  
  If lstMenu.ListCount = 0 Then
     cmdDelMenu.Enabled = False
     cmdModifyMenu.Enabled = False
    Else
     If lstMenu.Text = "" Then Exit Sub
        cmdDelMenu.Enabled = True
        cmdModifyMenu.Enabled = True
  End If

End Sub

Private Sub lstMenu_DblClick()

  If lstMenu.ListCount > 0 Then
     If lstMenu.Text <> "" Then
        Call cmdModifyMenu_Click
     End If
  End If
  
End Sub


Private Sub lstPayment_Click()

  If lstPayment.ListCount = 0 Then
     cmdDeletePayment.Enabled = False
    Else
     If lstPayment.Text = "" Then Exit Sub
        cmdDeletePayment.Enabled = True
  End If

End Sub

Private Sub lstSite_Click()

  If lstSite.ListCount = 0 Then
     cmdDelSite.Enabled = False
     cmdModifySite.Enabled = False
    Else
     If lstSite.Text <> "" Then
        cmdModifySite.Enabled = True
        cmdDelSite.Enabled = True
      Else
        cmdDelSite.Enabled = False
上一頁 1 2 3 45
?? 文件大小 12233 K
?? 上傳用戶 norwaybaby
?? 所屬分類其他數據庫
??? 相關標簽

#管理系統 #控件 #源碼
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? frmbase.frm

?? 快捷鍵說明
