dt_tddf.frm

一个简单的酒店管理系统 用VB.net+SQL2000实现

         TabIndex        =   17
         Top             =   720
         Width           =   945
      End
   End
   Begin VB.Label Label10 
      AutoSize        =   -1  'True
      ForeColor       =   &H00FF8080&
      Height          =   180
      Left            =   4440
      TabIndex        =   20
      Top             =   600
      Width           =   1890
   End
   Begin VB.Label frm_msg 
      AutoSize        =   -1  'True
      ForeColor       =   &H00FF0000&
      Height          =   300
      Left            =   5040
      TabIndex        =   21
      Top             =   60
      Width           =   2400
   End
End
Attribute VB_Name = "dt_tddf"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit


Private Sub CCMD1_Click(Index As Integer)
    Dim temp_i As Integer
    Dim tdqd_rec As Recordset  'DT_TDQD
    Dim temp_lsh As Integer
    Dim temp_fls As Variant
    Select Case Index
    Case 0
        Dim temp_ok As Boolean
        Dim LOCK_REC As Recordset
        
        ReDim temp_fls(SYS_LXN + 1)
        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
            t_czlsh = Pub_czls(PUB_data, "DT_TFDJ", Time(), pub_code)
            
            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
                  e = True
               Else
                  Call t.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 tdqd_rec.NoMatch Then
                        temp_lsh = temp_lsh + 1
                        If temp_lsh > 1999 Then
                            Call MsgBox("团队号已经超出系统所能承受的范围")
                            temp_ok = False
                            Exit Do
                        End If
                    Else
                        temp_ok = True
                        Exit Do
                    End If
                Loop
            Else
                temp_ok = True
            End If
            
            If temp_ok Then
                tdqd_rec.AddNew
                    tdqd_rec.Fields("ZH") = Trim(SYS_TD & Mid(Trim(Str(temp_lsh)), 2, 3))
                    tdqd_rec.Fields("RZRQ") = CDate(m_rzrq.Text)
                    tdqd_rec.Fields("LDRQ") = CDate(m_ldrq.Text)
                    tdqd_rec.Fields("KR_FL_S") = PUB_JOIN(m_kr_fls, 3, CS_code)
                    tdqd_rec.Fields("QP_FL_S") = PUB_JOIN(m_qp_fls, 3, CS_code)
                    tdqd_rec.Fields("DP_FL_S") = PUB_JOIN(m_dp_fls, 3, CS_code)
                    For temp_i = 1 To SYS_LXN
                        tdqd_rec.Fields("DF_LX" & Trim(Str(temp_i))) = 1
                    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.Update
            End If
            tdqd_rec.Close
            
            LOCK_REC.Edit
            LOCK_REC!CZY = "***"
            LOCK_REC.Update
            LOCK_REC.Close
            
            
            Call Pub_czle(PUB_data, t_czlsh, "团队无预订登记, 团队号: " & Trim(SYS_TD & Mid(Trim(Str(temp_lsh)), 2, 3)), Time(), pub_code)
        End If
            
    Case 1
    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 + 1
    
    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
    
End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then
        CS_rt = False
        Unload Me
    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 Trim(m_kr_fls(Index).Text) = "" Then
        If Not IsNumeric(Trim(m_kr_fls(Index).Text)) Then
            frm_msg.Caption = "无效房间数!"
            m_kr_fls(Index).SetFocus
        Else
        End If
    Else
        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 Trim(m_qp_fls(Index).Text) = "" Then
        If Not IsNumeric(Trim(m_qp_fls(Index).Text)) Then
            frm_msg.Caption = "无效房间数!"
            m_qp_fls(Index).SetFocus
        Else
        End If
    Else
        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
            CCMD1(0).SetFocus
        End If
    End If
End Sub

Private Sub m_dp_fls_LostFocus(Index As Integer)
    If Not Trim(m_dp_fls(Index).Text) = "" Then
        If Not IsNumeric(Trim(m_dp_fls(Index).Text)) Then
            frm_msg.Caption = "无效房间数!"
            m_dp_fls(Index).SetFocus
        Else
        End If
    Else
        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 Not Trim(m_ldrq.Text) = "____-__-__" Then
        If PUB_RQJY(m_ldrq, frm_msg) Then
            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