main.frm

酒店系统源码。为了学习和 研究软件内含的设计思想和原理

            Caption         =   "团会..."
         End
      End
      Begin VB.Menu mnuRZ_HF 
         Caption         =   "换    房"
         Begin VB.Menu mnuRZ_HF_SK 
            Caption         =   "散客..."
         End
         Begin VB.Menu mnuRZ_HF_TH 
            Caption         =   "团会..."
         End
      End
      Begin VB.Menu mnuRZ_LD 
         Caption         =   "团会成员提前离店"
      End
      Begin VB.Menu mnuRZ_2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuRZ_HT 
         Caption         =   "房态调整"
      End
      Begin VB.Menu mnuRZ_ZL 
         Caption         =   "客人资料输入"
      End
      Begin VB.Menu mnuRZ_3 
         Caption         =   "-"
      End
      Begin VB.Menu FZFJS_SK 
         Caption         =   "非住房散客登记"
      End
      Begin VB.Menu FZFJS_TH 
         Caption         =   "非住房团会登记"
      End
   End
   Begin VB.Menu mnuZW 
      Caption         =   "帐务处理(&W)"
      Begin VB.Menu mnuZW_BZJ 
         Caption         =   "收保证金"
      End
      Begin VB.Menu mnuZW_TBZJ 
         Caption         =   "退还保证金"
      End
      Begin VB.Menu mnuZW_1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuZW_FZGZ 
         Caption         =   "房租夜审过帐"
      End
      Begin VB.Menu mnuZW_ZD 
         Caption         =   "帐单输入"
         Shortcut        =   {F5}
      End
      Begin VB.Menu mnuZW_2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuZW_KRJZ 
         Caption         =   "结    帐"
         Shortcut        =   {F7}
      End
   End
   Begin VB.Menu mnuLIST 
      Caption         =   "打印报表(&T)"
      Begin VB.Menu mnuLIST_SRMX 
         Caption         =   "交接班日报表"
      End
      Begin VB.Menu mnuLIST_BZJ 
         Caption         =   "保证金明细表"
      End
      Begin VB.Menu mnuLIST_SKSQ 
         Caption         =   "散客赊欠一览表"
      End
      Begin VB.Menu mnuLIST_THSQ 
         Caption         =   "团会赊欠一览表"
      End
      Begin VB.Menu mnuLIST_1 
         Caption         =   "-"
      End
      Begin VB.Menu mnuLIST_LSJJB 
         Caption         =   "历史交接班报表"
      End
      Begin VB.Menu mnuLIST_YBB 
         Caption         =   "业务收入月报表"
      End
      Begin VB.Menu mnuLIST_2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuLIST_RCTJ 
         Caption         =   "人次统计表"
      End
   End
   Begin VB.Menu MNUCX 
      Caption         =   "查询(&U)"
      Begin VB.Menu MNUCX_ZZSK 
         Caption         =   "未结帐散客查询"
      End
      Begin VB.Menu MNUCX_ZZTH 
         Caption         =   "未结帐团会查询"
      End
      Begin VB.Menu MNUCX_1 
         Caption         =   "-"
      End
      Begin VB.Menu MNUCX_LSSK 
         Caption         =   "已结帐散客查询"
      End
      Begin VB.Menu MNUCX_LSTH 
         Caption         =   "已结帐团会查询"
      End
      Begin VB.Menu MNUCX_2 
         Caption         =   "-"
      End
      Begin VB.Menu MNUCX_SQ 
         Caption         =   "客人赊欠一览"
      End
   End
   Begin VB.Menu MNUSZ 
      Caption         =   "设置(&O)"
      Begin VB.Menu MNUSZ_MM 
         Caption         =   "更改口令"
      End
      Begin VB.Menu MNUSZ_CWFG 
         Caption         =   "财务分工"
      End
      Begin VB.Menu MNUSZ_1 
         Caption         =   "-"
      End
      Begin VB.Menu MNUSZ_FJ 
         Caption         =   "房间设置"
      End
      Begin VB.Menu MNUSZ_PYM 
         Caption         =   "加注拼音助记符"
         Shortcut        =   {F12}
      End
      Begin VB.Menu MNUSZ_2 
         Caption         =   "-"
      End
      Begin VB.Menu MNUSZ_SC 
         Caption         =   "清除历史数据"
         Enabled         =   0   'False
      End
      Begin VB.Menu mnuRepair 
         Caption         =   "修复优化数据库"
      End
      Begin VB.Menu MNUSZ_3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuViewToolbar 
         Caption         =   "工具栏(&T)"
         Checked         =   -1  'True
      End
      Begin VB.Menu mnuViewStatusBar 
         Caption         =   "状态栏(&B)"
         Checked         =   -1  'True
      End
   End
   Begin VB.Menu mnuHELP 
      Caption         =   "帮助(&H)"
      WindowList      =   -1  'True
      Begin VB.Menu mnuHELP_LR 
         Caption         =   "使用说明"
         Shortcut        =   {F1}
      End
      Begin VB.Menu mnuHELP_2 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHELP_GY 
         Caption         =   "关于本软件(&A)"
      End
      Begin VB.Menu mnuHELP_3 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHELP_JL 
         Caption         =   "日积月累(&D)"
      End
   End
End
Attribute VB_Name = "SMAIN"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim TIPSHOW As String
Option Explicit
Private m_cN As cNeoCaption
Private Sub Skin(f As Form, cN As cNeoCaption)
    cN.ActiveCaptionColor = &HFFFFFF
    cN.InActiveCaptionColor = &HC0C0C0
    cN.ActiveMenuColor = &H0&
    cN.ActiveMenuColorOver = &H0
    cN.InActiveMenuColor = &H0&
    cN.MenuBackgroundColor = RGB(207, 203, 207)
    cN.CaptionFont.Name = "宋体"
    cN.CaptionFont.Size = 9
    cN.MenuFont.Name = "宋体"
    cN.MenuFont.Size = 9
    cN.Attach f, f.PicCaption.Picture, f.PicBorder.Picture, 19, 20, 90, 140, 240, 400
    f.BackColor = RGB(207, 203, 207)
End Sub

Private Sub Form_Load()
    '防止重复启动
    Call CheckExist(Me)
   'COOL窗口设置
    Set m_cN = New cNeoCaption
    Skin Me, m_cN
    '设置窗口启动大小
'    Me.left = GetSetting(App.title, "Settings", "MainLeft", 100)
'    Me.top = GetSetting(App.title, "Settings", "MainTop", 100)
'    Me.Width = GetSetting(App.title, "Settings", "MainWidth", 11500)
'    Me.Height = GetSetting(App.title, "Settings", "MainHeight", 8500)
'    DATAEN.JDGL.ConnectionString = "Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=" & App.Path & "\DATA\jdgl.mdb"
    Me.Caption = "酒店总台管理系统 V2.0 通用版" & "─" & STRBGNAME & "专用"
    
End Sub

Private Sub Form_Unload(Cancel As Integer)
'    If Me.WindowState <> vbMinimized Then
'        SaveSetting App.title, "Settings", "MainLeft", Me.left
'        SaveSetting App.title, "Settings", "MainTop", Me.top
'        SaveSetting App.title, "Settings", "MainWidth", Me.Width
'        SaveSetting App.title, "Settings", "MainHeight", Me.Height
'    End If

End Sub

Private Sub FZFJS_SK_Click()
    Load FZFSK
    FZFSK.Show vbModal
    
End Sub

Private Sub FZFJS_TH_Click()
    Load FZFTH
    FZFTH.Show vbModal
End Sub

Private Sub MNUCX_LSSK_Click()
    Load SKLDCX
    SKLDCX.Show vbModal
End Sub

Private Sub MNUCX_LSTH_Click()
    Load THLDCX
    THLDCX.Show vbModal
End Sub

Private Sub MNUCX_SQ_Click()
    Load SQLY
    SQLY.Show vbModal
End Sub

Private Sub MNUCX_ZZSK_Click()
    Load SKCX
    SKCX.Show vbModal
    
End Sub

Private Sub MNUCX_ZZTH_Click()
    Load THCX
    THCX.Show vbModal
    
End Sub

Private Sub mnuFILE_CSH_Click()
    Dim DATJDGL As Database
    Dim RECWJBC As Recordset
    Dim SFOK As Integer
    SFOK = MsgBox("请慎用此功能..." + Chr(13) + "系统初始化将删除已存在的所有数据!" + Chr(13) + "请确认是否初始化?", vbQuestion + vbYesNo, "提示信息")
    If SFOK = vbYes Then
       Set DATJDGL = OpenDatabase(App.Path & "\DATA\JDGL.MDB")
       DATJDGL.Execute ("DELETE FROM 团会登记表")
       DATJDGL.Execute ("DELETE FROM 散客登记表")
       DATJDGL.Execute ("DELETE FROM 团会结帐")
       DATJDGL.Execute ("DELETE FROM 散客结帐")
       DATJDGL.Execute ("DELETE FROM 预订单")
       DATJDGL.Execute ("DELETE FROM 当前保证金")
       DATJDGL.Execute ("DELETE FROM 交班表")
       MsgBox "系统初始化完毕!", vbInformation, "提示信息"
       Set RECWJBC = DATJDGL.OpenRecordset("SELECT 交班表.班次, 交班表.交班 From 交班表 WHERE (((交班表.交班)=False))", dbOpenDynaset)
       RECWJBC.AddNew
       RECWJBC("班次") = 1
       RECWJBC.Update
       frmLogin.CZYBC = 1
       RECWJBC.Close
       DATJDGL.Close
       Set RECWJBC = Nothing
       Set DATJDGL = Nothing
    End If
    SMAIN.StatusBar1.Panels(1).Text = "操作员:" & frmLogin.CZYXM + "  总班次:" + CStr(frmLogin.CZYBC)

End Sub

Private Sub mnuFILE_EXIT_Click()
    Unload Me
End Sub

Private Sub mnuFILE_ZC_Click()
    Load frmLogin
    frmLogin.Show
    
End Sub

Private Sub mnuHELP_GY_Click()
    Load frmAbout
    frmAbout.Show vbModal
End Sub

Private Sub mnuHELP_JL_Click()
    SaveSetting App.EXEName, "Options", "在启动时显示提示", 1
    Load frmTip
    frmTip.Show vbModal

End Sub

Private Sub mnuFILE_BACKUP_Click()
    On Error GoTo BACKERROR

    Dim TJ As String
    Dim DATBACKUP As Database
    Dim RECBACKUP As Recordset
    
    ' 关闭数据库对象并且释放内存
    Dim ws As Workspace
    Dim db As Database
    Dim rs As Recordset

    For Each ws In Workspaces
        For Each db In ws.Databases
            For Each rs In db.Recordsets
                rs.Close
                Set rs = Nothing
            Next
            db.Close
            Set db = Nothing
        Next
        ws.Close
        Set ws = Nothing
    Next
    
    Set DATBACKUP = OpenDatabase(App.Path & "\BACKUP.MDB")
    Set RECBACKUP = DATBACKUP.OpenRecordset("BACKUP", dbOpenDynaset)
    
    RECBACKUP.FindFirst ("sf")
    If Not RECBACKUP.NoMatch Then RECBACKUP.Edit Else RECBACKUP.AddNew
    RECBACKUP("CS") = "'" + App.Path + "\data\jdgl.MDB" + "'"
    RECBACKUP("FILE") = "jdgl.MDB"
    RECBACKUP.Update
    DATBACKUP.Close
        
    Load BACKUP
    BACKUP.Show vbModal
    Exit Sub

BACKERROR:
    MsgBox CStr(Err.Number) & "-" & Err.Description, vbCritical, "错误"
    Exit Sub

End Sub
Private Sub mnuFILE_PRINT_Click()
    CommonDialog1.PrinterDefault = True
    CommonDialog1.ShowPrinter
End Sub

Private Sub mnuFILE_RESTORE_Click()
    On Error GoTo BACKERROR
    
    Dim DATJDGL As Database
    Dim RECWJBC As Recordset
    Dim RECMAXBC As Recordset

    Dim TJ As String
    Dim DATBACKUP As Database
    Dim RECBACKUP As Recordset
    
    ' 关闭数据库对象并且释放内存
    Dim ws As Workspace
    Dim db As Database
    Dim rs As Recordset

    For Each ws In Workspaces
        For Each db In ws.Databases
            For Each rs In db.Recordsets
                rs.Close
                Set rs = Nothing
            Next
            db.Close
            Set db = Nothing
        Next
        ws.Close
        Set ws = Nothing
    Next
    
    Set DATBACKUP = OpenDatabase(App.Path & "\BACKUP.MDB")
    Set RECBACKUP = DATBACKUP.OpenRecordset("BACKUP", dbOpenDynaset)
    TJ = "cs like " + """" + "'*" + """"
    RECBACKUP.FindFirst (TJ)
    If Not RECBACKUP.NoMatch Then RECBACKUP.Edit Else RECBACKUP.AddNew
    RECBACKUP("CS") = "'" + App.Path + "\data\jdgl.MDB" + "'"
    RECBACKUP("FILE") = "jdgl.MDB"
    RECBACKUP.Update
    DATBACKUP.Close
        
    Load RESTORE
    RESTORE.Show vbModal
    
    Set DATJDGL = OpenDatabase(App.Path & "\DATA\JDGL.MDB")
    Set RECWJBC = DATJDGL.OpenRecordset("SELECT 交班表.班次, 交班表.交班 From 交班表 WHERE (((交班表.交班)=False))", dbOpenDynaset)
    Set RECMAXBC = DATJDGL.OpenRecordset("SELECT DISTINCTROW Max([交班表].[班次]) AS 班次 FROM 交班表", dbOpenDynaset)
        
    '定义当前操作员班次
    If RECWJBC.RecordCount = 0 Then
       If RECMAXBC.RecordCount = 0 Then
          RECWJBC.AddNew
          RECWJBC("班次") = 1
          RECWJBC.Update
          frmLogin.CZYBC = 1
          Else
            frmLogin.CZYBC = IIf(IsNull(RECMAXBC("班次")), 0, RECMAXBC("班次")) + 1
            RECWJBC.AddNew
            RECWJBC("班次") = frmLogin.CZYBC
            RECWJBC.Update
       End If
       Else
         frmLogin.CZYBC = RECWJBC("班次")
    End If
    SMAIN.StatusBar1.Panels(1).Text = "操作员:" & frmLogin.CZYXM + "  总班次:" + CStr(frmLogin.CZYBC)
    RECWJBC.Close
    RECMAXBC.Close
    DATJDGL.Close
    Set RECWJBC = Nothing
    Set RECMAXBC = Nothing
    Set DATJDGL = Nothing
    Exit Sub

BACKERROR:
    MsgBox CStr(Err.Number) & "-" & Err.Description, vbCritical, "错误"
    Exit Sub

End Sub

Private Sub mnuHELP_LR_Click()
    Shell App.Path & "\hh.exe " & App.Path & "\help.chm", vbNormalFocus
End Sub

Private Sub mnuLIST_BZJ_Click()
    Load BZJWIN