dt_kfhf.frm

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

                    Call tPLock(temp_sql, "W" & Left(Trim(tx_yzh), 4), Trim(tx_yzh.Text), "1")
                    temp_rec.MoveNext
                Loop
                Call Flex_full(gd_yzh, kfhf_bt_y, zy_recYF, kfhf_fields_y, kfhf_fdcounts_y - 1, kfhf_fdxs_y)
                Call Flex_full(gd_xzh, kfhf_bt_x, zy_recXF, kfhf_fields_x, kfhf_fdcounts_x - 1, kfhf_fdxs_x)
            End If
       End If
    
    End Select
End Sub

'*   给选择的记录加锁
'**************************************************************************************************
'*  功    能 : 给选择的记录加锁
'*  作    者 : 梁卫
'*  作成日期 : 1999.04.06
'*  修改日期 : 1999.04.06
'*  参数说明 : t_sql    -- 打开记录集的SQL文
'*             t_tbname -- SQL文中的表名
'*             t_zh     -- 帐号
'*             t_js_ft  -- 是否被选择成为结算      '0' -- 非计算,  '1' -- 结算
'**************************************************************************************************
Private Sub tPLock(t_sql As String, t_tbname As String, T_ZH As String, t_js_ft As String)
    Dim temp_rec As Recordset
    Dim temp_lock As Integer
    
    Set temp_rec = PUB_data.OpenRecordset(t_sql, 2, 0, 2)
    If Not temp_rec.BOF Then
        temp_rec.MoveLast
        Do
            temp_lock = Pub_lock("PUBLIC", Trim(t_tbname), temp_rec)
        Loop Until temp_lock <> 0
        
        temp_rec.Edit
            temp_rec.Fields("JS_FT") = t_js_ft
            If t_js_ft = "1" Then
                temp_rec.Fields("CLYDM") = SYS_USER
            Else
                temp_rec.Fields("CLYDM") = "***"
            End If
        temp_rec.Update
        
        Call Pub_UNlock(Trim(t_tbname), temp_rec)
    End If
    temp_rec.Close

End Sub

Private Sub Form_Activate()
    tx_yzh.SetFocus
End Sub

'**************************************************************************************************
'*  功    能 :
'*  作    者 : 梁卫
'*  作成日期 : 1999.02.25
'*  修改日期 : 1999.02.25
'**************************************************************************************************
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    
    Select Case KeyCode
    Case vbKeyEscape
        CMD_EXIT_Click
    Case vbKeyF3
        CMD_HF_Click
    End Select
    
End Sub

'**************************************************************************************************
'*  功    能 :
'*  作    者 : 梁卫
'*  作成日期 : 1999.02.25
'*  修改日期 : 1999.02.25
'**************************************************************************************************
Private Sub Form_Load()
    frm_msg.Visible = False
    frm_msg.Caption = ""
    
    CMD_HF.Enabled = False
    
    dt_kfhf.KeyPreview = True
    
    tx_yzh.Text = ""
    tx_xzh.Text = ""
    
    '换房人的原房信息
    kfhf_zklx_y = 0
    kfhf_kf_lxn_y = 0
    kfhf_td_zh_y = ""
    kfhf_kr_dj_y = 0
    kfhf_zxfe_y = 0
    kfhf_kfrs_y = 0
    ReDim kfhf_fls_y(SYS_LXN + 1)
    For i = 1 To SYS_LXN
        kfhf_fls_y(i) = 0
    Next i
    lb_ykr_x.Caption = ""
    lb_ykr_m.Caption = ""
    lb_yyw_x.Caption = ""
    lb_yyw_m.Caption = ""
    lb_ykr_xbmc.Caption = ""
    lb_ygjmc.Caption = ""
    lb_ykf_lxc.Caption = ""
    kfhf_opYF = False
    
    '新房信息
    kfhf_zklx_x = 0
    kfhf_kf_lxn_x = 0
    kfhf_kfrs_x = 0
    ReDim kfhf_fls_x(SYS_LXN + 1)
    For i = 1 To SYS_LXN
        kfhf_fls_x(i) = 0
    Next i
    lb_xkr_x.Caption = ""
    lb_xkr_m.Caption = ""
    lb_xyw_x.Caption = ""
    lb_xyw_m.Caption = ""
    lb_xkr_xbmc.Caption = ""
    lb_xgjmc.Caption = ""
    lb_xfmsg.Caption = ""
    lb_xkf_lxc.Caption = ""
    kfhf_opXF = False
    
    '帐页选择条件
    tx_zh.Text = ""
    tx_from.Text = "____-__-__"
    tx_to.Text = "____-__-__"
    tx_pzh.Text = ""
    
    tx_zdh.Text = ""
    
    op_qb(0).Value = True
    
    Call tPkjEnabled(False)
    
    fm_yfz.Enabled = False
    tx_kf_fz_y.Text = 0
    tx_kf_fwf_y.Text = 0
    
    fm_xfz.Enabled = False
    tx_kf_fz_x.Text = 0
    tx_kf_fwf_x.Text = 0
    
    kfhf_fields_y = Array("ZH", "FSRQ", "ZY", "PZH", "JFFSE", "DFFSE")  '设置显示字段
    kfhf_fdxs_y = Array(0, 0, 0, 0, 0, 0)  '设置显示字段
    kfhf_bt_y = "<帐号 |^发生日期  |<摘要      |<凭证号|>借方发生额|>贷方发生额"   '设置显示表头格式
    kfhf_fdcounts_y = 6

    kfhf_fields_x = Array("ZH", "FSRQ", "ZY", "PZH", "JFFSE", "DFFSE") '设置显示字段
    kfhf_fdxs_x = Array(0, 0, 0, 0, 0, 0)  '设置显示字段
    kfhf_bt_x = "<帐号 |^发生日期  |<摘要      |<凭证号|>借方发生额|>贷方发生额"   '设置显示表头格式
    kfhf_fdcounts_x = 6

End Sub


Private Sub gd_xzh_DblClick()
    Dim temp_sql As String
        
    '把新帐页中的一条记录选择至原帐页中
    If gd_xzh.Rows - 1 <> 0 Then
        If Trim(gd_xzh.TextArray(gd_xzh.Row * kfhf_fdcounts_y)) <> "" Then
            temp_sql = "SELECT * FROM W" & Left(Trim(tx_yzh.Text), 4) & " WHERE TRIM(ZH)='" & Trim(gd_xzh.TextArray(gd_xzh.Row * kfhf_fdcounts_x)) & "' AND FSRQ=#" & Trim(gd_xzh.TextArray(gd_xzh.Row * kfhf_fdcounts_x + 1)) & "# AND TRIM(PZH)='" & Trim(gd_xzh.TextArray(gd_xzh.Row * kfhf_fdcounts_x + 3)) & "'"
            Call tPLock(temp_sql, "W" & Left(Trim(tx_yzh.Text), 4), Trim(tx_yzh.Text), "0")
            Call Flex_full(gd_yzh, kfhf_bt_y, zy_recYF, kfhf_fields_y, kfhf_fdcounts_y - 1, kfhf_fdxs_y)
            Call Flex_full(gd_xzh, kfhf_bt_x, zy_recXF, kfhf_fields_x, kfhf_fdcounts_x - 1, kfhf_fdxs_x)
        End If
    End If

End Sub

Private Sub gd_yzh_DblClick()
    Dim temp_sql As String
    
    '把原帐页中的一条记录选择至新帐页中
    If gd_yzh.Rows - 1 <> 0 Then
        If Trim(gd_yzh.TextArray(gd_yzh.Row * kfhf_fdcounts_y)) <> "" Then
            temp_sql = "SELECT * FROM W" & Left(Trim(tx_yzh.Text), 4) & " WHERE TRIM(ZH)='" & Trim(gd_yzh.TextArray(gd_yzh.Row * kfhf_fdcounts_y)) & "' AND FSRQ=#" & Trim(gd_yzh.TextArray(gd_yzh.Row * kfhf_fdcounts_y + 1)) & "# AND PZH='" & Trim(gd_yzh.TextArray(gd_yzh.Row * kfhf_fdcounts_y + 3)) & "'"
            Call tPLock(temp_sql, "W" & Left(Trim(tx_yzh.Text), 4), Trim(tx_yzh.Text), "1")
            Call Flex_full(gd_yzh, kfhf_bt_y, zy_recYF, kfhf_fields_y, kfhf_fdcounts_y - 1, kfhf_fdxs_y)
            Call Flex_full(gd_xzh, kfhf_bt_x, zy_recXF, kfhf_fields_x, kfhf_fdcounts_x - 1, kfhf_fdxs_x)
        End If
    End If
        
End Sub

'**************************************************************************************************
'*  功    能 : 根据选择的换房方式设置状态
'*  作    者 : 梁卫
'*  作成日期 : 1999.04.06
'*  修改日期 : 1999.04.06
'**************************************************************************************************
Private Sub op_qb_Click(Index As Integer)
    Dim temp_ft As Boolean
    
    If op_qb(1).Value Then
        If Len(Trim(tx_yzh.Text)) = 5 Then
            tx_yzh.Text = Left(Trim(tx_yzh.Text), 4)
            tx_yzh_LostFocus
        Else
            kfhf_yzhft = True
        End If
        
        '当选择全部时, 把原帐号中的帐页的JS_FT, CLYDM全部修改
        If kfhf_yzhft Then
            temp_ft = False
        Else
            temp_ft = True
        End If
        fm_yfz.Enabled = False
    Else                     '本人换入
        temp_ft = True
        fm_yfz.Enabled = True
    
    End If
    
    If temp_ft Then
        PUB_data.Execute "UPDATE W" & Left(Trim(tx_yzh.Text), 4) & " SET JS_FT='0', CLYDM='***' WHERE TRIM(JS_FT)='1' AND TRIM(CLYDM)='" & SYS_USER & "'"
        Call tPkjEnabled(True)
    Else
        PUB_data.Execute "UPDATE W" & Left(Trim(tx_yzh.Text), 4) & " SET JS_FT='1', CLYDM='" & Trim(SYS_USER) & "' WHERE TRIM(JS_FT)='0' AND TRIM(CLYDM)='***'"
        Call tPkjEnabled(False)
    End If
    
    Call Flex_full(gd_xzh, kfhf_bt_x, zy_recXF, kfhf_fields_x, kfhf_fdcounts_x - 1, kfhf_fdxs_x)
    Call Flex_full(gd_yzh, kfhf_bt_y, zy_recYF, kfhf_fields_y, kfhf_fdcounts_y - 1, kfhf_fdxs_y)
        

End Sub


Private Sub op_qb_KeyDown(Index As Integer, KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case vbKeyUp
        tx_yzh.SetFocus
    Case vbKeyDown, vbKeyReturn
        tx_xzh.SetFocus
    End Select
End Sub


Private Sub tx_xzh_GotFocus()
    fm_xfz.Enabled = False
    tx_kf_fz_x.Text = 0
    tx_kf_fwf_x.Text = 0
    CMD_HF.Enabled = False
End Sub

Private Sub tx_xzh_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
    Case vbKeyUp
        If op_qb(0).Value Then
            op_qb(0).SetFocus
        Else
            op_qb(1).SetFocus
        End If
    Case vbKeyDown, vbKeyReturn
        tx_zdh.SetFocus
    End Select
End Sub

'**************************************************************************************************
'*  功    能 : 输入新房号并校验其房号的正确性
'*  作    者 : 梁卫
'*  作成日期 : 1999.03.28
'*  修改日期 : 1999.03.28
'**************************************************************************************************
Private Sub tx_xzh_LostFocus()
    Dim krqd_rec As Recordset
    Dim krqd_recRS As Recordset
    Dim krqd_recFFZ As Recordset
    Dim krqd_recXFZR As Recordset
    Dim fjk_rec As Recordset
    Dim ftk_rec As Recordset
    
    Dim temp_bzj As Single
    
    Dim temp_ft As Boolean
    
    temp_ft = True
    
    frm_msg.Visible = False
    frm_msg.Caption = ""
    
    If Len(Trim(tx_xzh.Text)) = 0 Then
        Exit Sub
    End If
    
    If Len(Trim(tx_xzh.Text)) < 4 Then
        frm_msg.Visible = True
        frm_msg.Caption = "请输入正确的帐号"
        tx_xzh.SetFocus
        Exit Sub
    End If
    
    If Left(Trim(tx_yzh.Text), 4) = Left(Trim(tx_xzh.Text), 4) Then
        frm_msg.Visible = True
        frm_msg.Caption = "不能换入相同的房间"
        tx_xzh.SetFocus
        Exit Sub
    End If
    
    Set krqd_rec = PUB_data.OpenRecordset("SELECT * FROM DT_KRQD WHERE TRIM(ZH)='" & Left(Trim(tx_xzh.Text), 4) & "'", 4, 0, 2)
    If Not krqd_rec.BOF Then
        krqd_rec.MoveLast    '新房已住人
        
        '判断原房团队号和新房团队号是否相同, 团队号不一致的客人不能换入同一房间
        If kfhf_td_zh_y = Trim(krqd_rec.Fields("TD_ZH")) Then   '团队号相同
            If kfhf_zklx_y = krqd_rec.Fields("ZKLX") Then
                lb_xkr_x.Caption = Trim(krqd_rec.Fields("KR_X"))
                lb_xkr_m.Caption = Trim(krqd_rec.Fields("KR_M"))
                lb_xyw_x.Caption = Trim(krqd_rec.Fields("YW_X"))
                lb_xyw_m.Caption = Trim(krqd_rec.Fields("YW_M"))
                lb_xkr_xbmc.Caption = Trim(krqd_rec.Fields("KR_XBMC"))
                lb_xgjmc.Caption = Trim(krqd_rec.Fields("GJMC"))
                
                '保存新房的信息
                kfhf_zklx_x = krqd_rec.Fields("ZKLX")
                kfhf_kf_lxn_x = krqd_rec.Fields("KF_LXN")
                kfhf_ldrq_x = krqd_rec.Fields("LDRQ")
                
                Set krqd_recRS = PUB_data.OpenRecordset("SELECT COUNT(*) AS XFRS FROM DT_KRQD WHERE LEFT(TRIM(ZH),4)='" & Left(Trim(tx_xzh.Text), 4) & "'", 4, 0, 2)
                If Not krqd_recRS.BOF Then
                    krqd_recRS.MoveLast
                    kfhf_kfrs_x = krqd_recRS.Fields("XFRS")
                End If
                krqd_recRS.Close
                
                
                '判断客房定员
                Set fjk_rec = PUB_data.OpenRecordset("SELECT * FROM KF_FJK WHERE KF_LXN=" & kfhf_kf_lxn_x, 4, 0, 2)
                If Not fjk_rec.BOF Then
                    fjk_rec.MoveLast
                    If kfhf_kfrs_x + IIf(op_qb(0), 1, kfhf_kfrs_y) > fjk_rec.Fields("KF_DY") Then
                        frm_msg.Visible = True
                        frm_msg.Caption = "该房间已超员, 不能再换入客人"