dt_tfdj.frm

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

Option Explicit




Private Sub CCMD1_Click(Index As Integer)
    Dim temp_i As Integer
    Dim tdqd_rec As Recordset  'DT_TDQD
    Dim zy_rec As Recordset
    Dim temp_lsh As Integer
    Dim temp_fls As Variant
    Dim temp_zh As String
    
    Select Case Index
    Case 0
        Dim temp_ok As Boolean
        Dim LOCK_REC As Recordset
        Dim t_czlsh As String
        Dim t_tools As New HOTEL_TOOL.HOTEL_TOOLS
        
        ReDim temp_fls(SYS_LXN + 1) As Integer
        For temp_i = 1 To SYS_LXN
            temp_fls(temp_i) = 0
        Next
        
        For temp_i = 1 To SYS_LXN
            temp_fls(temp_i) = CInt(m_kr_fls(temp_i).Text) + CInt(m_qp_fls(temp_i).Text) + CInt(m_dp_fls(temp_i).Text)
        Next
        
        If Pub_free(CDate(m_rzrq.Text), CDate(m_ldrq.Text), temp_fls, LoadResString(SYS_TDLX), pub_code) Then
            
            Set LOCK_REC = PUB_data.OpenRecordset("select * from SYS_LOCK", 2, 0, 2)
            If Not LOCK_REC.BOF Then
               LOCK_REC.MoveLast
               LOCK_REC.MoveFirst
            End If
            LOCK_REC.FindFirst "TRIM(TABLENAME)='DT_TDQD'"
            Do While LOCK_REC!CZY <> SYS_USER
               If LOCK_REC!CZY = "***" Then
                  LOCK_REC.Edit
                    LOCK_REC!CZY = SYS_USER
                  LOCK_REC.Update
               Else
                  Call t_tools.pub_msg("团队清单正被其他人使用，请稍后")
                  LOCK_REC.Requery
                  If Not LOCK_REC.BOF Then
                       LOCK_REC.MoveLast
                       LOCK_REC.MoveFirst
                  End If
                  LOCK_REC.FindFirst "TRIM(TABLENAME)='DT_TDQD'"
               End If
            Loop
    
            temp_lsh = 1001
            temp_ok = False
            Set tdqd_rec = PUB_data.OpenRecordset("SELECT * FROM DT_TDQD", 2, 0, 2)
            If Not tdqd_rec.BOF Then
                tdqd_rec.MoveLast
                
                '生成团队号
                Do While True
                    tdqd_rec.FindFirst "TRIM(ZH)='" & SYS_TD & Mid(Trim(Str(temp_lsh)), 2, 3) & "'"
                    If Not tdqd_rec.NoMatch Then
                        temp_lsh = temp_lsh + 1
                        If temp_lsh > 1999 Then
                            temp_ok = False
                            Exit Do
                        End If
                    Else
                        temp_ok = True
                        Exit Do
                    End If
                Loop
            Else
                temp_ok = True
            End If
            
            If Not temp_ok Then
                LOCK_REC.Edit
                LOCK_REC!CZY = "***"
                LOCK_REC.Update
                LOCK_REC.Close
                Call MsgBox("团队号已经超出系统所能承受的范围, 请与微机室人员联系!")
            Else
                t_czlsh = Pub_czls(PUB_data, "DT_TFDJ", Time(), pub_code)
                tdqd_rec.AddNew
                    temp_zh = Trim(SYS_TD & Mid(Trim(Str(temp_lsh)), 2, 3))
                    tdqd_rec.Fields("ZH") = temp_zh
                    tdqd_rec.Fields("TDMC") = "*"
                    tdqd_rec.Fields("VIP_MC") = "*"
                    tdqd_rec.Fields("RZRQ") = CDate(m_rzrq.Text)
                    tdqd_rec.Fields("RZSJ") = Time()
                    tdqd_rec.Fields("LDRQ") = CDate(m_ldrq.Text)
                    tdqd_rec.Fields("KR_FL_S") = PUB_JOIN(m_kr_fls, 3, pub_code)
                    tdqd_rec.Fields("QP_FL_S") = PUB_JOIN(m_qp_fls, 3, pub_code)
                    tdqd_rec.Fields("DP_FL_S") = PUB_JOIN(m_dp_fls, 3, pub_code)
                    For temp_i = 1 To SYS_LXN
                        tdqd_rec.Fields("DF_LX" & Trim(Str(temp_i))) = temp_fls(temp_i)
                    Next
                    tdqd_rec.Fields("DF_JS") = 0
                    For temp_i = 1 To SYS_LXN
                        tdqd_rec.Fields("DF_JS") = tdqd_rec.Fields("DF_JS") + CInt(m_kr_fls(temp_i).Text) + CInt(m_qp_fls(temp_i).Text) + CInt(m_dp_fls(temp_i).Text)
                    Next
                    tdqd_rec.Fields("CZY") = SYS_USER
                    tdqd_rec.Fields("DFY_DM") = Trim(m_dfy_dm.Text)
                    
                    tdqd_rec.Fields("GJDM") = "*"
                    tdqd_rec.Fields("GJMC") = "*"
                    tdqd_rec.Fields("YJ_FT") = "0"
                    tdqd_rec.Fields("TSFW") = "*"
                    tdqd_rec.Fields("KR_DJ") = 0
                    tdqd_rec.Fields("ZXFE") = 0
                    tdqd_rec.Fields("YE") = 0
                    tdqd_rec.Fields("KF_FZ") = 0
                    tdqd_rec.Fields("KF_FWF") = 0
                    tdqd_rec.Fields("ZKL") = 1
                    tdqd_rec.Fields("YDD_H") = "*"
                    tdqd_rec.Fields("YDBC") = "*"
                    tdqd_rec.Fields("YLBC") = "*"
                    tdqd_rec.Fields("LDSJ") = "  :  :  "
                    tdqd_rec.Fields("SHXL_SJ") = "  :  :  "
                    tdqd_rec.Fields("MFZC_FT") = "0"
                    tdqd_rec.Fields("ZCK_BZ") = 0
                    tdqd_rec.Fields("JSR") = "*"
                    tdqd_rec.Fields("RS") = 0
                    tdqd_rec.Fields("BDJDDW_MC") = "*"
                    tdqd_rec.Fields("MF_FJS") = 0
                    tdqd_rec.Fields("QDP_RS") = 0
                    tdqd_rec.Fields("KR_FL_J") = String(60, "0")
                    tdqd_rec.Fields("QP_FL_J") = String(60, "0")
                    tdqd_rec.Fields("DP_FL_J") = String(60, "0")
                    tdqd_rec.Fields("YJBL") = 0
                    tdqd_rec.Fields("JDY") = "*"
                    tdqd_rec.Fields("FKDW") = "*"
                    tdqd_rec.Fields("FKZH") = "*"
                    tdqd_rec.Fields("KHDM") = "*"
                    tdqd_rec.Fields("YWDW_MC") = "*"
                    tdqd_rec.Fields("BZ") = "*"
                    tdqd_rec.Fields("LOCK_NO") = 0
                    
                tdqd_rec.Update
                LOCK_REC.Edit
                LOCK_REC!CZY = "***"
                LOCK_REC.Update
                LOCK_REC.Close
                
                Call Pub_kftj(Date, CDate(m_ldrq.Text), temp_fls, Date, CDate(m_ldrq.Text), temp_fls, LoadResString(SYS_TDLX), pub_code)
                               
'????                Set zy_rec = PUB_data.OpenRecordset("SELECT * FROM W" & Trim(SYS_TD & Mid(Trim(Str(temp_lsh)), 2, 3)), 2, 0, 2)
'????                If Not zy_rec.BOF Then
'????                    zy_rec.MoveLast
'????                    zy_rec.MoveFirst
'????                    '????把余下的帐页归档
'????                End If
'????                zy_rec.Close
                               
                Call dt_tddj.MAIN(Trim(SYS_TD & Mid(Trim(Str(temp_lsh)), 2, 3)), pub_code)
                dt_tddj.Show (1)
                
                Call Pub_czle(PUB_data, t_czlsh, "团队无预订登记, 团队号: " & Trim(SYS_TD & Mid(Trim(Str(temp_lsh)), 2, 3)), Time(), pub_code)
                dt_tdgl.tx_bjRT = 1
            End If
            tdqd_rec.Close
            
        Else
            Call t_tools.PUB_SYKF(PUB_data, CDate(m_rzrq.Text), CDate(m_ldrq.Text), temp_fls, SYS_LXN, SYS_LXC, SYS_Yl, pub_code)
        End If
            
    Case 1
        dt_tdgl.tx_bjRT = 0
    End Select
    Unload Me
End Sub

Private Sub Form_Activate()
    m_ldrq.SetFocus
End Sub

Private Sub Form_Load()
    Dim temp_i As Integer
    
    pub_code = Left(Pub_getcode(PUB_data, "DT_TFDJ"), 5)
    KeyPreview = True
    
    m_rzrq.Text = Date
    m_ldrq.Text = Date + 2
    
    For temp_i = 1 To SYS_LXN
        m_kr_fls(temp_i).Text = 0
        m_qp_fls(temp_i).Text = 0
        m_dp_fls(temp_i).Text = 0
    Next
    m_dfy_dm.Text = ""
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then
        Unload Me
    End If
End Sub



Private Sub m_dfy_dm_GotFocus()
    m_dfy_dm.SelStart = 0
    m_dfy_dm.SelLength = Len(Trim(m_dfy_dm.Text))
End Sub

Private Sub m_dfy_dm_LostFocus()
    frm_msg.Caption = ""
    If Trim(m_dfy_dm.Text) = "" Or Trim(m_dfy_dm.Text) = "*" Then
        frm_msg.Caption = "请输入订房员代码"
        m_dfy_dm.SetFocus
    End If
End Sub

Private Sub m_kr_fls_Change(Index As Integer)
    frm_msg.Caption = ""
End Sub


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

Private Sub m_kr_fls_KeyDown(Index As Integer, KeyCode As MSForms.ReturnInteger, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        If Index < SYS_LXN Then
            m_kr_fls(Index + 1).SetFocus
        Else
            m_qp_fls(1).SetFocus
        End If
    End If
End Sub

Private Sub m_kr_fls_LostFocus(Index As Integer)
    If Not PUB_SZJY(m_kr_fls(Index), frm_msg) Then
        m_kr_fls(Index).Text = "0"
    End If
End Sub


Private Sub m_qp_fls_Change(Index As Integer)
    frm_msg.Caption = ""
End Sub


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

Private Sub m_qp_fls_KeyDown(Index As Integer, KeyCode As MSForms.ReturnInteger, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        If Index < SYS_LXN Then
            m_qp_fls(Index + 1).SetFocus
        Else
            m_dp_fls(1).SetFocus
        End If
    End If
End Sub

Private Sub m_qp_fls_LostFocus(Index As Integer)
    If Not PUB_SZJY(m_qp_fls(Index), frm_msg) Then
        m_qp_fls(Index).Text = "0"
    End If
End Sub


Private Sub m_dp_fls_Change(Index As Integer)
    frm_msg.Caption = ""
End Sub


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


Private Sub m_dp_fls_KeyDown(Index As Integer, KeyCode As MSForms.ReturnInteger, Shift As Integer)
    If KeyCode = vbKeyReturn Then
        If Index < SYS_LXN Then
            m_dp_fls(Index + 1).SetFocus
        Else
            m_dfy_dm.SetFocus
        End If
    End If
End Sub

Private Sub m_dp_fls_LostFocus(Index As Integer)
    If Not PUB_SZJY(m_dp_fls(Index), frm_msg) Then
        m_dp_fls(Index).Text = "0"
    End If
End Sub

Private Sub m_ldrq_Change()
    frm_msg.Caption = ""
End Sub

Private Sub m_ldrq_GotFocus()
    m_ldrq.SelStart = 0
    m_ldrq.SelLength = Len(Trim(m_ldrq.Text))
End Sub

Private Sub m_ldrq_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyReturn Or KeyCode = vbKeyDown Then
        m_kr_fls(1).SetFocus
    End If
End Sub

Private Sub m_ldrq_LostFocus()
    Dim temp_ft As Boolean
    
    temp_ft = False
    If PUB_RQJY(m_ldrq, frm_msg) Then
        If m_ldrq.Text = "    -  -  " Or m_ldrq.Text = "    -  -  " Then
        Else
            If CDate(m_ldrq.Text) > CDate(m_rzrq.Text) Then
                temp_ft = True
            End If
        End If
    End If
    
    If Not temp_ft Then
        frm_msg.Caption = "无效日期!"
        m_ldrq.SetFocus
    End If
End Sub