📄 krjz.frm

📁 酒店系统源码。为了学习和研究软件内含的设计思想和原理
💻 FRM
📖 第 1 页 / 共 3 页
字号:
上一页 1 23
          If Not IsNull(Data1(SSTab1.Tab).Recordset("房号")) Then STROPTION = STROPTION + CStr(Data1(SSTab1.Tab).Recordset("房号"))
          If Not IsNull(Data1(SSTab1.Tab).Recordset("姓名")) Then STROPTION = STROPTION + "  " + CStr(Data1(SSTab1.Tab).Recordset("姓名"))
          If Not IsNull(Data1(SSTab1.Tab).Recordset("性别")) Then STROPTION = STROPTION + "  " + CStr(Data1(SSTab1.Tab).Recordset("性别"))
          If Not IsNull(Data1(SSTab1.Tab).Recordset("证件类别")) Then STROPTION = STROPTION + Chr(13) + CStr(Data1(SSTab1.Tab).Recordset("证件类别"))
          If Not IsNull(Data1(SSTab1.Tab).Recordset("证件号码")) Then STROPTION = STROPTION + "  " + CStr(Data1(SSTab1.Tab).Recordset("证件号码"))
          If Not IsNull(Data1(SSTab1.Tab).Recordset("类别")) Then STROPTION = STROPTION + Chr(13) + CStr(Data1(SSTab1.Tab).Recordset("类别"))
          If Not IsNull(Data1(SSTab1.Tab).Recordset("国籍")) Then STROPTION = STROPTION + "  " + CStr(Data1(SSTab1.Tab).Recordset("国籍"))
          If Not IsNull(Data1(SSTab1.Tab).Recordset("入住日期")) Then STROPTION = STROPTION + Chr(13) + Format(Data1(SSTab1.Tab).Recordset("入住日期"), "LONG DATE")
          If Not IsNull(Data1(SSTab1.Tab).Recordset("离住日期")) Then STROPTION = STROPTION + "  " + Format(Data1(SSTab1.Tab).Recordset("离住日期"), "LONG DATE")
          If Not IsNull(Data1(SSTab1.Tab).Recordset("单位或地址")) Then STROPTION = STROPTION + Chr(13) + CStr(Data1(SSTab1.Tab).Recordset("单位或地址"))
          If Not Data1(SSTab1.Tab).Recordset("住房") Then
             STROPTION = STROPTION + Chr(13) + Chr(13) + "非住房客人"
             DBGrid1.Columns("房费").Locked = True
             DBGrid1.Columns("商品").Locked = True
             DBGrid1.Columns("加床费").Locked = True
             Else
               DBGrid1.Columns("房费").Locked = False
               DBGrid1.Columns("商品").Locked = False
               DBGrid1.Columns("加床费").Locked = False
          End If
          Else
            If Not IsNull(Data1(SSTab1.Tab).Recordset("团会名称")) Then STROPTION = STROPTION + CStr(Data1(SSTab1.Tab).Recordset("团会名称"))
            If Not IsNull(Data1(SSTab1.Tab).Recordset("团体人数")) Then STROPTION = STROPTION + Chr(13) + "人数:" + CStr(Data1(SSTab1.Tab).Recordset("团体人数"))
            If Not IsNull(Data1(SSTab1.Tab).Recordset("陪同人数")) Then STROPTION = STROPTION + "  陪同:" + CStr(Data1(SSTab1.Tab).Recordset("陪同人数"))
            If Not IsNull(Data1(SSTab1.Tab).Recordset("入住日期")) Then STROPTION = STROPTION + Chr(13) + Format(Data1(SSTab1.Tab).Recordset("入住日期"), "LONG DATE")
            If Not IsNull(Data1(SSTab1.Tab).Recordset("离住日期")) Then STROPTION = STROPTION + "  " + Format(Data1(SSTab1.Tab).Recordset("离住日期"), "LONG DATE")
            If Not Data1(SSTab1.Tab).Recordset("住房") Then
               STROPTION = STROPTION + Chr(13) + Chr(13) + "非住房团会"
               DBGrid1.Columns("房费").Locked = True
               DBGrid1.Columns("商品").Locked = True
               DBGrid1.Columns("加床费").Locked = True
               Else
                 DBGrid1.Columns("房费").Locked = False
                 DBGrid1.Columns("商品").Locked = False
                 DBGrid1.Columns("加床费").Locked = False
            End If
       End If
    End If
    Label2(SSTab1.Tab).Caption = STROPTION
    DBGrid1.Refresh
End Sub

Private Sub MNU11_Click()      '打印机设置
    CDLTEST.flags = cdlPDDisablePrintToFile
    CDLTEST.Copies = 3
    CDLTEST.PrinterDefault = True
    CDLTEST.ShowPrinter

End Sub

Private Sub MNU16_Click()     ' 退出模块
    Unload Me
    
End Sub

Private Sub MNU21_Click()
    If DBGrid1.DataChanged Then
       Data3(0).UpdateRecord
    End If
    If SSTab1.Tab = 0 And List1(0).Text <> "" Then
       Data3(0).Recordset.AddNew
       Data3(0).Recordset("客人ID") = left(List1(0).Text, 12)
       Data3(0).Recordset("日期") = Now
       Data3(0).Recordset("操作员") = frmLogin.CZYXM
       Data3(0).Recordset("班次") = frmLogin.CZYBC
       INTID = Data3(0).Recordset("ID")
       Data3(0).Recordset.Update
    End If
    If SSTab1.Tab = 1 And List1(1).Text <> "" Then
       Data3(0).Recordset.AddNew
       Data3(0).Recordset("团会ID") = left(List1(1).Text, 12)
       Data3(0).Recordset("日期") = Now
       Data3(0).Recordset("操作员") = frmLogin.CZYXM
       Data3(0).Recordset("班次") = frmLogin.CZYBC
       INTID = Data3(0).Recordset("ID")
       Data3(0).Recordset.Update
    End If
    Data3(0).Recordset.FindFirst ("ID=" & INTID)
End Sub

Private Sub MNU22_Click()     ' 删除记录
    If Data3(0).Recordset.RecordCount = 0 Then Exit Sub
    SFOK = MsgBox("是否删除当前行?", vbYesNo + vbQuestion, "提示信息")
    If SFOK = vbYes Then
       Data3(0).Recordset.Delete
       If Not Data3(0).Recordset.EOF Then
          Data3(0).Recordset.MoveNext
          If Data3(0).Recordset.EOF And Data3(0).Recordset.RecordCount > 0 Then Data3(0).Recordset.MoveLast
          Else
            Data3(0).Recordset.MoveLast
       End If
       Data3(1).Refresh
    End If
    List1_Click (SSTab1.Tab)
    
End Sub

Private Sub MNU3_Click()
    Dim RECHJAP As Recordset, RECSKJZ As Recordset
    
    On Error GoTo BACKERROR
    
    Set RECHJAP = DATJDGL.OpenRecordset("团会房间安排", dbOpenDynaset)
    If SSTab1.Tab = 1 Then
       RECHJAP.FindFirst ("团会ID='" & left(List1(1).Text, 12) & "' AND 押金<>0 ")
       If Not RECHJAP.NoMatch Then
          Load THYJ
          THYJ.Caption = "退还钥匙押金"
          THYJ.Label1.Caption = List1(1).Text
          THYJ.Show vbModal
       End If
       RECHJAP.FindFirst ("团会ID='" & left(List1(1).Text, 12) & "' AND 押金<>0 ")
       If Not RECHJAP.NoMatch Then
          MsgBox "还有团会成员未退钥匙押金,不能结帐!", vbCritical, "错误信息"
          Exit Sub
       End If
    End If
    If List1(SSTab1.Tab).Text = "" Then
       MsgBox "请选择需办理结算的客人或团会!", vbCritical, "提示信息"
       Exit Sub
    End If
    If Data3(0).Recordset.RecordCount = 0 Then
       MsgBox "此客人没有消费帐单!不能结帐...", vbCritical, "提示信息"
       Exit Sub
    End If
    If STRJZLX = "" Then
       MsgBox "请选择结帐类型!", vbCritical, "提示信息"
       Option1(0).SetFocus
       Exit Sub
    End If
    SFOK = MsgBox(List1(SSTab1.Tab).Text + Chr(13) + "请确认是否办理" + STRJZLX + "?", vbYesNo + vbQuestion, "提示信息")
    If SFOK = vbYes Then
       Set RECHT = DATJDGL.OpenRecordset("房间状态", dbOpenDynaset)       '打开房间状态表
       If SSTab1.Tab = 0 Then                                             '散客结帐
          DATJDGL.Execute ("INSERT INTO 散客结帐 SELECT 客人ID,房号,姓名,性别,证件类别,证件号码,类别,国籍,入住日期,离住日期,房价,单位或地址,预付款,附注,住房 FROM 散客登记表 WHERE 散客登记表.客人ID='" & left(List1(0).Text, 12) & "'")
          Set RECSKJZ = DATJDGL.OpenRecordset("散客结帐", dbOpenDynaset)
          RECSKJZ.FindFirst ("客人ID='" & left(List1(0).Text, 12) & "'")
          If Not RECSKJZ.NoMatch Then
             RECSKJZ.Edit
             RECSKJZ("结帐日期") = Now
             RECSKJZ("离住日期") = Now
             RECSKJZ("结帐类型") = STRJZLX
             RECSKJZ("操作员") = frmLogin.CZYXM
             RECSKJZ("班次") = frmLogin.CZYBC
             RECSKJZ.Update
             '调整结帐房间的房态
             RECSK.Requery
             If RECSKJZ("住房") Then
                RECSK.FindFirst ("房号=" & RECSKJZ("房号"))
                If RECSK.NoMatch Then
                   RECHJAP.FindFirst ("房号=" & RECSKJZ("房号"))
                   If RECHJAP.NoMatch Then
                      RECHT.FindFirst ("房号=" & RECSKJZ("房号"))
                      If Not RECHT.NoMatch Then
                         RECHT.Edit
                         RECHT("房态") = "走房"
                         RECHT.Update
                      End If
                   End If
                End If
             End If
          End If
          DATJDGL.Execute ("INSERT INTO 结帐帐单 SELECT * FROM 客人帐单 WHERE 客人帐单.客人ID='" & left(List1(0).Text, 12) & "'")
          DATJDGL.Execute ("UPDATE 结帐帐单 SET 结帐日期=NOW,班次=" & frmLogin.CZYBC & " WHERE 客人ID='" & left(List1(0).Text, 12) & "'")
          DATJDGL.Execute ("DELETE FROM 散客登记表 WHERE 散客登记表.客人ID='" & left(List1(0).Text, 12) & "'")
          Load KRJZ1
          KRJZ1.Show vbModal
          List1(0).Clear
          RECSK.Requery
          If RECSK.RecordCount > 0 Then RECSK.MoveFirst
          While Not RECSK.EOF
                List1(0).AddItem RECSK("客人ID") + "  " + IIf(IsNull(RECSK("姓名")), "", RECSK("姓名"))
                RECSK.MoveNext
          Wend
          Else
            RECTH.FindFirst ("团会ID='" & left(List1(1).Text, 12) & "'")
            If Not RECTH.NoMatch Then
               STRFIND = "SELECT 团会房间安排.团会ID, 团会房间安排.房号 From 团会房间安排 WHERE (((团会房间安排.团会ID)='" & RECTH("团会ID") & "'))"
               Set RECHJAP = DATJDGL.OpenRecordset(STRFIND, dbOpenDynaset)
               STRFF = ""
               While Not RECHJAP.EOF
                     If InStr(STRFF, CStr(RECHJAP("房号"))) = 0 Then
                        If STRFF = "" Then
                           STRFF = STRFF + CStr(RECHJAP("房号"))
                           Else
                             STRFF = STRFF + "、" + CStr(RECHJAP("房号"))
                        End If
                     End If
                     '调整结帐房间的房态
                     Set RECHJAP1 = DATJDGL.OpenRecordset("SELECT 团会房间安排.ID, 团会房间安排.团会ID, 团会房间安排.房号, 团会房间安排.姓名, 团会房间安排.性别, 团会房间安排.押金, 团会房间安排.附注 From 团会房间安排 WHERE (((团会房间安排.团会ID)<>'" & left(List1(1).Text, 12) & "'))")
                     RECSK.FindFirst ("房号=" & RECHJAP("房号"))
                     If RECSK.NoMatch Then
                        RECHJAP1.FindFirst ("房号=" & RECHJAP("房号"))
                        If RECHJAP1.NoMatch Then
                           RECHT.FindFirst ("房号=" & RECHJAP("房号"))
                           If Not RECHT.NoMatch Then
                              RECHT.Edit
                              RECHT("房态") = "走房"
                              RECHT.Update
                           End If
                        End If
                     End If
                     RECHJAP.MoveNext
               Wend
            End If
            DATJDGL.Execute ("INSERT INTO 团会结帐 SELECT 团会ID,团会名称,团体人数,陪同人数,入住日期,离住日期,预付款,附注,操作员,住房 FROM 团会登记表 WHERE 团会登记表.团会ID='" & left(List1(1).Text, 12) & "'")
            Set RECTHJZ = DATJDGL.OpenRecordset("团会结帐", dbOpenDynaset)
            RECTHJZ.FindFirst ("团会ID='" & left(List1(1).Text, 12) & "'")
            If Not RECTHJZ.NoMatch Then
               RECTHJZ.Edit
               RECTHJZ("结帐日期") = Now
               RECTHJZ("离住日期") = Now
               RECTHJZ("结帐类型") = STRJZLX
               If STRFF <> "" Then RECTHJZ("房号") = STRFF
               RECTHJZ("操作员") = frmLogin.CZYXM
               RECTHJZ("班次") = frmLogin.CZYBC
               RECTHJZ.Update
            End If
            DATJDGL.Execute ("INSERT INTO 结帐帐单 SELECT * FROM 客人帐单 WHERE 客人帐单.团会ID='" & left(List1(1).Text, 12) & "'")
            DATJDGL.Execute ("UPDATE 结帐帐单 SET 结帐日期=NOW,班次=" & frmLogin.CZYBC & " WHERE 团会ID='" & left(List1(1).Text, 12) & "'")
            DATJDGL.Execute ("DELETE FROM 团会登记表 WHERE 团会登记表.团会ID='" & left(List1(1).Text, 12) & "'")
            Load KRJZ2
            KRJZ2.Show vbModal
            If RECTH.RecordCount > 0 Then RECTH.MoveFirst
            List1(1).Clear
            RECTH.Requery
            Do While Not RECTH.EOF
               If RECTH("团会名称") <> " " Then
                  List1(1).AddItem RECTH("团会ID") + "  " + IIf(IsNull(RECTH("团会名称")), "", RECTH("团会名称"))
               End If
               RECTH.MoveNext
            Loop
       End If
       Data1(SSTab1.Tab).Refresh
       Data3(1).RecordSource = Data2(SSTab1.Tab).RecordSource
       Data3(1).Refresh
       List1_Click (SSTab1.Tab)
       Else
         Exit Sub
    End If
    Exit Sub
    
BACKERROR:
    If Err.Number = 3704 Then
       Resume Next
       Else
         MsgBox CStr(Err.Number) & "-" & Err.Description, vbCritical, "错误信息"
         Unload Me
    End If

End Sub


Private Sub MNU4_Click()            ' 计算器
    Dim jsq As Double
    jsq = Shell("calc", vbNormalNoFocus)
 
End Sub

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

Private Sub MNU54_Click()          ' 关于对话
    Load frmAbout
    frmAbout.Show vbModal
    
End Sub


Private Sub Option1_Click(Index As Integer)
    STRJZLX = Option1(Index).Caption
End Sub

Private Sub SSTab1_Click(PreviousTab As Integer)
    If SSTab1.Tab = 0 Then
       Data3(1).RecordSource = Data2(0).RecordSource
       Else
         Data3(1).RecordSource = Data2(1).RecordSource
    End If
    Data3(1).Refresh
    If List1(SSTab1.Tab).ListCount > 0 Then
       If List1(SSTab1.Tab).Text = "" Then List1(SSTab1.Tab).ListIndex = 0
    End If
    List1_Click (SSTab1.Tab)
    

End Sub

Private Sub Text3_Change(Index As Integer)
    List1(SSTab1.Tab).Clear
    If RECSK.RecordCount > 0 Then RECSK.MoveFirst
    If RECTH.RecordCount > 0 Then RECTH.MoveFirst
    If SSTab1.Tab = 0 Then
       While Not RECSK.EOF
           If InStr(UCase(RECSK("FPY")), UCase(Text3(Index).Text)) > 0 Or Text3(Index).Text = "" Then
              List1(SSTab1.Tab).AddItem RECSK("客人ID") + "  " + IIf(IsNull(RECSK("姓名")), "", RECSK("姓名"))
           End If
           RECSK.MoveNext
       Wend
       Else
         While Not RECTH.EOF
             If InStr(UCase(RECTH("FPY")), UCase(Text3(Index).Text)) > 0 Or Text3(Index).Text = "" Then
                List1(SSTab1.Tab).AddItem RECTH("团会ID") + "  " + IIf(IsNull(RECTH("团会名称")), "", RECTH("团会名称"))
             End If
             RECTH.MoveNext
         Wend
    End If

End Sub

Private Sub Text3_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 13 Then
       If List1(SSTab1.Tab).ListCount > 0 Then
          List1(SSTab1.Tab).ListIndex = 0
          List1(SSTab1.Tab).SetFocus
       End If
    End If

End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case UCase(Button.Key)
        Case "A"          ' 打印机设置
            MNU11_Click
        Case "B"          ' 打印预览
            MsgBox "B"
        Case "C"          ' 文件输出
            MsgBox "C"
        Case "E"          ' 增加
            MNU21_Click
        Case "G"          ' 删除
            MNU22_Click
        Case "I"          ' 查看
            MNU3_Click
            
        Case "K"          ' 计算器
            MNU4_Click
        Case "M"          ' 帮助
            MNU51_Click
        Case "N"          ' 退出
            Unload Me
    End Select
End Sub
上一页 1 23
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -