frmmainmain.frm

星级酒店管理系统（附带系统自写控件源码）

      End
      Begin VB.Menu mnuCheckOut 
         Caption         =   "结帐后退单(&B) ..."
         Shortcut        =   {F4}
      End
   End
   Begin VB.Menu mnuReport 
      Caption         =   "报表管理(&R)"
      Begin VB.Menu mnuWastebook 
         Caption         =   "现金流水帐(&Wastebook)"
      End
      Begin VB.Menu fffgfgf 
         Caption         =   "-"
      End
      Begin VB.Menu mnuSiteCount 
         Caption         =   "按座位统计(&S) ..."
         Shortcut        =   {F6}
      End
      Begin VB.Menu mnuName 
         Caption         =   "按菜名统计(&N) ..."
         Shortcut        =   {F11}
      End
      Begin VB.Menu Line011 
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuHZ 
         Caption         =   "营业汇总表(&H)"
         Enabled         =   0   'False
         Shortcut        =   {F12}
         Visible         =   0   'False
      End
      Begin VB.Menu mnuQueryCustomer 
         Caption         =   "营业明细表(&C) ..."
         Enabled         =   0   'False
         Visible         =   0   'False
      End
      Begin VB.Menu LIne0302 
         Caption         =   "-"
         Visible         =   0   'False
      End
      Begin VB.Menu mnuSort 
         Caption         =   "畅销物品排名(&M) ..."
         Visible         =   0   'False
      End
   End
   Begin VB.Menu mnuControl 
      Caption         =   "系统控制(&C)"
      Begin VB.Menu mnuHelp 
         Caption         =   "帮助主题(&H)"
         Shortcut        =   {F1}
      End
      Begin VB.Menu miiii 
         Caption         =   "-"
      End
      Begin VB.Menu mnuAbout 
         Caption         =   "关于(&A)..."
      End
      Begin VB.Menu Line03 
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit 
         Caption         =   "退出(&X)..."
         Shortcut        =   ^X
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit

Dim fIni As RegClass
Dim infoLeft As Long    '信息条的左边

Private Sub MDIForm_Load()

   On Error GoTo StartErr
   
   frmLogin.Show 1
   
   lbInfo.Caption = sInfo
   infoLeft = 5160 - lbInfo.Width
   lbInfo.Left = infoLeft
  '网址联系信息
   Label1(0).Caption = sWeb
  '技术支持信息
   lbContact.Caption = sContact
   
  '检测是否是否正确
   Dim stmpDate As String
       dtpTest.Value = Date
       stmpDate = dtpTest.Value
   If Len(stmpDate) < 10 Then
      MsgBox "您的日期格式为【02-01-30】格式,将不能正常工作,按以下步骤修改。" & vbCrLf & vbCrLf _
              & "打开我的电脑->控制面板->区域设置->日期->【短日期样式为:YYYY-MM-DD】", vbExclamation
   End If
   
  '缺省时间段为0
   curDatePart = 0
  '给出是否为共享版
   'IsShare = GetShare()
   IsShare = False
   
   
   
  '改变标题
   Me.Caption = sInfo
   On Error Resume Next
   Me.Picture = LoadPicture(App.Path & "\backgroud.jpg")
   
   Exit Sub
StartErr:
   MsgBox "餐饮收银系统启动错误:" & Err.Description, vbCritical
   IsShare = True
   
End Sub

'检查是否有过期的预订内容
Private Sub CheckRun()
   
  On Error GoTo CheckErr
  
  AtCheckRun = True               '..................正在检测.........
  
  Dim tmplHour, tmpDatePart As Integer
      tmplHour = Hour(Time)
   If tmplHour >= Lunch1 And tmplHour < Lunch2 Then   '中午
      tmpDatePart = 1
     ElseIf tmplHour >= Supper1 And tmplHour < Supper2 Then   '下午
      tmpDatePart = 2
     ElseIf tmplHour >= Night1 And tmplHour < NIght2 Then     '晚上
      tmpDatePart = 3
     Else
      tmpDatePart = 1
   End If
               
   If tmpDatePart <> curDatePart Then
     '检测预订内容
      curDatePart = tmpDatePart
     '1、删除时间段小于CurDatePart内容
      Dim bDB As Connection
      Dim sTMp As String
      Set bDB = CreateObject("ADODB.Connection")
          bDB.Open Constr
          If IsSqlDat = True Then
             sTMp = "Delete from tbdBook Where (ExpireDate='" & Date & "' And DatePart<" & curDatePart & ") Or (ExpireDate<'" & Date & "')"
            Else
             sTMp = "Delete from tbdBook Where (ExpireDate=#" & Date & "# And DatePart<" & curDatePart & ") Or (ExpireDate<#" & Date & "#)"
          End If
          bDB.Execute sTMp
     '2、自动修改座位状态参数
         sTMp = "Update SiteType Set SiteStatus=0 Where SiteStatus=1"
         bDB.Execute sTMp
     '3、显示新的预订状态
          If IsSqlDat = True Then
             sTMp = "Update SiteType Set SiteStatus=1 Where Class In (Select Class From tbdBook Where ExpireDate='" & Date & "' And DatePart=" & tmpDatePart & ") And SiteStatus<2"
           Else
             sTMp = "Update SiteType Set SiteStatus=1 Where Class In (Select Class From tbdBook Where ExpireDate=#" & Date & "# And DatePart=" & tmpDatePart & ") And SiteStatus<2"
          End If
          bDB.Execute sTMp
          bDB.Close
          Set bDB = Nothing
   End If
   AtCheckRun = False
  '如果预订窗口显示时，更新
   If BrowserBookFocus = True Then
      '刷新所有预订内容
       frmBrowserBook.cmdFindAll.Value = True
   End If
  '如果餐桌状态显示时，更新
   If SitesFocus = True Then
      frmSites.Browse   '浏览餐桌
      Call frmSites.Form_Resize
   End If
   Exit Sub
CheckErr:
   AtCheckRun = False
   curDatePart = 0
   MsgBox "自动检测预订内容错误:" & Err.Description, vbCritical
   Exit Sub
End Sub

Private Sub MDIForm_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)

  If Button = 2 Then
     PopupMenu mnuBook
  End If
  
End Sub

Private Sub MDIForm_Resize()
  
  On Error Resume Next
  
  If Me.WindowState = 1 Then Exit Sub
     VerticalMenu1.Left = 25
     VerticalMenu1.Top = 10
    
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)

   On Error Resume Next
  '关闭所有窗口
   Unload frmLogin
   
End Sub

Private Sub mnuAbout_Click()

   On Error GoTo AboutErr
   
   frmAbout.Show 1
   
   Exit Sub
AboutErr:
    MsgBox "显示关于错误：" & Err.Description, vbCritical
    
End Sub


Private Sub mnuArrearage_Click()
   
   If mnuArrearage.Enabled = False Then
     MsgBox "很抱歉，禁止访问！  ", vbInformation
     Exit Sub
  End If
   If ArrearageFocus = True Then
       frmArrearage.SetFocus
     Else
       frmArrearage.Show
   End If
   
End Sub

Private Sub mnuBackup_Click()

  If mnuBackup.Enabled = False Then
     MsgBox "很抱歉，禁止访问！  ", vbInformation
     Exit Sub
  End If
    frmBackup.Show 1
  
End Sub

Private Sub mnuBase_Click()

  If mnuBase.Enabled = False Then
     MsgBox "很抱歉，禁止访问！  ", vbInformation
     Exit Sub
  End If
  
  If BaseFocus = True Then
     frmBase.SetFocus
    Else
     frmBase.Show
  End If
  
End Sub

Private Sub mnuBox_Click()

  '允许包厢点菜时
   frmBoxType.Show 1
  
End Sub

Private Sub mnuCheckOut_Click()

  If mnuCheckOut.Enabled = False Then
     MsgBox "很抱歉，禁止访问！  ", vbInformation
     Exit Sub
  End If
 '退帐：将已经结帐的单返回到临时单中，然后修改结帐
 '首先检查该座位没有被使用
  'If MsgBox("退单有两种：一、还原消费单,二、直接修改消费单。 " & vbCrLf _
  '   & "如果为还原消费单,请按【是】,修改消费单按【否】？ ", vbYesNo + vbInformation + vbDefaultButton2) = vbNo Then
  '   frmBackIt.Show
  '  Else
  frmBack.Show 1
 ' End If
 
End Sub

Private Sub mnuDetail_Click()

 'frmDetail.Show
 
End Sub

Private Sub mnuEnterStore_Click()

   'frmCustomer.Show
  
End Sub


Private Sub mnuControl_Click()

  'mnuAbout.Enabled = IsShare
  
End Sub

Private Sub mnuEmploy_Click()

  If mnuEmploy.Enabled = False Then
     MsgBox "很抱歉，禁止访问！  ", vbInformation
     Exit Sub
  End If
  If EmployFocus = True Then
     frmEmploy.SetFocus
    Else
     frmEmploy.Show
  End If
  
End Sub

Private Sub MnuExit_Click()

  Unload Me
  
End Sub

Private Sub mnuHelp_Click()

   On Error Resume Next
   Dim retVal As Long
       retVal = ShellExecute(Me.Hwnd, "Open", App.Path & "\help\index.htm", 0, 0, 1)
  
End Sub

Private Sub mnuFindBook_Click()
   
  If mnuFindBook.Enabled = False Then
     MsgBox "很抱歉，禁止访问！  ", vbInformation
     Exit Sub
  End If
  
  If BrowserBookFocus = True Then
     frmBrowserBook.SetFocus
    Else
     frmBrowserBook.Show
  End If
  
End Sub

Private Sub mnuIntegration_Click()

  If mnuIntegration.Enabled = False Then
     MsgBox "很抱歉，禁止访问！  ", vbInformation
     Exit Sub
  End If
  If IntegrationFocus = True Then
     frmIntegration.SetFocus
    Else
     frmIntegration.Show
  End If
 
End Sub

Private Sub mnuLevel_Click()

  If mnuLevel.Enabled = False Then
     MsgBox "很抱歉，禁止访问！  ", vbInformation
     Exit Sub
  End If
  frmMemberLevel.Show 1
  
End Sub

Private Sub mnuMember_Click()

  If mnuMember.Enabled = False Then
     MsgBox "很抱歉，禁止访问！  ", vbInformation
     Exit Sub
  End If
 '会员管理
  If MemberFocus = True Then
     frmMember.SetFocus
    Else
     frmMember.Show
  End If
 
End Sub

Private Sub mnuMenuManager_Click()

  If mnuMenuManager.Enabled = False Then
     MsgBox "很抱歉，禁止访问！  ", vbInformation
     Exit Sub
  End If
  If MenuFocus = True Then
     frmEatList.SetFocus
   Else
     frmEatList.Show
  End If
  
End Sub

Private Sub mnuName_Click()

  If mnuName.Enabled = False Then
     MsgBox "很抱歉，禁止访问！  ", vbInformation
     Exit Sub
  End If
  If HZNameFocus = True Then
     frmHZName.SetFocus
    Else
     frmHZName.Show
  End If
  
End Sub

Public Sub mnuNewBook_Click()

  If mnuNewBook.Enabled = False Then
     MsgBox "很抱歉，禁止访问！  ", vbInformation
     Exit Sub
  End If
  
  If NewBookFocus = False Then
     frmNewBook.Show
     frmNewBook.ftClass = sPubSite
   Else