pub_me_ct.bas

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

Attribute VB_Name = "pub_me_ct"
Option Explicit

'***********************************************************************
'* 功    能 : 给Combobox控件赋值
'* 作 成 者 : 梁 卫
'* 生成日期 : 1999.03.01
'* 修改日期 : 1999.03.04
'* 参数说明:  tp_com     : 控件的名称
'*            tp_table   : 所使用的表名
'*            tp_fdname0 : 代码字段的字段名
'*            tp_fdname1 : 名称字段的字段名
'***********************************************************************

Public Sub PUB_CMSC(tp_data As Database, tp_com As Control, tp_table As String, tp_fdname0 As String, tp_fdname1 As String)

    Dim i As Integer
    Dim tp_rec As Recordset
    Dim tp_recordcount As Integer

    tp_com.Clear
    
    Set tp_rec = tp_data.OpenRecordset("select " & tp_fdname0 & "," & tp_fdname1 & " from " & tp_table & " order by " & tp_fdname0, 4, 0, 2)
    If Not tp_rec.BOF Then
        tp_rec.MoveLast
        tp_recordcount = tp_rec.RecordCount
        
        tp_rec.MoveFirst

        For i = 0 To tp_recordcount - 1
            tp_com.AddItem
            tp_com.List(i, 0) = tp_rec.Fields(tp_fdname0)
            tp_com.List(i, 1) = tp_rec.Fields(tp_fdname1)
            tp_rec.MoveNext
        Next i
    End If
    tp_rec.Close

End Sub



'***********************************************************************
'* 功    能 : 根据代码生成名称
'* 作 成 者 : 梁 卫
'* 生成日期 : 1999.03.06
'* 修改日期 : 1999.03.06
'* 参数说明:  tp_dm : 代码字段控件名
'*            tp_mc : 名称字段控件名
'***********************************************************************

Public Function PUB_GetCMName(tp_dm As Control, tp_cm As Control) As Boolean

    Dim i As Integer
    Dim tp_rt As Boolean

    tp_rt = False

    For i = 0 To tp_cm.ListCount - 1
        If Trim(tp_cm.List(i, 0)) = Trim(tp_dm.Text) Then
            tp_cm.Text = Trim(tp_cm.List(i, 1))
            tp_rt = True
            Exit For
        End If
    Next i

    PUB_GetCMName = tp_rt
    
End Function



'************************************************************************************
'* 功    能 : 根据名称查找代码; 若该名称和代码为一组时, 则退出, 否则,按照名称查找代码
'* 作 成 者 : 梁 卫
'* 生成日期 : 1999.03.06
'* 修改日期 : 1999.03.06
'* 参数说明:  tp_dm : 代码字段控件名
'*            tp_mc : 名称字段控件名
'************************************************************************************

Public Function PUB_GetTXCode(tp_dm As Control, tp_cm As Control) As Boolean

    Dim i As Integer
    Dim tp_rt As Boolean
    Dim tp_find As Boolean

    tp_rt = False
    tp_find = False

    For i = 0 To tp_cm.ListCount - 1
        If Trim(tp_cm.List(i, 1)) = Trim(tp_cm.Text) Then
            tp_dm.Text = Trim(tp_cm.List(i, 0))
            tp_rt = True
            Exit For
        End If
    Next i
    
    PUB_GetTXCode = tp_rt

End Function








'**************************************************************************************************
'*  功    能 : 在字典表中, 代码字段失去焦点时的处理
'*  作    者 : 梁卫
'*  作成日期 : 1999.03.08
'*  修改日期 : 1999.03.08
'**************************************************************************************************
Public Sub PUB_DMLostFocus(temp_dm As Control, temp_mc As Control, temp_frmmsg As Control, temp_msg As String)
    Dim temp_rt As Boolean
    
    temp_frmmsg.Visible = False
    temp_frmmsg.Caption = ""
    
    If Trim(temp_dm.Text) = "" Or Trim(temp_dm.Text) = "*" Then
        temp_mc.Text = "*"
    Else
        temp_rt = PUB_GetCMName(temp_dm, temp_mc)
        If temp_rt Then
        Else
            temp_frmmsg.Visible = True
            temp_frmmsg.Caption = temp_msg
            temp_dm.SetFocus
        End If
    End If
End Sub


'**************************************************************************************************
'*  功    能 : 在字典表中, 名称字段失去焦点时的处理
'*  作    者 : 梁卫
'*  作成日期 : 1999.03.08
'*  修改日期 : 1999.03.08
'**************************************************************************************************
Public Function PUB_MCLostFocus(temp_dm As Control, temp_mc As Control, temp_frmmsg As Control, temp_msg As String) As Boolean
    
    temp_frmmsg.Visible = False
    temp_frmmsg.Caption = ""
    
    PUB_MCLostFocus = True
    
    If Trim(temp_mc.Text) = "" Or Trim(temp_mc.Text) = "*" Then
        temp_dm.Text = "*"
    Else
        PUB_MCLostFocus = PUB_GetTXCode(temp_dm, temp_mc)
        If PUB_MCLostFocus Then
        Else
            temp_frmmsg.Visible = True
            temp_frmmsg.Caption = temp_msg
            temp_dm.SetFocus
        End If
    End If

End Function






'**************************************************************************************************
'*  功    能 : 日期型字段校验
'*  作    者 : 梁卫
'*  作成日期 : 1999.03.15
'*  修改日期 : 1999.03.15
'**************************************************************************************************
Public Function PUB_RQJY(temp_rq As Control, temp_msg As Control) As Boolean
    
    PUB_RQJY = True
    If Trim(temp_rq.Text) = "____-__-__" Then
    Else
        If Len(Trim(temp_rq)) = 10 Then
            If IsDate(Trim(temp_rq)) Then
            Else
                PUB_RQJY = False
            End If
        Else
            PUB_RQJY = False
        End If
    End If
    If Not PUB_RQJY Then
        temp_msg.Visible = True
        temp_msg.Caption = "不适当的日期型"
        temp_rq.SetFocus
    End If
End Function

'**************************************************************************************************
'*  功    能 : 数字型字段校验
'*  作    者 : 梁卫
'*  作成日期 : 1999.03.15
'*  修改日期 : 1999.03.15
'**************************************************************************************************
Public Function PUB_SZJY(temp_sz As Control, temp_msg As Control) As Boolean
    
    temp_sz.Text = Trim(temp_sz.Text)
    PUB_SZJY = True
    If Trim(temp_sz) = "" Then
        temp_sz.Text = 0
    Else
        If IsNumeric(temp_sz.Text) Then
            If CDec(temp_sz.Text) >= 0 Then
            Else
                PUB_SZJY = False
            End If
        Else
            PUB_SZJY = False
        End If
    End If
    If Not PUB_SZJY Then
        temp_msg.Visible = True
        temp_msg.Caption = "不适当的数字"
        temp_sz.SetFocus
    End If
End Function






'**************************************************************************************************
'*  功    能 : 餐厅优惠券处理
'*  作    者 : 梁卫
'*  作成日期 : 1999.04.15
'*  修改日期 : 1999.04.15
'*  参数说明 : (输入) t_zy -- 领用, 发放, 回收
'*                    t_sl -- 数量
'*             (返回) t_sl -- 记录实际数量
'**************************************************************************************************
Public Sub ct_yhq(t_zy As String, t_sl As Integer)

    Dim yhq_rec As Recordset
    Dim lsh_rec As Recordset
 
    Dim temp_sl As Variant
    Dim t_hssl As Integer
    Dim t_lysl As Integer
    Dim t_ffsl As Integer
    
    If Not (t_sl = 0 And t_zy = "回收") Then
        t_hssl = 0
        t_lysl = 0
        t_ffsl = 0

        Select Case t_zy
        Case "回收"
            t_hssl = t_sl
        Case "领用"
            temp_sl = InputBox("请输入优惠券数量:", Trim(t_zy) & "优惠券", 1)
            Do While True
                If IsNumeric(temp_sl) Then
                    If CInt(temp_sl) >= 0 Then
                        Exit Do
                    End If
                End If
                temp_sl = InputBox("请输入正确的数量:", Trim(t_zy) & "优惠券", 1)
            Loop
            t_lysl = CInt(temp_sl)
            t_sl = t_lysl
        Case "发放"
            temp_sl = InputBox("请输入优惠券数量:", Trim(t_zy) & "优惠券", 1)
            Do While True
                If IsNumeric(temp_sl) Then
                    If CInt(temp_sl) >= 0 Then
                        Exit Do
                    End If
                End If
                temp_sl = InputBox("请输入正确的数量:", Trim(t_zy) & "优惠券", 1)
            Loop
            t_ffsl = CInt(temp_sl)
            t_sl = t_ffsl
        End Select
        
        Set yhq_rec = PUB_data.OpenRecordset("SELECT * FROM CT_YHQ", 2, 0, 2)
        If Not yhq_rec.BOF Then
            yhq_rec.MoveLast
        End If
        
        yhq_rec.AddNew
            yhq_rec.Fields("GWDM") = SYS_GWDM
            yhq_rec.Fields("GWMC") = SYS_GWMC
            yhq_rec.Fields("FSRQ") = Date
            
            Set lsh_rec = PUB_data.OpenRecordset("SELECT MAX(LSH) AS MAX_LSH FROM CT_YHQ WHERE TRIM(GWDM)='" & Trim(SYS_GWDM) & "' AND FSRQ=#" & Format(Date, "YYYY-MM-DD") & "#", 4, 0, 2)
            If Not lsh_rec.BOF Then
                lsh_rec.MoveLast
                If IsNull(lsh_rec.Fields("MAX_LSH")) Then
                    yhq_rec.Fields("LSH") = 1
                Else
                    yhq_rec.Fields("LSH") = lsh_rec.Fields("MAX_LSH") + 1
                End If
            Else
                yhq_rec.Fields("LSH") = 1
            End If
            lsh_rec.Close
            
            yhq_rec.Fields("HSSL") = t_hssl
            yhq_rec.Fields("LYSL") = t_lysl
            yhq_rec.Fields("FFSL") = t_ffsl
            yhq_rec.Fields("BZ") = Trim(t_zy)
            yhq_rec.Fields("CZY") = SYS_USER
            yhq_rec.Fields("LOCK_NO") = 0
        yhq_rec.Update
        yhq_rec.Close
    End If

End Sub



'**************************************************************************************************
'*  功    能 : 酒水统计
'*  作    者 : 梁卫
'*  作成日期 : 1999.04.15
'*  修改日期 : 1999.04.15
'**************************************************************************************************
Public Sub CT_JSTJ()
    Dim yyxma_rec As Recordset      'YYXMA
    Dim ctzy_rec As Recordset       'ZYyyyy
    Dim jstj_rec As Recordset       'ZYyyyy
    
    Dim jstj_lbdma As String
    Dim temp_rq As Variant
    
    Dim t_czlsh As String
    
    Dim temp_ft As Boolean
    Dim temp_lock As Integer
    
    pub_code = Left(Pub_getcode(PUB_data, "CT_JSTJ"), 5)
    
    jstj_lbdma = ""
    Set yyxma_rec = PUB_data.OpenRecordset("SELECT * FROM YYXMA WHERE TRIM(GWDM)='" & SYS_GWDM & "'", 4, 0, 2)
    If Not yyxma_rec.BOF Then
        yyxma_rec.MoveLast
        yyxma_rec.MoveFirst
        
        yyxma_rec.FindFirst "TRIM(LBMC_ZW)='酒水'"
        If Not yyxma_rec.NoMatch Then
            jstj_lbdma = jstj_lbdma & Trim(yyxma_rec.Fields("LBDMA"))
        End If
        yyxma_rec.FindFirst "TRIM(LBMC_ZW)='香烟'"
        If Not yyxma_rec.NoMatch Then
            jstj_lbdma = jstj_lbdma & "," & Trim(yyxma_rec.Fields("LBDMA"))
        End If
    End If
    yyxma_rec.Close
    
    If Trim(jstj_lbdma) = "" Then
        Call MsgBox("本部门目前无酒水, 香烟项目")
    Else
        temp_rq = InputBox("统计日期:", "酒水统计", Date)
        Do While True
            If IsDate(temp_rq) Then
                If CDate(temp_rq) <= Date Then
                    Exit Do
                End If
            End If
            temp_rq = InputBox("重新输入正确的统计日期:", "酒水统计", Date)
        Loop
        
        temp_ft = False
        Set jstj_rec = PUB_data.OpenRecordset("SELECT * FROM CT_JSTJ WHERE TRIM(GWDM)='" & SYS_GWDM & "' AND FSRQ=#" & temp_rq & "#", 2, 0, 2)
        If Not jstj_rec.BOF Then
            jstj_rec.MoveLast
            
            If MsgBox(temp_rq & "已经统计过酒水, 是否重新统计酒水?", vbOKCancel, SYS_GWMC) = vbOK Then
                temp_ft = True
                            
                Do
                    temp_lock = Pub_lock("CT", "CT_JSTJ", jstj_rec)
                Loop Until temp_lock <> 0
                Select Case temp_lock
                Case 1
                    jstj_rec.Delete
                Case 2
                End Select
                Call Pub_UNlock("CT_JSTJ", jstj_rec)
            End If
        Else
            temp_ft = True
        End If
        
        If temp_ft Then
            
            Set ctzy_rec = PUB_data.OpenRecordset("SELECT JSRQ AS FSRQ,BHA,ZWMC,YWMC,DJ,SUM(SL) AS SL,SUM(SJJE) AS SJJE FROM ZY" & year(temp_rq) & " WHERE TRIM(GWDM)='" & Trim(SYS_GWDM) & "' AND JSRQ=#" & temp_rq & "# AND INSTR('" & jstj_lbdma & "',LBDMA) GROUP BY BHA", 4, 0, 2)
            If Not ctzy_rec.BOF Then
                ctzy_rec.MoveLast
                ctzy_rec.MoveFirst
                
                t_czlsh = Pub_czls(PUB_data, "CT_JSTJ", Time(), pub_code)
                
                Do While Not ctzy_rec.EOF
                    jstj_rec.AddNew
                        jstj_rec.Fields("FSRQ") = ctzy_rec.Fields("FSRQ")
                        jstj_rec.Fields("BHA") = ctzy_rec.Fields("BHA")
                        jstj_rec.Fields("ZWMC") = ctzy_rec.Fields("ZWMC")
                        jstj_rec.Fields("YWMC") = ctzy_rec.Fields("YWMC")
                        jstj_rec.Fields("DJ") = ctzy_rec.Fields("DJ")
                        jstj_rec.Fields("SL") = ctzy_rec.Fields("SL")
                        jstj_rec.Fields("SJJE") = ctzy_rec.Fields("SJJE")
                        jstj_rec.Fields("GWDM") = Trim(SYS_GWDM)
                        jstj_rec.Fields("GWMC") = Trim(SYS_GWMC)
                        jstj_rec.Fields("CZY") = SYS_USER
                        jstj_rec.Fields("LOCK_NO") = 0
                    jstj_rec.Update
                    
                    ctzy_rec.MoveNext
                Loop
                Call Pub_czle(PUB_data, t_czlsh, SYS_GWDM & " " & SYS_GWMC & "酒水统计成功", Time(), pub_code)
            End If
            ctzy_rec.Close
        
        End If
        
        jstj_rec.Close
         
    End If
End Sub