ht_dfgl.frm

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

   Label1.Caption = t_gnmc
   JZ_USER = SYS_USER + Space(1) + SYS_NAME
   JZ_JRSJ2 = Time()
   JZ_DQSJ2 = Time()
End Sub

Private Sub Form_KeyPress(KeyAscii As Integer)
    frm_msg.Caption = ""
End Sub
Private Sub CMD1_Click(Index As Integer)
    Select Case Index
    Case 0
            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 WHERE  TRIM(HTDM)='" & UCase(Trim(m_htdm.Text)) & "'", 2, 0, 2)
            If Not t_rec.BOF Then
                t_rec.MoveLast
                '加锁
                Do
                    Select Case Pub_lock("YX", "YX_DFHT", t_rec)  '判断加锁结果
                        Case "1"  '已锁定记录
                            Exit Do
                        Case "2"  '记录不存在
                            Call Pub_UNlock("YX_DFHT", t_rec)
                            Exit Sub
                    End Select
                Loop
                Dim dfh_t As String
                dfh_t = "DFHT" & year(Format(Date, "yyyy-mm-dd"))
                YX_data.Execute "INSERT INTO " & dfh_t & " SELECT * FROM YX_DFHT WHERE HTDM='" & UCase(Trim(m_htdm.Text)) & "'"
                YX_data.Execute "DELETE FROM YX_DFHT WHERE HTDM='" & UCase(Trim(m_htdm.Text)) & "'"
                Call Pub_UNlock("YX_DFHT", t_rec)
            Else
                frm_msg.Caption = "合同代码不存在!"
                m_htdm.SetFocus
                m_htdm.SelStart = 0
                m_htdm.SelLength = Len(Trim(m_htdm.Text))
                Exit Sub
            End If
            Call flex1_ref
            Call first
    Case 1
        Call first
    End Select
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 Frame2.Enabled = True Then
        Set rec = YX_data.OpenRecordset("select HTDM,YFDW,YFDB,HTYXQ,JFDB,JS_FS,LOCK_NO from YX_DFHT WHERE HTDM='" & UCase(Trim(m_htdm.Text)) & "'", 4)
        If Not rec.BOF Then
            rec.MoveLast
            If Not Trim(rec!YFDW) = "*" Then
                m_yfdw.Text = rec!YFDW
            End If
            If Not Trim(rec!YFDB) = "*" Then
                m_yfdb.Text = rec!YFDB
            End If
            m_htyxq.Text = Format(rec!HTYXQ, "yyyy-mm-dd")
            If Not Trim(rec!JFDB) = "*" Then
                m_jfdb.Text = rec!JFDB
            End If
            If Not Trim(rec!JS_FS) = "*" Then
                m_js_fs.Text = rec!JS_FS
            End If
            cmd1(0).SetFocus
        Else
            frm_msg.Caption = "无效合同代码!"
            m_htdm.SetFocus
            m_htdm.SelStart = 0
            m_htdm.SelLength = Len(Trim(m_htdm.Text))
        End If
    End If
End Sub

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

Private Sub m_jfdb1_GotFocus()
    m_jfdb1.SelStart = 0
    m_jfdb1.SelLength = Len(Trim(m_jfdb1.Text))
End Sub

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

Private Sub m_jzrq1_GotFocus()
    m_jzrq1.SelStart = 0
    m_jzrq1.SelLength = Len(m_jzrq1.Text)
End Sub

Private Sub m_jzrq1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        Call m_jzrq1_LostFocus
    End If
End Sub

Private Sub m_jzrq1_LostFocus()
    If Frame3.Enabled = True Then
        If Not m_jzrq1.Text = "    -  -  " Then
           t_rq = date_cl(m_jzrq1.Text)
               If t_rq <> "F" Then
                   m_jzrq1 = t_rq
               End If
           If IsDate(m_jzrq1.Text) Then
               m_qzrq1.SetFocus
           Else
               frm_msg.Caption = "无效日期!"
               m_jzrq1.SetFocus
           End If
        Else
           m_qzrq1.SetFocus
        End If
    End If
End Sub

Private Sub m_qzrq1_GotFocus()
    m_qzrq1.SelStart = 0
    m_qzrq1.SelLength = Len(m_qzrq1.Text)
End Sub

Private Sub m_qzrq1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        Call m_qzrq1_LostFocus
    End If
End Sub

Private Sub m_qzrq1_LostFocus()
If Frame3.Enabled = True Then
    If m_jfdb1.Text = "" Then
        T_TJ = ""
    Else
        T_TJ = "TRIM(JFDB)='" & Trim(m_jfdb1.Text) & "'"
    End If
    
    If Trim(m_htdm1.Text) = "" Then
        
    Else
        If T_TJ = "" Then
           T_TJ = T_TJ & "TRIM(HTDM)='" & Trim(m_htdm1) & "'"
        Else
           T_TJ = T_TJ & " AND TRIM(HTDM)='" & Trim(m_htdm1) & "'"
        End If
    End If
    
    If Not m_jzrq1.Text = "    -  -  " Then
        
        If T_TJ = "" Then
            T_TJ = T_TJ & "CSTR(HTYXQ)='" & CDate(m_jzrq1) & "'"
        Else
            T_TJ = T_TJ & " AND CSTR(HTYXQ)='" & CDate(m_jzrq1) & "'"
        End If
    End If
    
    If Not m_qzrq1.Text = "    -  -  " Then
        t_rq = date_cl(m_qzrq1.Text)
        If t_rq <> "F" Then
            m_qzrq1 = t_rq
        End If
        If IsDate(m_qzrq1.Text) Then
            If T_TJ = "" Then
                T_TJ = T_TJ & "CSTR(HTQSRQ)='" & CDate(Trim(m_qzrq1)) & "'"
            Else
                T_TJ = T_TJ & " AND CSTR(HTQSRQ)='" & CDate(Trim(m_qzrq1)) & "'"
            End If
        Else
            m_qzrq1.SetFocus
            m_qzrq1.SelStart = 0
            m_qzrq1.SelLength = Len(Trim(m_qzrq1.Text))
        End If
    End If
    
    If Not T_TJ = "" Then
        Set t_rec = YX_data.OpenRecordset("select HTDM,YFDW,YFDB,HTYXQ,JFDB,JS_FS,LOCK_NO from YX_DFHT WHERE " & T_TJ, 4)
        If Not t_rec.BOF Then
            t_rec.MoveLast
            Call first
            Call pub_memo.Flex_full(FLEX1, t_bt, t_rec, t_fields, 5, Array(0, 0, 0, 0, 0, 0))
            rec_no.Caption = "当前记录数:" + CStr(FLEX1.Rows - 1)
        Else
            MsgBox "无符合筛选条件的记录!", vbOKOnly
        End If
        Call first
    Else
        Set t_rec = YX_data.OpenRecordset("select HTDM,YFDW,YFDB,HTYXQ,JFDB,JS_FS,LOCK_NO from YX_DFHT", 4)
        If Not t_rec.BOF Then
            t_rec.MoveLast
            Call first
            Call pub_memo.Flex_full(FLEX1, t_bt, t_rec, t_fields, 5, Array(0, 0, 0, 0, 0, 0))
            rec_no.Caption = "当前记录数:" + CStr(FLEX1.Rows - 1)
        End If
            Call first
    End If
End If
End Sub

Private Sub Timer1_Timer()
    JZ_DQSJ2 = Time()
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    key_index = 100
    Select Case KeyCode
           Case vbKeyF2
                key_index = 0   '建立
           Case vbKeyF3
                key_index = 1   '修改
           Case vbKeyF4
                key_index = 2   '解除
           Case vbKeyF5
                key_index = 3   '打印
           Case vbKeyF6
                key_index = 4   '筛选
           Case vbKeyF10
                key_index = 5   '查询
           Case vbKeyF9
                key_index = 6   '刷新
           Case vbKeyEscape
                key_index = 99 '退出
    End Select
    
        If key_index = 99 Then
            If Frame2.Enabled = False And Frame3.Enabled = False Then
                Call Cmd3_Click
            Else
                Call first
            End If
        Else
            If Frame2.Enabled = False And Frame3.Enabled = False Then
                Call Cmd2_Click(key_index)
            End If
        End If
End Sub
Private Sub Cmd2_Click(Index As Integer)
    Select Case Index
    Case 0 '建立
        FLEX1.Enabled = False
        STY = "0"
        dfht_pop.tf = False
        dfht_pop.Show (1)
        If dfht_pop.tf Then
            frm_msg.Caption = "订房合同成功建立!"
            Call flex1_ref
            Call first
        Else
            Call first
        End If
    Case 1 '修改
        FLEX1.Enabled = False
        STY = "1"
        dfht_pop.tf = False
        dfht_pop.Show (1)
        If dfht_pop.tf Then
            frm_msg.Caption = "订房合同成功修改!"
            Call flex1_ref
            Call first
        Else
            Call first
        End If
    Case 2 '解除
        FLEX1.Enabled = False
        STY = "2"
        Frame2.Enabled = True
        m_htdm.SetFocus
        m_htdm.SelStart = 0
        m_htdm.SelLength = Len(Trim(m_htdm.Text))
    Case 3 '打印
        If T_TJ = "" Then
            Set t_rec = YX_data.OpenRecordset("select HTDM,YFDW,YFDB,HTYXQ,JFDB,JS_FS from YX_DFHT", 4)
            If Not t_rec.BOF Then
                t_rec.MoveLast
                Call print_table(t_rec, "订房合同清单", Array("合同代码", "租用单位", "租用单位代表", "合同终止日期 ", "酒店代表", "结算方式 "), Array(18, 40, 15, 12, 12, 12), 0)
            Else
                MsgBox "无可打印信息!", 64
                Call flex1_ref
                Call first
                Exit Sub
            End If
        Else
            Set t_rec = YX_data.OpenRecordset("select HTDM,YFDW,YFDB,HTYXQ,JFDB,JS_FS from YX_DFHT WHERE " & T_TJ & "", 4)
            If Not t_rec.BOF Then
                t_rec.MoveLast
                Call print_table(t_rec, "订房合同清单", Array("合同代码", "租用单位", "租用单位代表", "合同终止日期 ", "酒店代表", "结算方式 "), Array(18, 40, 15, 12, 12, 12), 0)
            Else
                MsgBox "无可打印信息!", 64
                Call flex1_ref
                Call first
                Exit Sub
            End If
        End If
    Case 4 '筛选
            FLEX1.Enabled = False
            STY = "4"
            Frame3.Enabled = True
            Cmd2(0).Enabled = False
            Cmd2(1).Enabled = False
            Cmd2(2).Enabled = False
            Cmd2(3).Enabled = False
            Cmd2(4).Enabled = False
            Cmd2(5).Enabled = False
            Cmd2(6).Enabled = False
            Frame3.Enabled = True
            m_jfdb1.SetFocus
            
    Case 5 '查询
            FLEX1.Enabled = False
            STY = "5"
            dfht_pop.Show (1)
            t_rec.Requery
            Call pub_memo.Flex_full(FLEX1, t_bt, t_rec, t_fields, 5, Array(0, 0, 0, 0, 0, 0))
            rec_no.Caption = "当前记录数:" + CStr(FLEX1.Rows - 1)
            Call first
    Case 6 '刷新
            Call flex1_ref
    End Select
End Sub

Private Sub Cmd3_Click()
    Unload Me
    yx_main.Show (1)
End Sub
Private Sub FLEX1_GotFocus()
    On Error GoTo error1
    m_htdm.Text = Trim(FLEX1.TextArray(FLEX1.Row * 6))
    m_yfdw.Text = Trim(FLEX1.TextArray(FLEX1.Row * 6 + 1))
    m_yfdb.Text = Trim(FLEX1.TextArray(FLEX1.Row * 6 + 2))
    m_htyxq.Text = IIf(Trim(FLEX1.TextArray(FLEX1.Row * 6 + 3)) = "", "    -  -  ", Format(FLEX1.TextArray(FLEX1.Row * 6 + 3), "yyyy-mm-dd"))
    m_jfdb.Text = Trim(FLEX1.TextArray(FLEX1.Row * 6 + 4))
    m_js_fs.Text = Trim(FLEX1.TextArray(FLEX1.Row * 6 + 5))
        
    Exit Sub
error1:
       If Err() = 383 Then
            Resume Next
       End If
       
End Sub
Private Sub FLEX1_RowColChange()
    On Error GoTo error1
    frm_msg.Caption = ""
    m_htdm.Text = Trim(FLEX1.TextArray(FLEX1.Row * 6))
    m_yfdw.Text = Trim(FLEX1.TextArray(FLEX1.Row * 6 + 1))
    m_yfdb.Text = Trim(FLEX1.TextArray(FLEX1.Row * 6 + 2))
    m_htyxq.Text = IIf(Trim(FLEX1.TextArray(FLEX1.Row * 6 + 3)) = "", "    -  -  ", Format(FLEX1.TextArray(FLEX1.Row * 6 + 3), "yyyy-mm-dd"))
    m_jfdb.Text = Trim(FLEX1.TextArray(FLEX1.Row * 6 + 4))
    m_js_fs.Text = Trim(FLEX1.TextArray(FLEX1.Row * 6 + 5))
    Exit Sub
error1:
       If Err() = 383 Then
            Resume Next
       End If
End Sub
Private Sub flex1_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        Cmd2(0).SetFocus
    End If
End Sub

Private Sub first()
        Frame2.Enabled = False
        Frame3.Enabled = False
        m_jfdb1.Text = ""
        m_htdm1.Text = ""
        m_jzrq1.Text = "    -  -  "
        m_qzrq1.Text = "    -  -  "
        If cmd1(0).Enabled = True Then
            cmd1(0).Enabled = False
        End If
        If cmd1(1).Enabled = True Then
            cmd1(1).Enabled = False
        End If
        If Cmd2(0).Enabled = False Then
          Cmd2(0).Enabled = True
        End If
        If Cmd2(1).Enabled = False Then
            Cmd2(1).Enabled = True
        End If
        If Cmd2(2).Enabled = False Then
            Cmd2(2).Enabled = True
        End If
        If Cmd2(3).Enabled = False Then
            Cmd2(3).Enabled = True
        End If
        If Cmd2(4).Enabled = False Then
            Cmd2(4).Enabled = True
        End If
        If Cmd2(5).Enabled = False Then
            Cmd2(5).Enabled = True
        End If
        If Cmd2(6).Enabled = False Then
            Cmd2(6).Enabled = True
        End If
        If Cmd3.Enabled = False Then
            Cmd3.Enabled = True
        End If
        If FLEX1.Enabled = False Then
            FLEX1.Enabled = True
            FLEX1.SetFocus
        End If
    STY = ""
End Sub


Private Sub flex1_ref()
    If Not T_TJ = "" Then
        Set t_rec = YX_data.OpenRecordset("select HTDM,YFDW,YFDB,HTYXQ,JFDB,JS_FS,LOCK_NO from YX_DFHT WHERE " & T_TJ, 4)
        If Not t_rec.BOF Then
            t_rec.MoveLast
        End If
    Else
        Set t_rec = YX_data.OpenRecordset("select HTDM,YFDW,YFDB,HTYXQ,JFDB,JS_FS,LOCK_NO from YX_DFHT  ", 4)
        If Not t_rec.BOF Then
            t_rec.MoveLast
        End If
    End If
    Call pub_memo.Flex_full(FLEX1, t_bt, t_rec, t_fields, 5, Array(0, 0, 0, 0, 0, 0))
    rec_no.Caption = "当前记录数:" + CStr(FLEX1.Rows - 1)
End Sub