skrz.frm

酒店管理系统

End Sub

Private Sub MNU22_Click()     ' 删除记录
    If Data1.Recordset.RecordCount = 0 Then Exit Sub
    SFOK = MsgBox("是否删除当前登记表?", vbYesNo + vbQuestion, "提示信息")
    If SFOK = vbYes Then
       If Data1.Recordset.EditMode = 2 Then
          Data1.UpdateControls
          Data1.Refresh
          Else
            RECKRZD.FindFirst ("客人ID='" & Data1.Recordset("客人ID") & "'")
            If Not RECKRZD.NoMatch Then
               MsgBox "经查已存在此人明细帐单!不能删除...", vbCritical, "提示信息"
               Exit Sub
               Else
                 Data1.Recordset.Delete
                 If Not Data1.Recordset.EOF Then
                    Data1.Recordset.MoveNext
                    If Data1.Recordset.EOF And Data1.Recordset.RecordCount > 0 Then Data1.Recordset.MoveLast
                    Else
                      Data1.Recordset.MoveLast
                 End If
            End If
       End If
    End If
    
End Sub

Private Sub MNU23_Click()
    MYID = Text6.Text
    Data1.UpdateControls
    Data1.Refresh
    Data1.Recordset.FindFirst ("客人ID='" & MYID & "'")
    Save

End Sub

Private Sub MNU26_Click()
    If Data1.Recordset.RecordCount > 0 Then Chang
End Sub

Private Sub MNU27_Click()
    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
       MNU21_Click
       Text2.Text = YDRZ.STRYD2
       Combo3.Text = YDRZ.STRYD4
       Text4.Text = YDRZ.STRYD5
       Text1(8).Text = YDRZ.STRYD6
       Text5.Text = FormatNumber(YDRZ.CURYD, 2, vbTrue, , vbFalse)
       RECYD.FindFirst ("定房卡号='" & YDRZ.STRYD1 & "'")
       If Not RECYD.NoMatch Then RECYD.Delete
    End If
End Sub

Private Sub MNU28_Click()
    If Text8.DataChanged Then
       If Not IsNumeric(Text8.Text) Then Text8.Text = 0
       Text8.Text = CStr(CInt(Text8.Text))
       RECHJZT.FindFirst ("房号=" & Text8.Text)
       If RECHJZT.NoMatch Then
          MsgBox Text8.Text & Chr(13) & "此房号为空号!", vbCritical, "提示信息"
          Text8.SetFocus
          Exit Sub
          Else
            If RECHJZT("房态") = "空房" Then
               RECHJZT.Edit
               RECHJZT("房态") = "在住"
               RECHJZT.Update
               Else
                 If RECHJZT("房态") = "在住" Then
                    SFOK = MsgBox(Text8.Text & Chr(13) & "此房间已有客人入住!是否加客?", vbYesNo + vbQuestion, "提示信息")
                    If SFOK = 7 Then
                       Text8.SetFocus
                       Exit Sub
                    End If
                    Else
                      If RECHJZT("房态") = "维修" Then
                         MsgBox Text8.Text & Chr(13) & "此房间正在维修!", vbCritical, "提示信息"
                         Text8.SetFocus
                         Exit Sub
                         Else
                           If RECHJZT("房态") = "走房" Then
                              MsgBox Text8.Text & Chr(13) & "此房间客人刚走,还未清扫!", vbCritical, "提示信息"
                              Text8.SetFocus
                              Exit Sub
                           End If
                      End If
                 End If
            End If
       End If
    End If

    MYID = Text6.Text
    Data1.UpdateRecord
    Data1.Recordset.FindFirst ("客人ID='" & MYID & "'")
    Save
End Sub

Private Sub MNU3_Click()
    If Data1.Recordset.RecordCount = 0 Then Exit Sub
    Load SKRZCXWIN
    SKRZCXWIN.Caption = "住房散客登记"
    SKRZCXWIN.Show vbModal
    If SKRZCXWIN.STRKRID <> "" Then Data1.Recordset.FindFirst ("客人ID='" & SKRZCXWIN.STRKRID & "'")
    
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 Text2_GotFocus()
    Text2.SelStart = 0
    Text2.SelLength = Len(Text2.Text)

End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       If Text2.DataChanged = True Then
          Label4.Caption = PYM(Text2.Text)
       End If
       SendKeys "{TAB}"
    End If
    
End Sub
Private Sub Text2_Validate(Cancel As Boolean)
    If Text2.DataChanged = True Then
       Label4.Caption = PYM(Text2.Text)
    End If

End Sub

Private Sub Text3_GotFocus()
    Text3.SelStart = 0
    Text3.SelLength = Len(Text3.Text)
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
    Dim STRVALID As String
    
    If KeyAscii = 13 Then
       SendKeys "{TAB}"
    End If
    STRVALID = "0123456789.+-"
    If KeyAscii > 26 Then
       If InStr(STRVALID, Chr(KeyAscii)) = 0 Then
          KeyAscii = 0
       End If
    End If
End Sub

Private Sub Text3_Validate(Cancel As Boolean)
    If Not IsNumeric(Text3.Text) Then Text3.Text = 0
    Text3.Text = FormatNumber(Text3.Text, 2, vbTrue, , vbFalse)
End Sub
Private Sub Text4_GotFocus()
    Text4.SelStart = 0
    Text4.SelLength = Len(Text4.Text)
End Sub
Private Sub Text4_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       SendKeys "{TAB}"
       KeyAscii = 0
    End If

End Sub

Private Sub Text5_GotFocus()
    Text5.SelStart = 0
    Text5.SelLength = Len(Text5.Text)
End Sub
Private Sub Text5_KeyPress(KeyAscii As Integer)
    Dim STRVALID As String
    
    If KeyAscii = 13 Then
       SendKeys "{TAB}"
    End If
    STRVALID = "0123456789.+-"
    If KeyAscii > 26 Then
       If InStr(STRVALID, Chr(KeyAscii)) = 0 Then
          KeyAscii = 0
       End If
    End If
End Sub

Private Sub Text5_Validate(Cancel As Boolean)
    If Not IsNumeric(Text5.Text) Then Text5.Text = 0
    Text5.Text = FormatNumber(Text5.Text, 2, vbTrue, , vbFalse)
    If IsNumeric(Text5.Text) Then
       If CDbl(Text5.Text) <> 0 Then
          Label2(7).Caption = "<大写>人民币" + SUMDM(CDbl(Text5.Text))
          Else
            Label2(7).Caption = "<大写>"
       End If
    End If

End Sub

Private Sub TEXT7_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
       SendKeys "{TAB}"
       KeyAscii = 0
    End If

End Sub
Private Sub Text7_GotFocus()
    Text7.SelStart = 0
    Text7.SelLength = Len(Text7.Text)
End Sub

Private Sub Text8_GotFocus()
    Text8.SelStart = 0
    Text8.SelLength = Len(Text8.Text)
End Sub
Private Sub Text8_KeyPress(KeyAscii As Integer)
    Dim STRVALID As String
    STRVALID = "0123456789"
    If KeyAscii > 26 Then
       If InStr(STRVALID, Chr(KeyAscii)) = 0 Then
          KeyAscii = 0
       End If
    End If
    
    If KeyAscii = 13 Then
       SendKeys "{TAB}"
    End If
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case UCase(Button.Key)
        Case "A"          ' 打印
            MNU13_Click
        Case "B"          ' 打印预览
            MNU12_Click
        Case "E"          ' 增加
            MNU21_Click
        Case "EDIT"       ' 修改
            MNU26_Click
        Case "SAVE"       ' 保存
            MNU28_Click
        Case "O"          ' 删除
            MNU23_Click
        Case "F"          ' 恢复增加
            MNU22_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
Private Sub Chang()      '可修改状态
    Text1(8).Locked = False
    Text2.Locked = False
    Text3.Locked = False
    Text4.Locked = False
    Text5.Locked = False
    Text7.Locked = False
    Text8.Locked = False
    Combo1.Locked = False
    DBCombo1.Locked = False
    Combo3.Locked = False
    dbFind1.Visible = True
    DTPicker1.Visible = True
    DTPicker2.Visible = True
    Label5.Visible = False
    Label6.Visible = False
        
    Text1(8).BackColor = &H80000005
    Text2.BackColor = &H80000005
    Text3.BackColor = &H80000005
    Text4.BackColor = &H80000005
    Text5.BackColor = &H80000005
    Text7.BackColor = &H80000005
    Text8.BackColor = &H80000005
    Combo1.BackColor = &H80000005
    Combo3.BackColor = &H80000005
    DBCombo1.BackColor = &H80000005
    
    '置有效或无效菜单
    Toolbar1.Buttons("E").Enabled = False
    Toolbar1.Buttons("G").Enabled = False
    Toolbar1.Buttons("EDIT").Enabled = False
    Toolbar1.Buttons("I").Enabled = False
    Toolbar1.Buttons("O").Enabled = True
    Toolbar1.Buttons("SAVE").Enabled = True
    Me.MNU21.Enabled = False
    Me.MNU22.Enabled = False
    Me.MNU26.Enabled = False
    Me.MNU27.Enabled = False
    Me.MNU3.Enabled = False
    Me.MNU23.Enabled = True
    Me.MNU28.Enabled = True
    Data1.Enabled = False

End Sub
Private Sub Save()      '保存修改
    Text1(8).Locked = True
    Text2.Locked = True
    Text3.Locked = True
    Text4.Locked = True
    Text5.Locked = True
    Text7.Locked = True
    Text8.Locked = True
    Combo1.Locked = True
    DBCombo1.Locked = True
    Combo3.Locked = True
    dbFind1.Visible = False
    DTPicker1.Visible = False
    DTPicker2.Visible = False
    Label5.Visible = True
    Label6.Visible = True
        
    Text1(8).BackColor = &H8000000F
    Text2.BackColor = &H8000000F
    Text3.BackColor = &H8000000F
    Text4.BackColor = &H8000000F
    Text5.BackColor = &H8000000F
    Text7.BackColor = &H8000000F
    Text8.BackColor = &H8000000F
    Combo1.BackColor = &H8000000F
    Combo3.BackColor = &H8000000F
    DBCombo1.BackColor = &H8000000F
    
    '置有效或无效菜单
    Toolbar1.Buttons("E").Enabled = True
    Toolbar1.Buttons("G").Enabled = True
    Toolbar1.Buttons("EDIT").Enabled = True
    Toolbar1.Buttons("I").Enabled = True
    Toolbar1.Buttons("O").Enabled = False
    Toolbar1.Buttons("SAVE").Enabled = False
    Me.MNU21.Enabled = True
    Me.MNU22.Enabled = True
    Me.MNU26.Enabled = True
    Me.MNU27.Enabled = True
    Me.MNU3.Enabled = True
    Me.MNU23.Enabled = False
    Me.MNU28.Enabled = False
    Data1.Enabled = True
    
    
End Sub