main.frm

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

    BZJWIN.Show
    
End Sub

Private Sub mnuLIST_LSJJB_Click()
    Load SKSQWIN
    SKSQWIN.Check1.Enabled = False
    SKSQWIN.Command1.Visible = False
    SKSQWIN.Command3.Visible = False
    SKSQWIN.Command4.Visible = True
    SKSQWIN.Show vbModal

End Sub

Private Sub mnuLIST_RCTJ_Click()
    Load ZDRCTJ
    ZDRCTJ.Show
    
End Sub

Private Sub mnuLIST_SKSQ_Click()
    Load SKSQWIN
    SKSQWIN.Command1.Visible = True
    SKSQWIN.Command3.Visible = False
    SKSQWIN.Show vbModal

End Sub

Private Sub mnuLIST_SRMX_Click()
    Load JBBWIN
    JBBWIN.Show
    
End Sub

Private Sub mnuLIST_THSQ_Click()
    Load SKSQWIN
    SKSQWIN.Command1.Visible = False
    SKSQWIN.Command3.Visible = True
    SKSQWIN.Show vbModal
    
End Sub

Private Sub mnuLIST_YBB_Click()
    Load YBBWIN
    YBBWIN.Show
End Sub

Private Sub mnuRepair_Click()
    Load REPAIR
    REPAIR.Show
    
End Sub

Private Sub mnuRZ_HF_SK_Click()
    Dim DATJDGL As Database
    Dim RECSK As Recordset
    Dim THHJAP As Recordset
    Dim RECHT As Recordset
    Dim SKID As String
    Dim INTFH As Integer
    Dim INTYFH As Integer
    Dim STRFH As String
    Dim MYMARK As String
    
    SKID = InputBox("请输入需换房客人的登记卡号:", "提示信息")
    If SKID = "" Then Exit Sub
    Set DATJDGL = OpenDatabase(App.Path & "\DATA\JDGL.MDB")
    Set RECSK = DATJDGL.OpenRecordset("散客登记表", dbOpenDynaset)
    Set THHJAP = DATJDGL.OpenRecordset("团会房间安排", dbOpenDynaset)
    Set RECHT = DATJDGL.OpenRecordset("房间状态", dbOpenDynaset)
    RECSK.FindFirst ("客人ID='" & SKID & "'")
    If RECSK.NoMatch Then
       MsgBox "经查无此客人登记!", vbCritical, "提示信息"
       GoTo DATCLOSE
       Else
         If Not RECSK("住房") Then
            MsgBox "此客人未住房,不能换房!", vbInformation, "提示信息"
            Else
              STRFH = InputBox(IIf(IsNull(RECSK("房号")), "", CStr(RECSK("房号"))) + "    " + RECSK("姓名") + Chr(13) + "请输入换入的房间房号:", "换房提示")
              If Not IsNumeric(STRFH) Then
                 MsgBox "输入的数据类型错误!" + Chr(13) + "换房失败...", vbCritical, "错误信息"
                 GoTo DATCLOSE
                 Else
                   INTFH = CInt(STRFH)
                   If INTFH = RECSK("房号") Then GoTo DATCLOSE
                   RECHT.FindFirst ("房号=" & INTFH)
                   If RECHT.NoMatch Then
                      MsgBox "经查无此房号房间!" + Chr(13) + "换房失败...", vbCritical, "错误信息"
                      GoTo DATCLOSE
                      Else
                        If RECHT("房态") = "空房" Then
                           RECHT.Edit
                           RECHT("房态") = "在住"
                           RECHT.Update
                           Else
                             If RECHT("房态") = "在住" Then
                                If MsgBox("此房间已有客人入住!是否加客?", vbYesNo + vbQuestion, "提示信息") = vbNo Then
                                   MsgBox "换房失败...", vbCritical, "提求信息"
                                   GoTo DATCLOSE
                                End If
                                Else
                                  If RECHT("房态") = "维修" Then
                                     MsgBox "此房间正在维修!" + Chr(13) + "换房失败...", vbCritical, "提示信息"
                                     GoTo DATCLOSE
                                     Else
                                       If RECHT("房态") = "走房" Then
                                          MsgBox "此房间客人刚走,还未清扫!" + Chr(13) + "换房失败...", vbCritical, "提示信息"
                                          GoTo DATCLOSE
                                       End If
                                  End If
                             End If
                        End If
                        '检查原房间如无在住客,改房态为走房
                        INTYFH = RECSK("房号")
                        MYMARK = RECSK.Bookmark
                        THHJAP.FindFirst ("房号=" & INTYFH)
                        If THHJAP.NoMatch Then
                           RECSK.FindFirst ("房号=" & INTYFH & " AND 客人ID<>'" & SKID & "'")
                           If RECSK.NoMatch Then
                              RECHT.FindFirst ("房号=" & INTYFH)
                              If Not RECHT.NoMatch Then
                                 RECHT.Edit
                                 RECHT("房态") = "走房"
                                 RECHT.Update
                              End If
                           End If
                        End If
                        RECSK.Bookmark = MYMARK
                        '修改客人房号
                        RECSK.Edit
                        RECSK("房号") = INTFH
                        MsgBox "已将" & RECSK("姓名") & "从" & CStr(INTYFH) & "号房换至" & INTFH & "号房!", vbInformation, "提示信息"
                        RECSK.Update
                   End If
              End If
         End If
    End If
    
DATCLOSE:
    DATJDGL.Close
    
End Sub

Private Sub mnuRZ_HF_TH_Click()
    Dim DATJDGL As Database
    Dim RECTH As Recordset
    Dim SKID As String
    
    SKID = InputBox("请输入需换房团会的登记卡号:", "提示信息")
    If SKID = "" Then Exit Sub
    Set DATJDGL = OpenDatabase(App.Path & "\DATA\JDGL.MDB")
    Set RECTH = DATJDGL.OpenRecordset("团会登记表", dbOpenDynaset)
    RECTH.FindFirst ("团会ID='" & SKID & "'")
    If RECTH.NoMatch Then
       MsgBox "经查无此团会登记!", vbCritical, "提示信息"
       DATJDGL.Close
       Exit Sub
       Else
         If Not RECTH("住房") Then
            MsgBox "此团会未住房,不能换房!", vbInformation, "提示信息"
            Else
              Load THYJ
              THYJ.Caption = "团会成员换房"
              THYJ.Label1.Caption = SKID + "  " + IIf(IsNull(RECTH("团会名称")), "", RECTH("团会名称"))
              THYJ.Command1.Visible = False
              THYJ.Command3.Visible = True
              THYJ.Show vbModal
         End If
    End If
    DATJDGL.Close
    
End Sub

Private Sub mnuRZ_HT_Click()
    Load HTTZ
    HTTZ.Show vbModal
End Sub

Private Sub mnuRZ_LD_Click()
    Dim DATJDGL As Database
    Dim RECTH As Recordset
    Dim SKID As String
    
    SKID = InputBox("请输入成员所属团会的登记卡号:", "提示信息")
    If SKID = "" Then Exit Sub
    Set DATJDGL = OpenDatabase(App.Path & "\DATA\JDGL.MDB")
    Set RECTH = DATJDGL.OpenRecordset("团会登记表", dbOpenDynaset)
    RECTH.FindFirst ("团会ID='" & SKID & "'")
    If RECTH.NoMatch Then
       MsgBox "经查无此团会登记!", vbCritical, "提示信息"
       DATJDGL.Close
       Exit Sub
       Else
         If Not RECTH("住房") Then
            MsgBox "此团会未住房,成员可直接离店,无需办理离店手续!", vbInformation, "提示信息"
            Else
              Load THYJ
              THYJ.Caption = "团会成员提前离店"
              THYJ.Label1.Caption = SKID + "  " + IIf(IsNull(RECTH("团会名称")), "", RECTH("团会名称"))
              THYJ.Command1.Visible = False
              THYJ.Command4.Visible = True
              THYJ.Show vbModal
         End If
    End If
    DATJDGL.Close

End Sub

Private Sub mnuRZ_SK_Click()
    Load SKRZ
    SKRZ.Show vbModal
End Sub

Private Sub mnuRZ_TF_SK_Click()
    Dim DATJDGL As Database
    Dim RECSK As Recordset
    Dim RECZD As Recordset
    Dim SKID As String
    
    SKID = InputBox("请输入需退房客人的登记卡号:", "提示信息")
    If SKID = "" Then Exit Sub
    Set DATJDGL = OpenDatabase(App.Path & "\DATA\JDGL.MDB")
    Set RECSK = DATJDGL.OpenRecordset("散客登记表", dbOpenDynaset)
    Set RECZD = DATJDGL.OpenRecordset("客人帐单", dbOpenDynaset)
    RECZD.FindFirst ("客人ID='" & SKID & "'")
    If Not RECZD.NoMatch Then
       MsgBox "此客人已有消费帐单,不能退房!", vbCritical, "提示信息"
       DATJDGL.Close
       Exit Sub
    End If
    RECSK.FindFirst ("客人ID='" & SKID & "'")
    If RECSK.NoMatch Then
       MsgBox "经查无此客人登记!", vbCritical, "提示信息"
       DATJDGL.Close
       Exit Sub
       Else
         RECSK.Delete
         MsgBox "登记卡号:" & SKID & Chr(13) & "退房完毕!", vbInformation, "提示信息"
    End If
    DATJDGL.Close
End Sub

Private Sub mnuRZ_TF_TH_Click()
    Dim DATJDGL As Database
    Dim RECTH As Recordset
    Dim RECZD As Recordset
    Dim SKID As String
    
    SKID = InputBox("请输入需退房团会的登记卡号:", "提示信息")
    If SKID = "" Then Exit Sub
    Set DATJDGL = OpenDatabase(App.Path & "\DATA\JDGL.MDB")
    Set RECTH = DATJDGL.OpenRecordset("团会登记表", dbOpenDynaset)
    Set RECZD = DATJDGL.OpenRecordset("客人帐单", dbOpenDynaset)
    RECZD.FindFirst ("团会ID='" & SKID & "'")
    If Not RECZD.NoMatch Then
       MsgBox "此团会已有消费帐单,不能退房!", vbCritical, "提示信息"
       DATJDGL.Close
       Exit Sub
    End If
    RECTH.FindFirst ("团会ID='" & SKID & "'")
    If RECTH.NoMatch Then
       MsgBox "经查无此团会登记!", vbCritical, "提示信息"
       DATJDGL.Close
       Exit Sub
       Else
         RECTH.Delete
         MsgBox "登记卡号:" & SKID & Chr(13) & "退房完毕!", vbInformation, "提示信息"
    End If
    DATJDGL.Close

End Sub

Private Sub mnuRZ_TH_Click()
    Load THRZ
    THRZ.Show vbModal
    
End Sub

Private Sub mnuRZ_ZL_Click()
    Load KRZL
    KRZL.Show vbModal
End Sub

Private Sub MNUSZ_CWFG_Click()
    Load CZQX
    CZQX.Show vbModal
    
End Sub

Private Sub MNUSZ_FJ_Click()
    Load HJSZ
    HJSZ.Show vbModal
    
End Sub

Private Sub MNUSZ_MM_Click()
    Load CZYGHMM
    CZYGHMM.Show vbModal
    
End Sub

Private Sub MNUSZ_PYM_Click()
    Load PYMWIN
    PYMWIN.Show
End Sub

Private Sub mnuViewStatusBar_Click()
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
    StatusBar1.Visible = mnuViewStatusBar.Checked

End Sub

Private Sub mnuViewToolbar_Click()
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
    CoolBar1.Visible = mnuViewToolbar.Checked

End Sub

Private Sub mnuYD_QX_Click()
    Dim SFOK As Integer
    Dim DATJDGL As Database
    Dim RECYD As Recordset
    Set DATJDGL = OpenDatabase(App.Path & "\DATA\JDGL.MDB")
    Set RECYD = DATJDGL.OpenRecordset("预订单", dbOpenDynaset)
    If RECYD.RecordCount = 0 Then
       MsgBox "系统中无可选预定单!", vbCritical, "提示信息"
       Exit Sub
    End If
    Load YDRZ
    YDRZ.Show vbModal
    If YDRZ.STRYD1 <> " " Then
       SFOK = MsgBox(YDRZ.STRYD1 + "  " + YDRZ.STRYD2 + Chr(13) + "请确认是否取消此预订?", vbQuestion + vbYesNo, "提示信息")
       If SFOK = vbYes Then
          RECYD.FindFirst ("定房卡号='" & YDRZ.STRYD1 & "'")
          If Not RECYD.NoMatch Then RECYD.Delete
       End If
    End If
End Sub

Private Sub mnuYD_SR_Click()
    Load YDFJ
    YDFJ.Show vbModal
    
End Sub

Private Sub mnuZW_BZJ_Click()
    Load SBZJ
    SBZJ.Show vbModal
    
End Sub

Private Sub mnuZW_FZGZ_Click()
    Load FZGZ
    FZGZ.Show vbModal
End Sub

Private Sub mnuZW_KRJZ_Click()
    Load KRJZ
    KRJZ.Show vbModal
    
End Sub

Private Sub mnuZW_TBZJ_Click()
    Load TBZJ
    TBZJ.Show vbModal
    
End Sub

Private Sub mnuZW_ZD_Click()
    Load KRZD
    KRZD.Show vbModal
    
End Sub

Private Sub Timer1_Timer()
    Dim ShowAtStartup As Long
    Timer1.Enabled = False
    If TIPSHOW <> "" Then
       Exit Sub
    End If
    ' 察看在启动时是否将显示日积月累
    ShowAtStartup = GetSetting(App.EXEName, "Options", "在启动时显示提示", 1)
    If ShowAtStartup = 1 Then
        Load frmTip
        frmTip.Show vbModal, Me
    End If
    TIPSHOW = "SHOW"

End Sub

Private Sub Timer2_Timer()
    Label1.left = Label1.left - 15
    If Abs(Label1.left) >= Label1.Width Then Label1.left = Picture1.Width
       
End Sub
Private Sub Timer3_Timer()
    StatusBar1.Panels(2).Text = "日期:" & Format(Now, "LONG DATE")
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case UCase(Button.Key)
    Case "HELP"
         mnuHELP_LR_Click
    Case "BACKUP"
         mnuFILE_BACKUP_Click
    Case "RESTORE"
         mnuFILE_RESTORE_Click
    Case "PRINT"
         CommonDialog1.PrinterDefault = True
         CommonDialog1.ShowPrinter
    Case "DATE"
         Load RQ
         RQ.Show vbModal
         SMAIN.StatusBar1.Panels(2).Text = "日期:" & Format(Now, "LONG DATE")
    Case "JSQ"
         Shell "CALC.EXE"
    Case "CZY"
         mnuFILE_ZC_Click
    Case "ABOUT"
         Load frmAbout
         frmAbout.Show vbModal
    Case "QUIT"
         Unload Me
    
    End Select
End Sub

Public Sub CheckExist(fm As Form)  '防止窗体重新Activate
    Dim TITLE As String
    
    If App.PrevInstance Then
        TITLE = App.TITLE
        Call MsgBox("程序已经执行!", vbCritical)
        App.TITLE = "" '如此才不会Avtivate到自己
        fm.Caption = ""
        AppActivate TITLE 'activate先前就已行的程式
        End
    End If
End Sub