modmain.bas

餐饮管理系统数据库设计文档 表名：bzqbj（保质期报警表） 字段名 字段类型 字段长度 （0表示不允许NULL

    
    Call ExeSQLByCmd(strsql)
    
    For i = 0 To 9999
        If lylsl(i) < lminalert(i) Then
            strsql = "insert into kcslbj (ylid,ylmc,kcsl,minalert,maxalert,flag) values('"
            strsql = strsql & sylid(i) & "','"
            strsql = strsql & sylmc(i) & "',"
            strsql = strsql & lylsl(i) & ","
            strsql = strsql & lminalert(i) & ","
            strsql = strsql & lmaxalert(i) & ",0)"
            Call ExeSQLByCmd(strsql)
'            strmsg = "编码为<" & sylid(i) & ">的物品<" & sylmc(i) & ">库存中数量为<"
'            strmsg = strmsg & CStr(lylsl(i)) & ">,低于警戒数量<" & CStr(lminalert(i)) & ">!"
'            MsgBox strmsg, vbInformation, "库存警告"
        ElseIf lylsl(i) > lmaxalert(i) Then
            strsql = "insert into kcslbj (ylid,ylmc,kcsl,minalert,maxalert,flag) values('"
            strsql = strsql & sylid(i) & "','"
            strsql = strsql & sylmc(i) & "',"
            strsql = strsql & lylsl(i) & ","
            strsql = strsql & lminalert(i) & ","
            strsql = strsql & lmaxalert(i) & ",1)"
            Call ExeSQLByCmd(strsql)
'            strmsg = "编码为<" & sylid(i) & ">的物品<" & sylmc(i) & ">库存中数量为<"
'            strmsg = strmsg & CStr(lylsl(i)) & ">,高于警戒数量<" & CStr(lmaxalert(i)) & ">!"
'            MsgBox strmsg, vbInformation, "库存警告"
        End If
    Next
End Sub

'*************************************************************************************
'*************************************************************************************
'得到当前库存的保质期警告信息
'*************************************************************************************
Public Function GetKCBZQAlert()

    Dim rs As ADODB.Recordset
    Dim strsql As String
    Dim i As Long
    Dim ddiff As Long
    Dim strmsg As String
    
    Call GetKcValue
    For i = 0 To 9999
        lbzqflag(i) = 1
    Next
    
    strsql = "select * from rkjl where sl>0"
    
    Set rs = GetRsBySQL(strsql)
    
    If rs.RecordCount = 0 Then Exit Function
    
    For i = 0 To rs.RecordCount - 1
        ddiff = DateDiff("d", rs("gmsj"), Date)
        If ddiff >= lbzyj(GetiByylid(rs("gmsp"))) Then
            lbzdd(GetiByylid(rs("gmsp"))) = lbzq(GetiByylid(rs("gmsp"))) - ddiff + 1
            lbzqflag(GetiByylid(rs("gmsp"))) = 0
        End If
        rs.MoveNext
    Next
    
    rs.Close
    Set rs = Nothing

    strsql = "delete from bzqbj"
    Call ExeSQLByCmd(strsql)

    For i = 0 To 9999
        If lbzqflag(i) = 0 And sylid(i) <> "" Then
            strsql = "insert into bzqbj (ylid,ylmc,diffbzq,diffbzqyj,bzq) values ('"
            strsql = strsql & sylid(i) & "','"
            strsql = strsql & sylmc(i) & "',"
            strsql = strsql & lbzdd(i) & ","
            strsql = strsql & lbzyj(i) & ","
            strsql = strsql & lbzq(i) & ")"
            
            Call ExeSQLByCmd(strsql)
'            strmsg = "编码为<" & sylid(i) & ">的物品<" & sylmc(i) & ">距离保质期还有<"
'            strmsg = strmsg & CStr(lbzdd(i)) & ">,超过保质期警戒<" & CStr(lbzyj(i)) & ">!"
'            MsgBox strmsg, vbInformation, "保质期警告"
        End If
    Next
End Function

Public Function IsAlert() As Boolean
On Error GoTo err_isalert
    Dim rs As ADODB.Recordset
    Dim strsql As String
    
    IsAlert = False
    strsql = "select * from kcslbj"
    Set rs = GetRsBySQL(strsql)
    
    If rs.RecordCount > 0 Then
        IsAlert = True
    End If

    rs.Close
    Set rs = Nothing
    
    strsql = "select * from bzqbj"
    Set rs = GetRsBySQL(strsql)
    
    If rs.RecordCount > 0 Then
        IsAlert = True
    End If
    rs.Close
    Set rs = Nothing
    Exit Function
err_isalert:
    IsAlert = False
End Function

Public Sub AlertKCSL()
'on error resume next
    Dim rs As ADODB.Recordset
    Dim strsql As String
    Dim strmsg As String
    Dim i As Long
    
    strsql = "select * from kcslbj"
    
    Set rs = GetRsBySQL(strsql)
    
    If rs.RecordCount = 0 Then GoTo NO_KCSLBJ
    
    For i = 0 To rs.RecordCount - 1
        If rs("flag") = 0 Then
            strmsg = "编码为<" & rs("ylid") & ">的物品<" & rs("ylmc") & ">库存中数量为<"
            strmsg = strmsg & CStr(rs("kcsl")) & ">,低于警戒数量<" & CStr(rs("minalert")) & ">!"
        Else
            strmsg = "编码为<" & rs("ylid") & ">的物品<" & rs("ylmc") & ">库存中数量为<"
            strmsg = strmsg & CStr(rs("kcsl")) & ">,高于警戒数量<" & CStr(rs("maxalert")) & ">!"
        End If
        MsgBox strmsg, vbInformation, "库存数量报警"
        rs.MoveNext
    Next
    
NO_KCSLBJ:
    rs.Close
    
    strsql = "select * from bzqbj"
    
    Set rs = GetRsBySQL(strsql)
    
    If rs.RecordCount = 0 Then Exit Sub
    
    For i = 0 To rs.RecordCount - 1
        strmsg = "编码为<" & rs("ylid") & ">的物品<" & rs("ylmc") & ">距离保质期还有<"
        strmsg = strmsg & CStr(rs("diffbzq")) & ">,超过保质期警戒<" & CStr(rs("diffbzqyj")) & ">!"
        
        MsgBox strmsg, vbInformation, "保质期报警"
        rs.MoveNext
    Next
    
    rs.Close
    
    Set rs = Nothing
End Sub



Public Function setGrdPicture(ByRef fgd As MSFlexGrid, ByVal lrow As Long, ByVal lcol As Long, ByVal kbn As String, ByVal txt As String) As Boolean
On Error GoTo errProc
    setGrdPicture = False
    With fgd
        .row = lrow
        .Col = lcol
        .RowHeight(lrow) = 1000
        .ColWidth(lcol) = 1000
        .CellPictureAlignment = flexAlignCenterTop
        .CellAlignment = flexAlignCenterBottom
        .Text = txt
        Select Case kbn
            Case "ROOM_USE"
                Set .CellPicture = LoadPicture(App.Path & "\images\table2.bmp")
            Case "ROOM_NO_USE"
                Set .CellPicture = LoadPicture(App.Path & "\images\table1.bmp")
            Case "ROOM_YD"
                Set .CellPicture = LoadPicture(App.Path & "\images\table3.bmp")
        End Select
    End With
    setGrdPicture = True
errProc:
End Function

Public Function getTableStatus_time(ByVal tbl_id As String) As Long
    On Error GoTo errProc
    Dim rs As New ADODB.Recordset
    Dim wksql As String
    getTableStatus_time = -1
    wksql = "SELECT * FROM YDFW "
    wksql = wksql & " WHERE zwbh=" & tbl_id
    Set rs = GetRsBySQL(wksql)
    If rs.RecordCount <= 0 Then Exit Function
    getTableStatus_time = DateDiff("n", Now, CDate(rs!ydsj))
    Exit Function
errProc:
    
End Function
Public Function updateWorkStatus_ZT(ByVal tbl_id As String, ByVal mode As Integer) As Boolean
    On Error GoTo errProc
    Dim wksql As String
    updateWorkStatus_ZT = False
    wksql = "UPDATE WORKSTATUS SET"
    wksql = wksql & " DQZT=" & mode
'    wksql = wksql & ",dqrs=5"
    wksql = wksql & " WHERE ID=" & tbl_id
    If ExeSQLByCmd(wksql) = False Then Exit Function
    updateWorkStatus_ZT = True
    Exit Function
errProc:
End Function
Public Function NONULL(ByVal str As Field) As String
    If IsNull(str) Then
        NONULL = ""
    Else
        NONULL = str
    End If
End Function

Public Function IsGZAlert() As Boolean
On Error GoTo err_isgzalert
    Dim rs As ADODB.Recordset
    Dim strsql As String
    Dim i As Long
    
    IsGZAlert = False
    
    strsql = "select dwmc,bz,dqrs,ssje,jssj,cdlb from jzls,yxlsb,jzdw"
    strsql = strsql & " where xm=dwmc and jsdh=cdlb and sffk=0"
'    strsql = strsql & " and datediff(day,jssj,'" & dtpyskx_s & "')<=0"
'    strsql = strsql & " and datediff(day,jssj,'" & dtpyskx_e & "')>=0"
    strsql = strsql & " and datediff(day,jssj,'" & Date & "')>=bz"
    strsql = strsql & " order by dwmc,dqrs,ssje,jssj,cdlb"

    Set rs = GetRsBySQL(strsql)
    
    If rs.RecordCount > 0 Then
        IsGZAlert = True
    End If
       
Exit Function
err_isgzalert:
    IsGZAlert = False
End Function

Public Function IsExistEj(ByVal id As Integer, ByVal strylid As String) As Boolean
On Error GoTo err_isexistej
    Dim rs As ADODB.Recordset
    Dim strsql As String
    
    If id = 1 Then              '酒库
        strsql = "select * from jkkcb where ylid='" & strylid & "'"
    ElseIf id = 2 Then          '冷库
        strsql = "select * from lkkcb where ylid='" & strylid & "'"
    End If
        
    Set rs = GetRsBySQL(strsql)
    
    If rs.RecordCount = 0 Then
        IsExistEj = False
    Else
        IsExistEj = True
    End If
    
    rs.Close
    Set rs = Nothing
Exit Function
err_isexistej:
    IsExistEj = False
End Function

Public Function GetAllJid() As Boolean
On Error GoTo err_getalljid
    Dim strsql As String
    Dim i As Long
    Dim rs As ADODB.Recordset
    
    strsql = "select * from jkkcb"
    
    If rs.RecordCount = 0 Then GoTo err_getalljid
    
    For i = 0 To rs.RecordCount - 1
        m_sjylid(i) = rs("ylid")
        
        rs.MoveNext
    Next
    


    GetAllJid = True
Exit Function
err_getalljid:
    GetAllJid = False
End Function