ct_ybcz.frm

vb不酒店管理系统

Dim ybcz_YJSMC As String     '结算名称
Dim ybcz_FKMC As String     '付款名称
Dim ybcz_YFKMC As String    '原付款名称
Dim ybcz_ZH As String       '帐号
Dim ybcz_ZHK As String      '帐号库
Dim ybcz_GDK As String      '归档库
Dim ybcz_HZK As String      '汇总库
Dim ybcz_ZHXZ As String     '帐号性质

Dim ybcz_SPR As String      '审批人

Dim ybcz_name As String     '记操作流水时的名称

Dim t_bt As String       '存储列表显示的表头
Dim t_fields As Variant  '存储列表显示的字段名
Dim t_fdxs As Variant    '显示列是否有特殊处理    0 无, 1 有
Dim t_fdcounts As Integer   '表示列表所显示的字段的个数

'**************************************************************************************************
'*  功    能 :
'*  作    者 : 梁卫
'*  作成日期 : 1999.03.18
'*  修改日期 : 1999.03.18
'**************************************************************************************************
Private Sub CMD_EXIT_Click()
    If ybcz_over Then
        Call Pub_czle(PUB_data, t_czlsh, "纠正付款方式错误:" & SYS_GWMC & " " & Trim(tx_yjsrq.Text) & " " & Trim(tx_yzdh.Text) & "完成", Time(), pub_code)
    Else
        Call Pub_czle(PUB_data, t_czlsh, "纠正付款方式错误:" & SYS_GWMC & " 未完成", Time(), pub_code)
    End If

    Unload Me
End Sub


'**************************************************************************************************
Private Sub CMD_HF_Click()
    
    Dim temp_ft As Boolean
    Dim yyk_rec As Recordset
    
    Set yyk_rec = PUB_data.OpenRecordset("SELECT * FROM YY" & year(CDate(tx_yjsrq.Text)) & " WHERE TRIM(GWDM)='" & SYS_GWDM & "' AND JSRQ=#" & CDate(tx_yjsrq.Text) & "# AND TRIM(ZDH)='" & Trim(tx_yzdh.Text) & "' AND TRIM(JS_FS)='" & Trim(tx_yjsfs.Text) & "' AND TRIM(FK_FS)='" & Trim(tx_yfkfs.Text) & "' AND TRIM(TH)='" & Trim(tx_yth.Text) & "'", 2, 0, 2)
    If Not yyk_rec.BOF Then
        yyk_rec.MoveLast
        
        If Trim(yyk_rec!czbj) = "1" Then
            Call MsgBox("该笔帐是一笔冲正帐, 不可以重复操作 !")
            Call CMD_EXIT_Click
        End If
        
        ybcz_ZH = Trim(yyk_rec!dfzh)
        ct_ythqr.thqr_Rt = False
        Call ct_ythqr.MAIN(yyk_rec)
        ct_ythqr.Show (1)
        temp_ft = ct_ythqr.thqr_Rt
        
        If Not temp_ft Then
            Call MsgBox("您输入的数据有误 ! ")
            Call CMD_EXIT_Click
        End If
        
        If Len(Trim(yyk_rec!dfzh)) <> 0 Then
            JY_ZH = Trim(yyk_rec!dfzh)
            JY_ZDH = Trim(yyk_rec!ZDH)
            jy_JSRQ = yyk_rec!JSRQ
            JY_ZH = Trim(yyk_rec!dfzh)
            JY_ZH = Trim(yyk_rec!dfzh)
                
            ybcz_HZK = "*"
            ybcz_GDK = "*"
            ybcz_ZHXZ = "*"
            
            Call ZW_SJK(Trim(JY_ZH), Trim(ybcz_ZHK), Trim(ybcz_GDK), Date, Trim(ybcz_ZHXZ))
            
            Dim temp_YN As Boolean
            Dim temp_ft As Boolean
            
            temp_YN = False
            temp_ft = False
            
            Dim temp_qr As Boolean
            temp_qr = ZW_ZHQR(Trim(JY_ZH), temp_YN, Trim(ybcz_ZHK), Trim(ybcz_GDK), temp_ft, Date)
            If temp_qr Then
                Dim zy_rec As Recordset
                Set zy_rec = PUB_data.OpenRecordset("SELECT * FROM W" & Trim(JY_ZH) & " WHERE TRIM(PZH)='" & Trim(JY_ZDH) & "' AND FSRQ=#" & JY_FSRQ & "# AND CZBJ='0'", 4, 0, 2)
                If Not zy_rec.BOF Then
                    zy_rec.MoveLast
                Else
                    Call MsgBox("该笔帐已不在该帐号中, 请查明原因 !")
                    Call CMD_EXIT_Click
                End If
                zy_rec.Close
            Else
                Call CMD_EXIT_Click
            End If
            
        End If
        
        '把要恢复的台帐帐首作一备份
'        LOCAL_data.Execute "DELETE FROM CT_LSZSGD WHERE TRIM(GWDM)='" & SYS_GWDM & "' AND JSRQ=#" & CDate(tx_yjsrq.Text) & "# AND TRIM(ZDH)='" & Trim(tx_yzdh.Text) & "' AND TRIM(JS_FS)='" & Trim(tx_yjsfs.Text) & "' AND TRIM(FK_FS)='" & Trim(tx_yfkfs.Text) & "' AND TRIM(TH)='" & Trim(tx_yth.Text) & "' AND CZBJ='0'"
        LOCAL_data.Execute "DELETE FROM CT_LSZSGD"
        PUB_data.Execute "INSERT INTO CT_LSZSGD IN '" & Trim(SYS_LOCALBASE) & "' SELECT * FROM YY" & year(CDate(tx_yjsrq.Text)) & " WHERE TRIM(GWDM)='" & SYS_GWDM & "' AND JSRQ=#" & CDate(tx_yjsrq.Text) & "# AND TRIM(ZDH)='" & Trim(tx_yzdh.Text) & "' AND TRIM(JS_FS)='" & Trim(tx_yjsfs.Text) & "' AND TRIM(FK_FS)='" & Trim(tx_yfkfs.Text) & "' AND TRIM(TH)='" & Trim(tx_yth.Text) & "' AND CZBJ='0'"
        
        '把要恢复的台帐帐页作一备份
'        LOCAL_data.Execute "DELETE FROM CT_LSZYGD WHERE TRIM(GWDM)='" & SYS_GWDM & "' AND JSRQ=#" & CDate(tx_yjsrq.Text) & "# AND TRIM(ZDH)='" & Trim(tx_yzdh.Text) & "' AND TRIM(TH)='" & Trim(tx_yth.Text) & "' AND TRIM(JSSJ)='" & Trim(yyk_rec!JSSJ) & "'"
        LOCAL_data.Execute "DELETE FROM CT_LSZYGD "
        PUB_data.Execute "INSERT INTO CT_LSZYGD IN '" & Trim(SYS_LOCALBASE) & "' SELECT * FROM ZY" & year(CDate(tx_yjsrq.Text)) & " WHERE TRIM(GWDM)='" & SYS_GWDM & "' AND JSRQ=#" & CDate(tx_yjsrq.Text) & "# AND TRIM(ZDH)='" & Trim(tx_yzdh.Text) & "' AND TRIM(TH)='" & Trim(tx_yth.Text) & "' AND TRIM(JSSJ)='" & Trim(yyk_rec!JSSJ) & "'"
        
        '修改台帐帐页中要恢复的信息
'        LOCAL_data.Execute "UPDATE CT_LSZYGD SET DY_FT='0', SJ_FT='0'  WHERE TRIM(GWDM)='" & SYS_GWDM & "' AND JSRQ=#" & CDate(tx_yjsrq.Text) & "# AND TRIM(ZDH)='" & Trim(tx_yzdh.Text) & "' AND TRIM(TH)='" & Trim(tx_yth.Text) & "' AND TRIM(JSSJ)='" & Trim(yyk_rec!jssj) & "'"
        LOCAL_data.Execute "UPDATE CT_LSZYGD SET DY_FT='0', SJ_FT='0'"
        
        '把要恢复的台帐帐页内容恢复至临时汇总表中
        Dim lshzk_rec As Recordset
        Dim hjhzk_rec As Recordset
        
'        LOCAL_data.Execute "DELETE FROM CT_LSHZK WHERE TRIM(TH)='" & Trim(tx_yth.Text) & "' "
        LOCAL_data.Execute "DELETE FROM CT_LSHZK "
        Set lshzk_rec = LOCAL_data.OpenRecordset("SELECT * FROM CT_LSHZK", 2, 0, 2)
        If Not lshzk_rec.BOF Then
            lshzk_rec.MoveLast
        End If
        
        Set hjhzk_rec = LOCAL_data.OpenRecordset("SELECT TH, LBDMA, LBMC_ZW, LBMC_YW, ZKL, SUM(XFJE) AS SM_XFJE,SUM(SJJE) AS SM_SJJE FROM CT_LSZYGD WHERE TRIM(GWDM)='" & SYS_GWDM & "' AND JSRQ=#" & CDate(tx_yjsrq.Text) & "# AND TRIM(ZDH)='" & Trim(tx_yzdh.Text) & "' AND TRIM(TH)='" & Trim(tx_yth.Text) & "' AND TRIM(JSSJ)='" & Trim(yyk_rec!JSSJ) & "' GROUP BY TH, LBDMA, LBDM_ZW, LBDM_YW, ZKL", 4, 0, 2)
        If Not hjhzk_rec.BOF Then
            hjhzk_rec.MoveLast
            
            hjhzk_rec.MoveFirst
            Do While Not hjhzk_rec.EOF
                hzk_rec.AddNew
                    lshzk_rec!TH = Trim(hjhzk_rec!TH)
                    lshzk_rec!LBDMA = Trim(hjhzk_rec!LBDMA)
                    lshzk_rec!LBMC_ZW = Trim(hjhzk_rec!LBMC_ZW)
                    lshzk_rec!LBMC_YW = Trim(hjhzk_rec!IBMC_YW)
                    lshzk_rec!SJJE = Trim(hjhzk_rec!SM_SJJE)
                    lshzk_rec!XFJE = Trim(hjhzk_rec!SM_XFJE)
                    lshzk_rec!ZKL = Trim(hjhzk_rec!ZKL)
                    lshzk_rec!lock_no = 0
                lshzk_rec.Update
            
                hjhzk_rec.MoveNext
            Loop
        End If
        hjhzk_rec.Close
        
        lshzk_rec.Close
        
        ybcz_over = False
        
        If CS_cwfs = 1 Or CS_cwfs = 2 Then
            ybcz_over = ct_tzhf(pub_yth, pub_yjsr, pub_yzdh, pub_yjsmc, pub_yr2, pub_yfkmc, pub_yr5, tzgd, yyk, lsk, hzk, lslb, pub_czh)
        Else
            ybcz_over = ct_dfcw(pub_yth, pub_yjsr, pub_yzdh, pub_yjsmc, pub_yr2, pub_yfkmc, pub_yr5, tzgd, yyk, lsk, hzk, lslb, pub_czh)
        End If
        
        If ybcz_over Then
            Dim temp_lockno As Integer
            Do
                temp_lockn = Pub_lock("PUBLIC", "YY" & year(CDate(tx_yjsrq.Text)), yyk_rec)
            Loop Until temp_lockno <> 0
            
            '修改冲正标记
            yyk_rec.Edit
                yyk_rec!czbj = "1"
            yyk_rec.Update
            
            Call Pub_UNlock("YY" & year(CDate(tx_yjsrq.Text)), yyk_rec)
            
            If CS_cwfs = 2 Then
                Call MsgBox("请通过正常结算功能, 对恢复的台帐进行结算 !")
            End If
        End If
        
    Else
        Call MsgBox("没有找到该笔帐 ! ")
    End If
    
    yyk_rec.Close
    
    Call CMD_EXIT_Click
End Sub

'**************************************************************************************************
'*  功    能 :
'*  作    者 : 梁卫
'*  作成日期 : 1999.03.18
'*  修改日期 : 1999.03.18
'**************************************************************************************************
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = vbKeyEscape Then
        Call CMD_EXIT_Click
    End If
End Sub


'**************************************************************************************************
Sub MAIN(t_TITLE As String, t_CWFS As String)
    CS_title = Trim(t_TITLE)
    CS_cwfs = Trim(t_CWFS)
End Sub

'**************************************************************************************************
'*  功    能 :
'*  作    者 : 梁卫
'*  作成日期 : 1999.03.18
'*  修改日期 : 1999.03.18
'**************************************************************************************************
Private Sub Form_Load()

    pub_code = Left(Pub_getcode(PUB_data, "CT_ybcz"), 5)
    
    KeyPreview = True
    
    frm_msg.Visible = False
    frm_msg.Caption = ""
    
    lb_title.Caption = Trim(CS_title)
    
    ybcz_YJSMC = ""
    ybcz_R1 = "0"
    
    tx_yth.Text = ""
    tx_yzdh.Text = ""
    tx_yjsrq.Text = Date
    
    tx_yjsfs.Text = "0"
    lb_yjsmc.Caption = ""
    
    tx_yfkfs.Text = "0"
    lb_yfkmc.Caption = ""
    tx_czh.Text = ""
    tx_ye.Text = 0
    
    t_czlsh = Pub_czls(PUB_data, "CT_YBCZ", Time(), pub_code)
    
    ybcz_over = False
    
End Sub


'**************************************************************************************************
Private Sub tx_czh_LostFocus()
    frm_msg.Visible = False
    frm_msg.Caption = ""
    
    If Trim(tx_czh.Text) = "" Then
        frm_msg.Visible = True
        frm_msg.Caption = "冲正凭证号不应为空白!"
        tx_czh.SetFocus
    End If
End Sub

'**************************************************************************************************
Private Sub tx_ye_GotFocus()
    If IsNumeric(tx_ye.Text) Then
        tx_ye.Text = Format(tx_ye.Text)
    Else
        tx_ye.Text = 0
    End If
End Sub

'**************************************************************************************************
Private Sub tx_ye_LostFocus()
    frm_msg.Visible = False
    frm_msg.Caption = ""
    
    If PUB_SZJY(tx_ye, frm_msg) Then
        If CDec(tx_ye.Text) >= 0 Then
            tx_ye.Text = Format(tx_ye.Text, "#,##0.00")
        Else
            frm_msg.Visible = True
            frm_msg.Caption = "原付款总额不能 < 0 !"
            tx_ye.SetFocus
        End If
    End If
End Sub

'**************************************************************************************************
Private Sub tx_yfkfs_GotFocus()
    If Trim(ybcz_YJSMC) = "现场结算" Then
        tx_yfkfs.Text = t_tools.ZW_FKFS(PUB_data, "1", pub_code)
    Else
        tx_yfkfs.Enabled = False
        tx_yfkfs.Text = "*"
        lb_yfkmc.Enabled = False
        lb_yfkmc.Caption = "*"
        
        ybcz_YFKMC = "*"
    End If
End Sub

'**************************************************************************************************
Private Sub tx_yfkfs_LostFocus()
    
    If Trim(tx_yfkfs.Text) = "" Then
        ybcz_YFKMC = "*"
        Call CMD_EXIT_Click
    Else
        
        Dim fkfs_rec As Recordset
        Set fkfs_rec = PUB_data.OpenRecordset("SELECT * FROM ZW_FKFS WHERE TRIM(FK_DM)='" & Trim(tx_yfkfs.Text) & "'", 4, 0, 2)
        If Not fkfs_rec.BOF Then
            fkfs_rec.MoveLast
            ybcz_YFKMC = Trim(fkfs_rec!fk_mc)
            lb_yfkmc.Caption = ybcz_YFKMC
        Else
            ybcz_YFKMC = ""
            Call CMD_EXIT_Click
        End If
        fkfs_rec.Close
    End If
End Sub

'**************************************************************************************************
Private Sub tx_yjsfs_GotFocus()
    tx_yjsfs.Text = t_tools.ZW_JSFS(PUB_data, pub_code)
End Sub

'**************************************************************************************************
Private Sub tx_yjsfs_LostFocus()
    
    If Trim(tx_yjsfs.Text) = "" Then
        ybcz_YJSMC = "*"
        Call CMD_EXIT_Click
    Else
        
        Dim jsfs_rec As Recordset
        Set jsfs_rec = PUB_data.OpenRecordset("SELECT * FROM ZW_JSFS WHERE TRIM(JS_FS)='" & Trim(tx_yjsfs.Text) & "'", 4, 0, 2)
        If Not jsfs_rec.BOF Then
            jsfs_rec.MoveLast
            ybcz_YJSMC = Trim(jsfs_rec!JS_MC)
            lb_yjsmc.Caption = ybcz_YJSMC
        Else
            ybcz_YJSMC = ""
            Call CMD_EXIT_Click
        End If
        jsfs_rec.Close
    End If
End Sub

'**************************************************************************************************
Private Sub tx_yjsrq_LostFocus()
    frm_msg.Visible = False
    frm_msg.Caption = ""
    
    If PUB_RQJY(tx_yjsrq, frm_msg) Then
        If Trim(tx_yjsrq.Text) = "____-__-__" Then
            frm_msg.Visible = True
            frm_msg.Caption = "请输入原结算日期"
        Else
            If CDate(tx_yjsrq.Text) >= SYS_START And CDate(tx_yjsrq.Text) <= Date Then
            Else
                frm_msg.Visible = True
                frm_msg.Caption = "请输入适当的原结算日期"
                tx_yjsrq.SetFocus
            End If
        End If
    End If
End Sub

'**************************************************************************************************
'校验台号的正确性
Private Sub tx_yth_LostFocus()
    Dim temp_i As Integer
    Dim temp_char As String
    Dim temp_ft As Boolean
    
    frm_msg.Visible = False
    frm_msg.Caption = ""
    
    temp_ft = True
    If Len(Trim(tx_yth.Text)) = 0 Then
        temp_ft = False
    Else
        '按字符判断台号的合法性
        For temp_i = 1 To Len(Trim(tx_yth.Text))
            temp_char = Mid(Trim(tx_yth.Text), temp_i, 1)
            If Not (IsNumeric(temp_char) Or (UCase(temp_char) >= "A" And UCase(temp_char) <= "Z")) Then
                temp_ft = False
                Exit For
            End If