frmdc.frm

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

On Error GoTo errProc
    insertXfcdb = False
    wksql = "INSERT INTO XFCDB(cm,sl,dh,zh,bz,fjfy) "
    wksql = wksql & " VALUES('"
    wksql = wksql & dcls(l).id
    wksql = wksql & "'," & dcls(l).suu
    wksql = wksql & ",'" & dhCode & "'"
    wksql = wksql & ",'" & m_autoId & "'"
    wksql = wksql & ",0," '未结帐标志
    wksql = wksql & Val(txtfjfy)
    wksql = wksql & ")"
    If ExeSQLByCmd(wksql) = False Then Exit Function
    insertXfcdb = True
    Exit Function
errProc:
    Err.Clear
End Function
Private Function updateXfcdb(l) As Boolean
    Dim wksql As String
    Dim id As String
    updateXfcdb = False
On Error GoTo errProc:
    wksql = "UPDATE  XFCDB SET"
    wksql = wksql & " fjfy=" & Val(txtfjfy) & ","
    If m_runMode = 0 Or m_runMode = 2 Then
        wksql = wksql & " SL=SL+" & dcls(l).suu
    ElseIf m_runMode = 1 Then
        wksql = wksql & " SL=" & dcls(l).suu
    End If
    wksql = wksql & " WHERE  CM= '" & dcls(l).id
    wksql = wksql & "' AND ZH=" & m_autoId
    If m_runMode = 0 Or m_runMode = 1 Then
        wksql = wksql & " AND LEFT(DH,2)='DC'"
    ElseIf m_runMode = 2 Then
        wksql = wksql & " AND LEFT(DH,2)='ZS'"
    End If
    If ExeSQLByCmd(wksql) = False Then Exit Function
    updateXfcdb = True
    Exit Function
errProc:
End Function
Private Function checkXfcdb(ByVal l As Long, Optional flg As Boolean = False) As Boolean
'FLG=false : 检查是否该桌台点过菜,如果点过则点菜单号已经产生
'FLG=TRUE  : 检查是否该桌台已经点过某道菜
    Dim wksql As String
    Dim rs As New ADODB.Recordset
On Error GoTo errProc:
    checkXfcdb = False
    wksql = "SELECT * FROM XFCDB"
    wksql = wksql & " WHERE ZH=" & m_autoId
    If flg = True Then
        wksql = wksql & " AND CM='" & dcls(l).id & "'"
    End If
    If m_runMode = 0 Or m_runMode = 1 Then
        wksql = wksql & " AND LEFT(DH,2)='DC'"
    ElseIf m_runMode = 2 Then
        wksql = wksql & " AND LEFT(DH,2)='ZS'"
    End If

    Set rs = GetRsBySQL(wksql)
    If rs.RecordCount <= 0 Then Exit Function
    If flg = False Then dhCode = rs!dh
    checkXfcdb = True
    Exit Function
errProc:
End Function
Private Sub Form_Activate()
    Call initFld
    Call SetPropFgd(GrdMenu_dc)
     '点菜或退菜时从XFCDB读出点了什么菜 单号=DC***
     '赠送时从XFCDB读出点了什么菜 单号=ZS***
    Call getDataFromXf
    
    Call createData
    
End Sub

Private Sub Form_Load()
    ReDim dcls(0) As Menu
    
    bFlag = False

End Sub
Public Function createData() As Boolean '父节点添加
On Error GoTo errProc
    Dim i, j As Long
    Dim wksql As String
    Dim rs As New ADODB.Recordset
    createData = False
    Dim nodX As Node
    Dim NodeText   As String
    wksql = "SELECT * FROM TYPELIST "
    If m_cjKbn = 0 Then
        wksql = wksql & " WHERE parentid=2" '菜系大分类
    Else
        wksql = wksql & " WHERE parentid=4" '菜系大分类
    End If
    wksql = wksql & " ORDER BY ID "
    Set rs = GetRsBySQL(wksql)
    If rs.RecordCount <= 0 Then
        'MsgBox "菜单信息未建立,请先添加大分类!", vbInformation, "信息提示"
        Exit Function
    End If
    NodeText = "菜单"
    Set nodX = TrvPs_dc.Nodes.Add(, tvwFirst, "NO" & "0", NodeText)
    nodX.Tag = ""
    For i = 1 To rs.RecordCount
        NodeText = rs!lbname
        Set nodX = TrvPs_dc.Nodes.Add(, tvwNext, "NO" & i, NodeText)
        nodX.Tag = Val(rs!id)
        'Call createDataBoy("", "NO" & i, rs!id)
        Call createDataBoy("", "NO" & i, rs!lbname)         'Jassonhan modified.
        rs.MoveNext
    Next
'    TrvPs_dc.Nodes(TrvPs_dc.Nodes.Count).EnsureVisible
    If rs.State <> adStateClosed Then rs.Close
    Set rs = Nothing
    createData = True
    Exit Function
errProc:
    If rs.State <> adStateClosed Then rs.Close
    Set rs = Nothing
    If Err.Number <> 0 Then Err.Clear
End Function

Public Function createDataBoy(NoFa As String, NoBoy As String, ByVal id As String) As Boolean '子节点添加
On Error GoTo errProc
    Dim i, j As Long
    Dim wksql As String
    Dim rs As New ADODB.Recordset
    createDataBoy = False
    Dim nodX As Node    '惡柧 Node
    Dim NodeText   As String
    Dim M_Nofa As String
    Dim l As Long
    wksql = "SELECT * FROM CDB "
    'wksql = wksql & " WHERE lbbh=" & id
    wksql = wksql & " WHERE dlmc='" & id & "'"      'Jassonhan modified.
    Set rs = GetRsBySQL(wksql)
    If rs.RecordCount <= 0 Then
        Set rs = Nothing
        createDataBoy = True
        Exit Function
    End If
    NodeText = ""
    M_Nofa = NoBoy
    l = UBound(dcls)
    ReDim Preserve dcls(l + rs.RecordCount) As Menu
    For i = 1 To rs.RecordCount
        dcls(l + i).id = rs!id
        dcls(l + i).name = rs!mc
        dcls(l + i).suu = 0
        dcls(l + i).sum = 0
        If rs!sftj = 0 Then
            dcls(l + i).flg = False
            dcls(l + i).tank = rs!price
        Else
            dcls(l + i).flg = True
            dcls(l + i).tank = rs!tj
        End If
        dcls(l + i).mode = 0
        NoBoy = M_Nofa & "-" & i
        NodeText = rs!mc
        Set nodX = TrvPs_dc.Nodes.Add(M_Nofa, 4, NoBoy, NodeText)
        nodX.Tag = rs!id
'        If createDataBoy(NoBoy, NoBoy, (Dmltk!LTKROTTOBANGOU), (Dmltk!LTKROTKBN)) = False Then Exit Function
NextData:
        rs.MoveNext
    Next
    If rs.State <> adStateClosed Then rs.Close
    Set rs = Nothing
    
    createDataBoy = True
    Exit Function
errProc:
    If rs.State <> adStateClosed Then rs.Close
    Set rs = Nothing
    If Err.Number <> 0 Then Err.Clear
End Function

Private Sub GrdMenu_dc_Click()
    remove_tag = GrdMenu_dc.TextMatrix(GrdMenu_dc.row, 0)
End Sub

Private Sub GrdMenu_dc_DblClick()
    Call removeCai
End Sub

Private Sub removeCai()
    Dim l As Long
    Dim j As Long
    Dim k As Long
    Dim i As Long
    Dim lrow As Long
    Dim strsql As String
    
'    '******************************************
'    '未落单退酒时,需要改变酒库库存
'    With GrdMenu_dc
'        For i = 0 To 9999
'            If .TextMatrix(.RowSel, 0) = sjylid(i) Then
'                strsql = "update jkkcb set sl=sl+1 where ylid='" & sjylid(i) & "'"
'
'                Call ExeSQLByCmd(strsql)
'                Exit For
'            End If
'        Next
'    End With
'
'    '******************************************
    
    For l = 1 To UBound(dcls)
        If dcls(l).id = remove_tag And ((m_runMode <> 1 And dcls(l).mode = 0) Or (m_runMode = 1 And dcls(l).mode = 1)) Then
            ' and()中前一种为点菜模式,后一种为退菜模式
            If m_runMode = 0 Then
                If dcls(l).mode = 1 Then Exit Sub '点菜模式不能退已落单的菜
                If dcls(l).suu <= 0 Then Exit Sub
            End If
'            If m_runMode = 1 Then If dcls(l).mode = 0 Then Exit Sub
            lrow = dcls(l).row
            dcls(l).suu = dcls(l).suu - 1
            dcls(l).sum = dcls(l).sum - dcls(l).tank
            If dcls(l).suu > 0 Then
                GrdMenu_dc.TextMatrix(lrow - 1, 2) = Format(dcls(l).suu, sfmtc)
                GrdMenu_dc.TextMatrix(lrow - 1, 4) = Format(dcls(l).sum, kfmtc)
            Else
                For j = lrow - 1 To GrdMenu_dc.Rows - 2
                    For k = 0 To GrdMenu_dc.Cols - 1
                        GrdMenu_dc.TextMatrix(j, k) = GrdMenu_dc.TextMatrix(j + 1, k)
                    Next
                Next
                For j = 0 To UBound(dcls)
                    If dcls(j).row > lrow Then
                        dcls(j).row = dcls(j).row - 1
                    End If
                Next
                GrdMenu_dc.Rows = GrdMenu_dc.Rows - 1
            End If
            sumkin = sumkin - dcls(l).tank
            TxtSum_dc = Format(sumkin, kfmtc)
        End If
    Next
End Sub
Private Sub addCai()
    Dim l As Long
    Dim lrow As Long
    Dim strsql As String
    
    For l = 1 To UBound(dcls)
        
        If dcls(l).id = node_tag And dcls(l).mode = 0 Then
            
            If dcls(l).suu <= 0 Then
                lrow = GrdMenu_dc.Rows + 1
                GrdMenu_dc.Rows = lrow
                dcls(l).row = lrow
            Else
                lrow = dcls(l).row
            End If
            dcls(l).suu = dcls(l).suu + 1
            dcls(l).sum = dcls(l).sum + dcls(l).tank
            dcls(l).mode = 0
            
            GrdMenu_dc.TextMatrix(lrow - 1, 0) = dcls(l).id
            GrdMenu_dc.TextMatrix(lrow - 1, 1) = dcls(l).name
            GrdMenu_dc.TextMatrix(lrow - 1, 2) = Format(dcls(l).suu, sfmtc)
            GrdMenu_dc.TextMatrix(lrow - 1, 3) = Format(dcls(l).tank, kfmtc)
            GrdMenu_dc.TextMatrix(lrow - 1, 4) = Format(dcls(l).sum, kfmtc)
            If dcls(l).flg = True Then
                GrdMenu_dc.TextMatrix(lrow - 1, 5) = "是"
            Else
                GrdMenu_dc.TextMatrix(lrow - 1, 5) = "否"
            End If
            sumkin = sumkin + dcls(l).tank
            TxtSum_dc = Format(sumkin, kfmtc)
        End If
    Next
End Sub

Private Sub TrvPs_dc_DblClick()
    If m_runMode = 1 Then Exit Sub '退菜模式不能加菜
    Call addCai
    
    If bFlag = False Then
        iRows = GrdMenu_dc.Rows - 1
        bFlag = True
    End If
End Sub

Private Sub TrvPs_dc_NodeClick(ByVal Node As MSComctlLib.Node)
    If Node.Children > 0 Then
        node_tag = ""
        Exit Sub
    End If
    node_tag = Node.Tag
End Sub
Private Sub initFld()
    TxtSum_dc = Format(0, kfmtc)
    TxtDh_dc = ""
    TxtDh_dc.Enabled = False
    GrdMenu_dc.Rows = 1
    GrdMenu_dc.Cols = 6
    GrdMenu_dc.TextMatrix(0, 0) = "编号"
    GrdMenu_dc.TextMatrix(0, 1) = "菜名"
    GrdMenu_dc.TextMatrix(0, 2) = "数量"
    GrdMenu_dc.TextMatrix(0, 3) = "单价"
    GrdMenu_dc.TextMatrix(0, 4) = "合计"
    GrdMenu_dc.TextMatrix(0, 5) = "特价"
    dhCode = ""
    Call checkXfcdb(0, False)
    TxtDh_dc = dhCode
End Sub
Private Function getDataFromXf() As Boolean
    Dim wksql As String
    Dim rs As New ADODB.Recordset
    Dim l As Long
    
    sumkin = 0
    getDataFromXf = False
    wksql = "SELECT  XFcdb.*, price, mc, sftj,tj FROM XFcdb,cdb "
    wksql = wksql & " WHERE ZH=" & m_autoId
    wksql = wksql & " AND XFcdb.cm = cdb.id"
    If m_runMode = 0 Or m_runMode = 1 Then
        wksql = wksql & " AND LEFT(DH,2)='DC'"
    ElseIf m_runMode = 2 Then
        wksql = wksql & " AND LEFT(DH,2)='ZS'"
    End If
    Set rs = GetRsBySQL(wksql)
    If rs.RecordCount <= 0 Then Exit Function
    ReDim Preserve dcls(rs.RecordCount) As Menu
    sumkin = 0
    GrdMenu_dc.Rows = rs.RecordCount + 1
    For l = 1 To rs.RecordCount
        txtfjfy = Format(rs("fjfy"), "0.00")
    
        dcls(l).id = rs!cM
        dcls(l).name = rs!mc
        dcls(l).suu = rs!sl
        If rs!sftj = 0 Then
            dcls(l).flg = False
            dcls(l).tank = rs!price
        Else
            dcls(l).flg = True
            dcls(l).tank = rs!tj
        End If
        dcls(l).sum = dcls(l).suu * dcls(l).tank
        dcls(l).row = l + 1
        sumkin = sumkin + dcls(l).sum
        
        dcls(l).mode = 1
        With GrdMenu_dc
            .TextMatrix(l, 0) = dcls(l).id
            .TextMatrix(l, 1) = dcls(l).name
            .TextMatrix(l, 2) = Format(dcls(l).suu, sfmtc)
            .TextMatrix(l, 3) = Format(dcls(l).tank, kfmtc)
            .TextMatrix(l, 4) = Format(dcls(l).sum, kfmtc)
            If dcls(l).flg = False Then
                .TextMatrix(l, 5) = "否"
            Else
                .TextMatrix(l, 5) = "是"
            End If
        End With
        txtfjfy = Format(rs("fjfy"), "0.00")
        rs.MoveNext
    Next
    
    TxtSum_dc = Format(sumkin, kfmtc)
    getDataFromXf = True
End Function


Private Sub txtfjfy_GotFocus()
    txtfjfy.SelStart = 0
    txtfjfy.SelLength = Len(txtfjfy)
End Sub

Private Sub txtfjfy_LostFocus()
    If txtfjfy.Text = "" Then
        txtfjfy.Text = "0.00"
    End If
End Sub