dt_sfdj.frm

该系统为酒店日常管理提供了很大的方便

        
'????
        sfdj_freeRT = Pub_free(CDate(lb_rzrq.Caption), CDate(tx_ldrq.Text), sfdj_dffls, CInt(tx_zklx.Text), pub_code)
        If sfdj_freeRT Then
            Call Pub_kftj(CDate(lb_rzrq.Caption), CDate(tx_ldrq.Text), sfdj_dffls, CDate(lb_rzrq.Caption), CDate(tx_ldrq.Text), sfdj_dffls, CInt(tx_zklx.Text), pub_code)
            
            dt_krdj.PFRS = 0
            dt_krdj.PFFLS = PUB_JOIN(sfdj_pffls, 3, pub_code)
            Call dt_krdj.MAIN("增加", "", "", Trim(tx_tdh.Text), Trim(cm_tdmc.Text), Date, CDate(tx_ldrq.Text), sfdj_dffls, Trim(tx_zklx.Text), tx_rs.Text, "", "", "")
            dt_krdj.Show (1)
            Call PUB_FJFL(sfdj_pffls, dt_krdj.PFFLS, 3, pub_code)
        
        
            Dim temp_fls_c() As Integer   '保存各种房类型的派房与订房间的差额
            
            '无预订登记的处理
            ReDim temp_fls_c(SYS_LXN + 1)
            For i = 1 To SYS_LXN
                temp_fls_c(i) = sfdj_pffls(i) - sfdj_dffls(i)
            Next i
            
            '修改客房利用情况统计表
            Call Pub_kftj(CDate(lb_rzrq.Caption), CDate(tx_ldrq.Text), temp_fls_c, CDate(lb_rzrq.Caption), CDate(tx_ldrq.Text), temp_fls_c, CInt(tx_zklx.Text), pub_code)
        
        Else
            Call tools.PUB_SYKF(PUB_data, CDate(lb_rzrq.Caption), CDate(tx_ldrq.Text), sfdj_dffls, SYS_LXN, SYS_LXC, SYS_Yl, pub_code)
        End If
        
        Unload Me
    Case 1      '退出
        Unload Me
    End Select
End Sub


'***********************************************************************
'* 功    能 : 给 Form 赋焦点
'* 作 成 者 : 梁 卫
'* 生成日期 : 1999.03.18
'* 修改日期 : 1999.03.18
'***********************************************************************
Private Sub Form_Activate()
    cm_zkmc.SetFocus
End Sub

'***********************************************************************
'* 功    能 : 按 Esc 键时， 退出
'* 作 成 者 : 梁 卫
'* 生成日期 : 1999.03.18
'* 修改日期 : 1999.03.18
'***********************************************************************
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then
        Unload Me
    End If
End Sub

'***********************************************************************
'* 功    能 : 前台接待处散客无预订登记
'* 作 成 者 : 梁 卫
'* 生成日期 : 1999.03.04
'* 修改日期 : 1999.03.04
'***********************************************************************
Private Sub Form_Load()

    dt_sfdj.KeyPreview = True
    
    Me.Left = (Screen.Width - Me.Width) / 2   ' 在水平方向上居中。
    Me.Top = (Screen.Height - Me.Height) / 2  ' 在垂直方向上居中。
    
    '初始化
    fm_tdxx.Visible = False
    frm_msg.Visible = False
    frm_msg.Caption = ""
        
    tx_tdh.Text = ""
    cm_tdmc.Text = ""
    tx_rs.Text = 1
    
    For i = 1 To SYS_LXN
        lb_lxc(i).Visible = True
        lb_lxc(i).Caption = SYS_LXC(i)
        tx_fls(i).Visible = True
        tx_fls(i).Text = 0
    Next i
    
    lb_rzrq.Caption = Format(Date, "yyyy-mm-dd")
    tx_ldrq.Text = Format(Date + 2, "yyyy-mm-dd")
    tx_ldrq.Enabled = True

    Call PUB_GetZKMC(cm_zkmc)
    
    If cm_zkmc.ListCount <> 0 Then
        tx_zklx.Text = LoadResString(SYS_SKLX)
        cm_zkmc.Text = LoadResString(SYS_SKMC)
    End If
    
End Sub




Private Sub tx_fls_GotFocus(Index As Integer)
    tx_fls(Index).SelStart = 0
    tx_fls(Index).SelLength = Len(Trim(tx_fls(Index).Text))
End Sub


'***********************************************************************
'* 功    能 : 判断输入房类数的正确性
'* 作 成 者 : 梁 卫
'* 生成日期 : 1999.03.04
'* 修改日期 : 1999.03.04
'***********************************************************************
Private Sub tx_fls_LostFocus(Index As Integer)
    frm_msg.Visible = False
    frm_msg.Caption = ""
    
    If Trim(tx_fls(Index).Text) = "" Then
        tx_fls(Index).Text = 0
    Else
        If IsNumeric(tx_fls(Index).Text) Then
            If CDec(tx_fls(Index).Text) >= 0 Then
                tx_fls(Index).Text = Int(tx_fls(Index).Text)
            Else
                tx_fls(Index).Text = 0
            End If
        Else
            tx_fls(Index).Text = 0
        End If
    End If
End Sub


Private Sub tx_ldrq_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case vbKeyUp
        tx_rs.SetFocus
    Case vbKeyReturn, vbKeyDown
        If SYS_LXN <> 0 Then
            tx_fls(1).SetFocus
        Else
            cmd_ok(0).SetFocus
        End If
    End Select

End Sub

'***********************************************************************
'* 功    能 : 判断离店日期的正确性
'* 作 成 者 : 梁 卫
'* 生成日期 : 1999.03.05
'* 修改日期 : 1999.03.05
'***********************************************************************
Private Sub tx_ldrq_LostFocus()
    Dim t_RT As Boolean
    
    frm_msg.Visible = False
    frm_msg.Caption = ""
    
    t_RT = False
    
    If Len(Trim(tx_ldrq.Text)) = 10 Then
        If IsDate(tx_ldrq.Text) Then
            If CDate(tx_ldrq.Text) >= CDate(lb_rzrq.Caption) Then
                t_RT = True
            End If
        End If
    End If
    
    If Not t_RT Then
        frm_msg.Visible = True
        frm_msg.Caption = "不适当的离店日期"
        tx_ldrq.SetFocus
    End If
End Sub

Private Sub tx_rs_GotFocus()
    tx_rs.SelStart = 0
    tx_rs.SelLength = Len(Trim(tx_rs.Text))
End Sub

Private Sub tx_rs_KeyDown(KeyCode As MSForms.ReturnInteger, Shift As Integer)
    Select Case KeyCode
    Case vbKeyReturn, vbKeyDown
        If tx_ldrq.Enabled Then
            tx_ldrq.SetFocus
        Else
            tx_fls(1).SetFocus
        End If
    End Select
End Sub

'***********************************************************************
'* 功    能 : 判断入住人数
'* 作 成 者 : 梁 卫
'* 生成日期 : 1999.03.04
'* 修改日期 : 1999.03.04
'***********************************************************************
Private Sub tx_rs_LostFocus()
    Dim t_RT As Boolean
    
    frm_msg.Visible = False
    frm_msg.Caption = ""
    
    t_RT = True
    
    If Trim(tx_rs.Text) = "" Then
        tx_rs.Text = 1
    Else
        If IsNumeric(tx_rs.Text) Then
            If CDec(tx_rs.Text) >= 0 Then
                tx_rs.Text = Int(tx_rs.Text)
                t_RT = True
            Else
                t_RT = False
            End If
        Else
            tx_rs.Text = 1
        End If
    End If
    
    If Not t_RT Then
        frm_msg.Visible = True
        frm_msg.Caption = "不适当的人数"
    End If

End Sub




Private Sub tx_tdh_GotFocus()
    tx_tdh.SelStart = 0
    tx_tdh.SelLength = Len(Trim(tx_tdh.Text))
End Sub

Private Sub tx_tdh_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        cm_tdmc.SetFocus
    End If
End Sub

'**************************************************************************************************
'*  功    能 :
'*  作    者 : 梁卫
'*  作成日期 : 1999.03.09
'*  修改日期 : 1999.03.09
'**************************************************************************************************
Private Sub tx_tdh_LostFocus()
    tx_tdh.Text = UCase(Trim(tx_tdh.Text))
    Call PUB_DMLostFocus(tx_tdh, cm_tdmc, frm_msg, "不适当的团队信息")
    
End Sub

'***********************************************************************
'* 功    能 : 若为"团队",则输入团队号
'* 作 成 者 : 梁 卫
'* 生成日期 : 1999.03.04
'* 修改日期 : 1999.03.04
'***********************************************************************
Private Sub cm_zkmc_LostFocus()
    Dim temp_rt As Boolean
    temp_rt = False
    
    frm_msg.Visible = False
    frm_msg.Caption = ""
    
    If Trim(cm_zkmc.Text) = "" Then
    Else
        For i = 0 To cm_zkmc.ListCount - 1
            If Trim(cm_zkmc.Text) = Trim(cm_zkmc.List(i, 1)) Then
                temp_rt = True
            End If
        Next i
    End If
    
    If temp_rt Then
        If tx_zklx = LoadResString(SYS_TDLX) Then
            Call PUB_GetCMDB(PUB_data, cm_tdmc, "DT_TDQD", "ZH", "TDMC")
            
            If cm_tdmc.ListCount = 0 Then
                frm_msg.Visible = True
                frm_msg.Caption = "无团队住客, 请修改住客类型"
                cm_zkmc.SetFocus
                Exit Sub
            Else
                tx_tdh.Text = ""
                cm_tdmc.Text = ""
                fm_tdxx.Visible = True
                tx_tdh.SetFocus
            End If
        Else
            fm_tdxx.Visible = False
            tx_rs.SetFocus
        End If
    Else
        cm_zkmc.Text = LoadResString(SYS_SKLX)
        tx_zklx.Text = LoadResString(SYS_SKMC)
    End If
            
    If tx_zklx = LoadResString(SYS_TDLX) Then
        tx_ldrq.Enabled = False
    Else
        tx_ldrq.Enabled = True
    End If
End Sub


'**************************************************************************************************
'*  功    能 :
'*  作    者 : 梁卫
'*  作成日期 : 1999.03.09
'*  修改日期 : 1999.03.09
'**************************************************************************************************
Private Sub cm_tdmc_LostFocus()
    Dim temp_ft As Boolean
    Dim temp_rt As Boolean
    Dim t_rec As Recordset
                
    frm_msg.Visible = False
    frm_msg.Caption = ""
    
    temp_ft = True
    temp_rt = PUB_MCLostFocus(tx_tdh, cm_tdmc, frm_msg, "不适当的团队信息")
    If temp_rt Then
        '住客为团队类型时, 判断团队帐号
        If Trim(tx_tdh.Text) = "" Then
            temp_ft = False
        Else
            Set t_rec = PUB_data.OpenRecordset("SELECT ZH,TDMC,LDRQ FROM DT_TDQD WHERE TRIM(ZH)='" & Trim(tx_tdh.Text) & "'", 4, 0, 2)
            If Not t_rec.BOF Then
                t_rec.MoveLast
                tx_ldrq.Text = Format(t_rec.Fields("LDRQ"), "yyyy-mm-dd")
                tx_rs.SetFocus
            Else
                temp_ft = False
            End If
            t_rec.Close
        End If
    End If

    If Not temp_ft Or Not temp_rt Then
        frm_msg.Visible = True
        frm_msg.Caption = "请选择正确的团队信息"
        cm_tdmc.SetFocus
    End If
End Sub

'**************************************************************************************************
'*  功    能 :
'*  作    者 : 梁卫
'*  作成日期 : 1999.03.09
'*  修改日期 : 1999.03.09
'**************************************************************************************************
Private Sub cm_tdmc_Click()
    tx_tdh.Text = cm_tdmc.List(cm_tdmc.ListIndex, 0)
    cm_tdmc.Text = cm_tdmc.List(cm_tdmc.ListIndex, 1)
End Sub