dfht_pop.frm

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

            i = i + 1
        Loop
    End If
End Sub

Private Sub CMD1_Click()
    Select Case STY
    Case "0"  '增加
            '生成订房合同单号
            Set rec = YX_data.OpenRecordset("SELECT RQ,DFHT_NO,LOCK_NO FROM NO WHERE CSTR(RQ)='" & Date & "'", 2, 0, 2)
            If Not rec.BOF Then
                rec.MoveLast
                '加锁
                Do
                    Select Case Pub_lock("YX", "NO", rec)  '判断加锁结果
                        Case "1"
                            Exit Do
                        Case "2"
                            Call Pub_UNlock("NO", rec)
                            Exit Sub
                    End Select
                Loop
                rec.Edit
                    rec!DFHT_NO = rec!DFHT_NO + 1
                rec.Update
            End If
            
            Set t_rec = YX_data.OpenRecordset("select HTDM,YFDW,YFDB,HTYXQ,HTQSRQ,YF_LXR,YF_LXDH,WJ_TD_FZ,WJ_SK_FZ,DJ_TD_FZ,DJ_SK_FZ,ZC,WC,YC,BZ,JFDB,JS_FS,YHSM,CZY,LOCK_NO from YX_DFHT", 2, 0, 2)
            If Not t_rec.BOF Then
                t_rec.MoveLast
            End If
                With t_rec
                .AddNew
                    !HTDM = "DF" & CStr(Format(Date, "yyyymmdd")) & Right("0" & CStr(rec!DFHT_NO), 2)
                    !YFDW = IIf(Trim(m_yfdw.Text) = "", "*", Trim(UCase(m_yfdw.Text)))
                    !YFDB = IIf(Trim(m_yfdb.Text) = "", "*", UCase(Trim(m_yfdb.Text)))
                    !HTYXQ = CDate(m_htyxq.Text)
                    !HTQSRQ = CDate(m_htqsrq.Text)
                    !YF_LXR = IIf(Trim(m_yf_lxr.Text) = "", "*", UCase(Trim(m_yf_lxr.Text)))
                    !YF_LXDH = IIf(Trim(m_yf_lxdh.Text) = "", "*", UCase(Trim(m_yf_lxdh.Text)))
                    !WJ_TD_FZ = CDec(Trim(m_wj_td_fz.Text))
                    !WJ_SK_FZ = CDec(Trim(m_wj_sk_fz.Text))
                    !DJ_TD_FZ = CDec(Trim(m_dj_td_fz.Text))
                    !DJ_SK_FZ = CDec(Trim(m_dj_sk_fz.Text))
                    !ZC = IIf(Trim(UCase(m_zc.Text)) = "", "*", Trim(UCase(m_zc.Text)))
                    !WC = IIf(Trim(UCase(m_wc.Text)) = "", "*", Trim(UCase(m_wc.Text)))
                    !YC = IIf(Trim(UCase(m_yc.Text)) = "", "*", Trim(UCase(m_yc.Text)))
                    !BZ = IIf(Trim(m_bz) = "", "*", UCase(Trim(m_bz.Text)))
                    !JFDB = IIf(Trim(m_jfdb.Text) = "", "*", UCase(Trim(m_jfdb.Text)))
                    !JS_FS = IIf(Trim(m_js_fs.Text) = "", "*", UCase(Trim(m_js_fs.Text)))
                    !YHSM = IIf(Trim(m_yhsm.Text) = "", "*", UCase(Trim(m_yhsm.Text)))
                    !CZY = SYS_USER
                    !lock_no = 0
                    Dim t_ddh As String
                    t_ddh = t_rec!HTDM
                .Update
                End With
                Call Pub_UNlock("NO", rec)
                t_f = True
                MsgBox "订房合同成功建立!合同编号:" & t_ddh, vbOKOnly
                Unload Me
     Case "1"    '修改
        Set t_rec3 = YX_data.OpenRecordset("select HTDM,YFDW,YFDB,HTYXQ,HTQSRQ,YF_LXR,YF_LXDH,WJ_TD_FZ,WJ_SK_FZ,DJ_TD_FZ,DJ_SK_FZ,ZC,WC,YC,BZ,JFDB,JS_FS,YHSM,CZY,LOCK_NO from YX_DFHT where HTDM='" & UCase(Trim(m_htdm.Text)) & "'", 2, 0, 2)
           If Not t_rec3.BOF Then
                   t_rec3.MoveLast
                   '加锁
                       Do
                           Select Case Pub_lock("YX", "YX_DFHT", t_rec3)  '判断加锁结果
                               Case "1" '锁定
                                   Exit Do
                               Case "2"  '
                                   Call Pub_UNlock("YX_DFHT", t_rec3)
                                   Exit Sub
                           End Select
                       Loop
                       With t_rec3
                        .Edit
                            !YFDW = IIf(Trim(m_yfdw.Text) = "", "*", Trim(UCase(m_yfdw.Text)))
                            !YFDB = IIf(Trim(m_yfdb.Text) = "", "*", UCase(Trim(m_yfdb.Text)))
                            !HTYXQ = CDate(m_htyxq.Text)
                            !HTQSRQ = CDate(m_htqsrq.Text)
                            !YF_LXR = IIf(Trim(m_yf_lxr.Text) = "", "*", UCase(Trim(m_yf_lxr.Text)))
                            !YF_LXDH = IIf(Trim(m_yf_lxdh.Text) = "", "*", UCase(Trim(m_yf_lxdh.Text)))
                            !WJ_TD_FZ = CDec(Trim(m_wj_td_fz.Text))
                            !WJ_SK_FZ = CDec(Trim(m_wj_sk_fz.Text))
                            !DJ_TD_FZ = CDec(Trim(m_dj_td_fz.Text))
                            !DJ_SK_FZ = CDec(Trim(m_dj_sk_fz.Text))
                            !ZC = IIf(Trim(UCase(m_zc.Text)) = "", "*", Trim(UCase(m_zc.Text)))
                            !WC = IIf(Trim(UCase(m_wc.Text)) = "", "*", Trim(UCase(m_wc.Text)))
                            !YC = IIf(Trim(UCase(m_yc.Text)) = "", "*", Trim(UCase(m_yc.Text)))
                            !BZ = IIf(Trim(m_bz) = "", "*", UCase(Trim(m_bz.Text)))
                            !JFDB = IIf(Trim(m_jfdb.Text) = "", "*", UCase(Trim(m_jfdb.Text)))
                            !JS_FS = IIf(Trim(m_js_fs.Text) = "", "*", UCase(Trim(m_js_fs.Text)))
                            !YHSM = IIf(Trim(m_yhsm.Text) = "", "*", UCase(Trim(m_yhsm.Text)))
                            !CZY = SYS_USER
                        .Update
                        End With
                       '解锁
                       Call Pub_UNlock("YX_DFHT", t_rec3)
                       t_f = True
                       Unload Me
                  End If
    End Select
End Sub


Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then
        Call Cmd2_Click
    End If
End Sub
Private Sub m_bz_GotFocus()
    m_bz.SelStart = 0
    m_bz.SelLength = Len(Trim(m_bz.Text))
End Sub

Private Sub m_bz_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        m_jfdb.SetFocus
    End If
End Sub


Private Sub Cmd2_Click()
    Unload Me
    ht_dfgl.Enabled = True

End Sub



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

Private Sub m_dj_sk_fz_GotFocus()
    m_dj_sk_fz.SelStart = 0
    m_dj_sk_fz.SelLength = Len(Trim(m_dj_sk_fz.Text))
End Sub

Private Sub m_dj_sk_fz_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        Call m_dj_sk_fz_LostFocus
    End If
End Sub

Private Sub m_dj_sk_fz_LostFocus()
    If Not m_dj_sk_fz.Text = "" Then
        If Not IsNumeric(Trim(m_dj_sk_fz.Text)) Then
            frm_msg.Caption = "无效房租!"
            m_dj_sk_fz.SetFocus
            m_dj_sk_fz.SelStart = 0
            m_dj_sk_fz.SelLength = Len(Trim(m_dj_sk_fz.Text))
            Else
            m_zc.SetFocus
        End If
    Else
        m_dj_sk_fz.Text = "0"
        m_zc.SetFocus
    End If
End Sub

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

Private Sub m_dj_td_fz_GotFocus()
    m_dj_td_fz.SelStart = 0
    m_dj_td_fz.SelLength = Len(Trim(m_dj_td_fz.Text))
End Sub

Private Sub m_dj_td_fz_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        Call m_dj_td_fz_LostFocus
    End If
End Sub

Private Sub m_dj_td_fz_LostFocus()
    If Not m_dj_td_fz.Text = "" Then
        If Not IsNumeric(Trim(m_dj_td_fz.Text)) Then
            frm_msg.Caption = "无效房租!"
            m_dj_td_fz.SetFocus
            m_dj_td_fz.SelStart = 0
            m_dj_td_fz.SelLength = Len(Trim(m_dj_td_fz.Text))
        Else
            m_dj_sk_fz.SetFocus
        End If
    Else
        m_dj_td_fz.Text = "0"
        m_dj_sk_fz.SetFocus
    End If
End Sub

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

Private Sub m_htdm_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        Call m_htdm_LostFocus
    End If
End Sub

Private Sub m_htdm_LostFocus()
     If Not m_htdm.Text = "" Then
         Select Case STY
            Case "1"     '修改
                Set t_rec2 = YX_data.OpenRecordset("select HTDM,YFDW,YFDB,HTYXQ,HTQSRQ,YF_LXR,YF_LXDH,WJ_TD_FZ,WJ_SK_FZ,DJ_TD_FZ,DJ_SK_FZ,ZC,WC,YC,BZ,JFDB,JS_FS,YHSM,CZY,LOCK_NO from YX_DFHT WHERE  TRIM(HTDM)='" & UCase(Trim(m_htdm.Text)) & "'", 4)
                If Not t_rec2.BOF Then
                    t_rec2.MoveLast
                        If Trim(t_rec2!YFDW) <> "*" Then
                            m_yfdw.Text = Trim(t_rec2!YFDW)
                        End If
                        
                        If Trim(t_rec2!YFDB) <> "*" Then
                            m_yfdb.Text = Trim(t_rec2!YFDB)
                        End If
                        m_htyxq.Text = Format(t_rec2!HTYXQ, "yyyy-mm-dd")
                        m_htqsrq.Text = Format(t_rec2!HTQSRQ, "yyyy-mm-dd")
                        
                        If Trim(t_rec2!YF_LXR) <> "*" Then
                            m_yf_lxr.Text = Trim(t_rec2!YF_LXR)
                        End If
                        
                        If Trim(t_rec2!YF_LXDH) <> "*" Then
                            m_yf_lxdh.Text = Trim(t_rec2!YF_LXDH)
                        End If
                        
                        m_wj_td_fz.Text = Trim(t_rec2!WJ_TD_FZ)
                        m_wj_sk_fz.Text = Trim(t_rec2!WJ_SK_FZ)
                        m_dj_td_fz.Text = Trim(t_rec2!DJ_TD_FZ)
                        m_dj_sk_fz.Text = Trim(t_rec2!DJ_SK_FZ)
                        
                        If Trim(t_rec2!ZC) <> "*" Then
                            m_zc.Text = Trim(t_rec2!ZC)
                        End If
                        
                        If Trim(t_rec2!WC) <> "*" Then
                            m_wc.Text = Trim(t_rec2!WC)
                        End If
                        
                        If Trim(t_rec2!YC) <> "*" Then
                            m_yc.Text = Trim(t_rec2!YC)
                        End If
                        
                        If Trim(t_rec2!BZ) <> "*" Then
                            m_bz.Text = Trim(t_rec2!BZ)
                        End If
                        
                        If Trim(t_rec2!JFDB) <> "*" Then
                            m_jfdb.Text = Trim(t_rec2!JFDB)
                        End If
                        
                        If Not Trim(t_rec2!JS_FS) = "*" Then
                            m_js_fs.Text = Trim(t_rec2!JS_FS)
                        End If
                        If Trim(t_rec2!YHSM) <> "*" Then
                            m_yhsm.Text = Trim(t_rec2!YHSM)
                        End If
                        
                        m_yfdw.Enabled = True
                        m_yfdb.Enabled = True
                        m_yf_lxr.Enabled = True
                        m_yf_lxdh.Enabled = True
                        m_wj_td_fz.Enabled = True
                        m_wj_sk_fz.Enabled = True
                        m_dj_td_fz.Enabled = True
                        m_dj_sk_fz.Enabled = True
                        m_zc.Enabled = True
                        m_wc.Enabled = True
                        m_yc.Enabled = True
                        m_bz.Enabled = True
                        m_jfdb.Enabled = True
                        m_yhsm.Enabled = True
                        m_htyxq.Enabled = True
                        m_htqsrq.Enabled = True
                        m_yfdw.SetFocus
                        m_yfdw.SelStart = 0
                        m_yfdw.SelLength = Len(Trim(m_yfdw.Text))
                        Exit Sub
                Else
                    frm_msg.Caption = "此合同编码不存在!"
                    m_htdm.SetFocus
                    Exit Sub
                End If
            Case "5"     '查询
                Set t_rec2 = YX_data.OpenRecordset("select HTDM,YFDW,YFDB,HTYXQ,HTQSRQ,YF_LXR,YF_LXDH,WJ_TD_FZ,WJ_SK_FZ,DJ_TD_FZ,DJ_SK_FZ,ZC,WC,YC,BZ,JFDB,JS_FS,YHSM,CZY,LOCK_NO from YX_DFHT", 4)
                If Not t_rec2.BOF Then
                        t_rec2.MoveLast
                        If Trim(t_rec2!YFDW) <> "*" Then
                            m_yfdw.Text = Trim(t_rec2!YFDW)
                        End If
                        
                        If Trim(t_rec2!YFDB) <> "*" Then
                            m_yfdb.Text = Trim(t_rec2!YFDB)
                        End If
                        m_htyxq.Text = Format(t_rec2!HTYXQ, "yyyy-mm-dd")
                        m_htqsrq.Text = Format(t_rec2!HTQSRQ, "yyyy-mm-dd")
                        
                        If Trim(t_rec2!YF_LXR) <> "*" Then
                            m_yf_lxr.Text = Trim(t_rec2!YF_LXR)
                        End If
                        
                        If Trim(t_rec2!YF_LXDH) <> "*" Then
                            m_yf_lxdh.Text = Trim(t_rec2!YF_LXDH)
                        End If
                        
                        m_wj_td_fz.Text = Trim(t_rec2!WJ_TD_FZ)
                        m_wj_sk_fz.Text = Trim(t_rec2!WJ_SK_FZ)
                        m_dj_td_fz.Text = Trim(t_rec2!DJ_TD_FZ)
                        m_dj_sk_fz.Text = Trim(t_rec2!DJ_SK_FZ)
                        
                        If Trim(t_rec2!ZC) <> "*" Then
                            m_zc.Text = Trim(t_rec2!ZC)
                        End If
                        
                        If Trim(t_rec2!WC) <> "*" Then
                            m_wc.Text = Trim(t_rec2!WC)
                        End If
                        
                        If Trim(t_rec2!YC) <> "*" Then
                            m_yc.Text = Trim(t_rec2!YC)
                        End If
                        
                        If Trim(t_rec2!BZ) <> "*" Then
                            m_bz.Text = Trim(t_rec2!BZ)
                        End If
                        
                        If Trim(t_rec2!JFDB) <> "*" Then
                            m_jfdb.Text = Trim(t_rec2!JFDB)
                        End If
                        
                        If Not Trim(t_rec2!JS_FS) = "*" Then
                            m_js_fs.Text = Trim(t_rec2!JS_FS)
                        End If
                        If Trim(t_rec2!YHSM) <> "*" Then
                            m_yhsm.Text = Trim(t_rec2!YHSM)
                        End If
                        If CMD1.Enabled = True Then
                            CMD1.Enabled = False
                            Cmd2.SetFocus
                        Else
                            Cmd2.SetFocus
                        End If
                 Else
                    frm_msg.Caption = "此合同编码不存在!"
                    m_htdm.SetFocus
                    Exit Sub
                 End If
            End Select
        Else
           frm_msg.Caption = "此合同编码不能为空!"
           m_htdm.SetFocus
        End If
End Sub

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

Private Sub m_htqsrq_GotFocus()
    m_htqsrq.SelStart = 0
    m_htqsrq.SelLength = Len(m_htqsrq.Text)
    m_htqsrq.Text = Format(Date, "yyyy-mm-dd")
End Sub

Private Sub m_htqsrq_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        Call m_htqsrq_LostFocus
    End If
    
End Sub

Private Sub m_htqsrq_LostFocus()
     If Not m_htqsrq.Text = "" Then
        t_rq = date_cl(Trim(m_htqsrq.Text))
            If t_rq <> "F" Then
                m_htqsrq = t_rq
            End If
        If IsDate(Trim(m_htqsrq.Text)) Then
            If CDate(Trim(m_htqsrq.Text)) >= Date Then
                m_htyxq.SetFocus
                m_htyxq.SelStart = 0
                m_htyxq.SelLength = Len(m_htyxq.Text)
            Else
                frm_msg.Caption = "无效日期!"
                m_htqsrq.SetFocus
                m_htqsrq.SelStart = 0
                m_htqsrq.SelLength = Len(m_htqsrq.Text)