frmhht.frm

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

    Unload Me
End Sub

Private Sub cmdSaveHt_Click()
    Dim l As Long
    Dim adocon As New ADODB.Connection
    Dim autoDh_DC As String
    Dim autoDh_zs As String
    If m_mode_ht = 0 Then '合台
        If GrdHtInfo.Rows <= 2 Then
            MsgBox "请至少选择两个桌号", vbInformation, "信息提示"
            Exit Sub
        End If
        Set adocon = OpenDB
        adocon.BeginTrans
        If getDh("DC", autoDh_DC) = False Then GoTo errProc1
        If getDh("ZS", autoDh_zs) = False Then GoTo errProc1
        For l = 1 To GrdHtInfo.Rows - 1
            If updateXfcdb_ht(GrdHtInfo.TextMatrix(l, 2), autoDh_DC, autoDh_zs) = False Then GoTo errProc1
        Next
        adocon.CommitTrans
        Call MsgBox("合台成功!", vbInformation, "信息提示")
        cmdClr_ht_Click
        Exit Sub
errProc1:
        adocon.RollbackTrans
        Call MsgBox("合台失败!", vbInformation, "信息提示")
    Else
        On Error GoTo ERRPROC2:
        
        If GrdHtInfo.Rows <> 3 Then
            MsgBox "请先选择好交换桌号和目标桌号", vbInformation, "信息提示"
            Exit Sub
        End If
        Set adocon = OpenDB
        adocon.BeginTrans
        If updateXfcdb_ht_CHANGE() = False Then GoTo ERRPROC2
        If updateWorkStatus_Change = False Then GoTo ERRPROC2
        adocon.CommitTrans
        Call MsgBox("换台成功!", vbInformation, "信息提示")
        cmdClr_ht_Click
        Call initFld_ht
        Call initFrm_Ht
        Exit Sub
ERRPROC2:
        adocon.RollbackTrans
        Call MsgBox("换台失败", vbInformation, "信息提示")
    End If
End Sub
Private Function updateXfcdb_ht_CHANGE() As Boolean
    updateXfcdb_ht_CHANGE = False
    Dim wksql As String
    Dim rs As ADODB.Recordset
    On Error GoTo errProc
    wksql = " UPDATE XFCDB SET"
    wksql = wksql & " ZH=" & GrdHtInfo.TextMatrix(2, 2)
    wksql = wksql & " WHERE ZH=" & GrdHtInfo.TextMatrix(1, 2)
    If ExeSQLByCmd(wksql) = False Then Exit Function
    updateXfcdb_ht_CHANGE = True
    Exit Function
errProc:
End Function
Private Function updateWorkStatus_Change() As Boolean
    updateWorkStatus_Change = False
    Dim wksql As String
    Dim rs As ADODB.Recordset
    On Error GoTo errProc
    '将交换桌号的设置为空闲状态
'    wksql = " UPDATE WORKSTATUS SET"
'    wksql = wksql & " DQZT=0 "
'    wksql = wksql & " WHERE ID=" & GrdHtInfo.TextMatrix(1, 2)
'    If ExeSQLByCmd(wksql) = False Then Exit Function
    If updateWorkStatus_ZT(GrdHtInfo.TextMatrix(1, 2), 0) = False Then Exit Function
    
    '将目标桌号的设置为有人状态
'    wksql = " UPDATE WORKSTATUS SET"
'    wksql = wksql & " DQZT=1 "
'    wksql = wksql & " WHERE ID=" & GrdHtInfo.TextMatrix(2, 2)
'    If ExeSQLByCmd(wksql) = False Then Exit Function
    If updateWorkStatus_ZT(GrdHtInfo.TextMatrix(2, 2), 1) = False Then Exit Function
    updateWorkStatus_Change = True
    Exit Function
errProc:
End Function
Private Function updateXfcdb_ht(ByVal ZHId As String, ByVal autoDh_DC As String, ByVal autoDh_zs As String) As Boolean
    updateXfcdb_ht = False
    Dim wksql As String
    Dim rs As ADODB.Recordset
    On Error GoTo errProc
    wksql = " UPDATE XFCDB SET"
    wksql = wksql & " DH='" & autoDh_DC & "'"
    wksql = wksql & " WHERE LEFT(DH,2)='DC' "
    wksql = wksql & " AND ZH=" & ZHId
    If ExeSQLByCmd(wksql) = False Then Exit Function
    wksql = " UPDATE XFCDB SET"
    wksql = wksql & " DH='" & autoDh_zs & "'"
    wksql = wksql & " WHERE LEFT(DH,2)='ZS' "
    wksql = wksql & " AND ZH=" & ZHId
    If ExeSQLByCmd(wksql) = False Then Exit Function
    updateXfcdb_ht = True
    Exit Function
errProc:
End Function

Private Sub cmdSel_Click()

End Sub

Private Sub cmdSel_HT_Click()
'    Static roomlist As Long
'    If roomlist = CboRoomList_ht.ListIndex Then Exit Sub
    Call getTableInfo_HT(CboRoomList_ht.ListIndex)
'    roomlist = CboRoomList_ht.ListIndex
End Sub

Private Sub fgdHT_Click()
    clickCount = fgdHT.row * rowCountht + fgdHT.Col + 1
End Sub
Private Sub fgdHT_DblClick()
    Dim minutes_HT As Long
    Dim l As Long
    On Error GoTo errProc
    If m_mode_ht = 0 Then '合台
        If clickCount > UBound(dcls_ht) Then Exit Sub
        If dcls_ht(clickCount).mode = 0 Then Exit Sub
        For l = 1 To GrdHtInfo.Rows - 1
            If GrdHtInfo.TextMatrix(l, 1) = dcls_ht(clickCount).zh Then Exit Sub
        Next
        GrdHtInfo.Rows = GrdHtInfo.Rows + 1
        GrdHtInfo.TextMatrix(GrdHtInfo.Rows - 1, 0) = "合并桌号"
        GrdHtInfo.TextMatrix(GrdHtInfo.Rows - 1, 1) = dcls_ht(clickCount).zh
        GrdHtInfo.TextMatrix(GrdHtInfo.Rows - 1, 2) = dcls_ht(clickCount).id
    Else
        If GrdHtInfo.Rows = 1 Then
            If dcls_ht(clickCount).mode = 0 Then Exit Sub
            GrdHtInfo.Rows = 2
            GrdHtInfo.TextMatrix(1, 0) = "改变桌号"
            GrdHtInfo.TextMatrix(1, 1) = dcls_ht(clickCount).zh
            GrdHtInfo.TextMatrix(1, 2) = dcls_ht(clickCount).id
        ElseIf GrdHtInfo.Rows = 2 Then
            If dcls_ht(clickCount).mode = 1 Then Exit Sub
            minutes_HT = getTableStatus_time(dcls_ht(clickCount).id)
            If minutes_HT <> -1 Then
                If MsgBox("此桌台已经预定,距离预定时间尚有" & minutes_JD & "分钟!是否继续?", vbOKCancel, "信息提示") = vbCancel Then Exit Sub
            End If
            GrdHtInfo.Rows = 3
            GrdHtInfo.TextMatrix(2, 0) = "目标桌号"
            GrdHtInfo.TextMatrix(2, 1) = dcls_ht(clickCount).zh
            GrdHtInfo.TextMatrix(2, 2) = dcls_ht(clickCount).id
            
        End If
    End If
errProc:
End Sub

Private Sub Form_Activate()
    Call initFld_ht
    Call initFrm_Ht
    Call SetPropFgd(GrdHtInfo)
End Sub
Private Sub initFrm_Ht()
    Dim wksql As String
    Dim rs As New ADODB.Recordset
    Dim l As Long
    wksql = "SELECT id,lbname FROM  TYPELIST"
    wksql = wksql & " WHERE parentid=1 "
    wksql = wksql & " ORDER BY ID"
    Set rs = GetRsBySQL(wksql)
    If rs.RecordCount <= 0 Then
        MsgBox "请先设置好房间信息", vbInformation, "信息提示"
        Unload Me
    End If
    ReDim RoomId_ht(rs.RecordCount) As Long
    CboRoomList_ht.Clear
    For l = 0 To rs.RecordCount - 1
        CboRoomList_ht.AddItem rs!lbname
        RoomId_ht(l) = rs!id
        rs.MoveNext
    Next
    CboRoomList_ht.ListIndex = 0
    Call getTableInfo_HT(CboRoomList_ht.ListIndex)
End Sub
Private Sub getTableInfo_HT(ByVal id As Long, Optional refresh_flg As Boolean = False)
    Dim wksql As String
    Dim l As Long
    Dim rs As New ADODB.Recordset
    Dim lrow As Long
    Dim lcol As Long
    Dim kbn As String
On Error GoTo errProc:
    lrow = 0
    lcol = 0
    fgdHT.Cols = 0
    fgdHT.Cols = rowCountht
    wksql = "SELECT * FROM WORKSTATUS "
    wksql = wksql & " WHERE fjbh=" & RoomId_ht(id)
    wksql = wksql & " ORDER BY ZH "
    Set rs = GetRsBySQL(wksql)
    If rs.RecordCount <= 0 Then Exit Sub
    fgdHT.Rows = (rs.RecordCount + rowCountht - 1) \ rowCountht
    ReDim dcls_ht(rs.RecordCount) As workStatus
    For l = 1 To rs.RecordCount
        kbn = IIf(rs!dqzt = 1, "ROOM_USE", "ROOM_NO_USE")
        Call setGrdPicture(fgdHT, lrow, lcol, kbn, rs!zh)
nexti:
        
        lcol = lcol + 1
        If lcol = rowCountht Then
            lcol = 0
            lrow = lrow + 1
        End If
        dcls_ht(l).id = rs!id
        dcls_ht(l).zh = rs!zh
        If rs!dqzt = 1 Then
            dcls_ht(l).mode = 1
        Else
            dcls_ht(l).mode = 0
        End If
        dcls_ht(l).kssj = ""
        dcls_ht(l).jssj = ""
        rs.MoveNext
    Next
    Exit Sub
errProc:
End Sub