frm_main.frm

ktv场所的包房开房、迎宾、预定管理系统。

                    frm_account.Show
                Else
                    MsgBox "此桌号客人还未开单！", vbInformation, "未开单"
                    Exit Sub
                End If
            End If
        Case 119
           frm_room.Show
        Case 120
            If frmMain.Toolbar1.Buttons(12).Enabled = True And frmno = 1 Then
                daima_on = Trim(frm_main.msglist.TextMatrix(frm_main.msglist.row, 1))
                TxtSQL = "select * from roominfo where room_number='" & daima_on & "'"
                TxtSQL = TxtSQL & " and user_flag=0"
                Set mrc = ExecuteSQL(TxtSQL, msgtext)
                If Not mrc.EOF Then
                    yesno = MsgBox("确认要预订吗?", vbYesNo, "提示")
                    If yesno = vbYes Then
                        TxtSQL = "update roominfo set user_flag=-1"
                        TxtSQL = TxtSQL & " where val(room_number)=" & Val(daima_on)
                        Set mrc = ExecuteSQL(TxtSQL, msgtext)
                        MsgBox "预订成功！", vbOKOnly, "提示"
                        Command1_Click
                    End If
                Else
                    MsgBox "此桌号不能预订！", vbInformation, "提示"
                    Exit Sub
                End If
            End If
        Case 121
            Command1_Click
'        Case 122
'            ru = MsgBox("确认退出?", 33, "退出")
'            If ru = 2 Then
'                Exit Sub
'            End If
'            End
    End Select
End Sub
Private Sub Form_Load()
Dim texttxt As String
Dim num As Integer

    showtitle
    Me.Label1.Caption = struserinfoname & "吧台销售"
    Me.Label1.Left = Me.width / 2 - Me.Label1.width / 2 + 1000
    TxtSQL = "select room_number,room_name,employee_id,starttime,planpeoplecount,user_flag,supplier_id,roomcount,yd_flag from"
    TxtSQL = TxtSQL & " roominfo"
    TxtSQL = TxtSQL & " order by 1"
    Call ShowData(msglist)
    Call ShowTitle_info(flx_info)
    msglist_Click
    checkplanopentodaysalesflag
End Sub
Private Sub checkplanopentodaysalesflag()
    Dim temp As ADODB.Recordset
    On Error Resume Next
    sql$ = "update room_yd set flag_yd=false where (time_yd -#" & (Now() - 10 / (24 * 60)) & "#<=0) and flag_yd=true"
'    myDB.Execute sql$
    Set temp = ExecuteSQL(TxtSQL, msgtext)
End Sub
Public Sub showtitle()
    Dim i As Integer
    
    With msglist
        .Cols = 8
        .rows = 11
        .TextMatrix(0, 0) = "序号"
        .TextMatrix(0, 1) = "包厢号"
        .TextMatrix(0, 2) = "名称"
        .TextMatrix(0, 3) = "时间"
        .TextMatrix(0, 4) = "人数"
        .TextMatrix(0, 5) = "服务员"
        .TextMatrix(0, 6) = "状态"
        .TextMatrix(0, 7) = "序号"
        
        '固定表头
        .FixedRows = 1
                
        '设置各列的对齐方

        For i = 1 To 7
            .ColAlignment(i) = 4
        Next i
        
        '表头项居中
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        .RowSel = 1
        .ColSel = .Cols - 1
        .CellAlignment = 4
        
        '设置单元大小
        .colWidth(0) = 500
        .colWidth(1) = 900
        .colWidth(2) = 1000
        .colWidth(3) = 1100
        .colWidth(4) = 600
        .colWidth(5) = 600
        .colWidth(6) = 800
        .colWidth(7) = 800
        .row = 1
    End With
End Sub

Public Sub ShowData(list1 As Object)
    Dim mytempds As ADODB.Recordset
    Dim j As Integer
    Dim i As Integer
    Dim sql$

  
    Set mrc = ExecuteSQL(TxtSQL, msgtext)
        With list1
        .rows = 1
        j = .rows
        Do While Not mrc.EOF
            .rows = .rows + 1
            .TextMatrix(.rows - 1, 0) = .rows - 1
            .TextMatrix(.rows - 1, 1) = mrc.Fields(0) & ""
            .TextMatrix(.rows - 1, 2) = mrc.Fields(1) & ""
            Select Case mrc.Fields("user_flag")
              Case 1
                .TextMatrix(.rows - 1, 3) = Format(mrc.Fields(3) & "", "dd hh:mm")
                .TextMatrix(.rows - 1, 4) = mrc.Fields(4) & ""
                .TextMatrix(.rows - 1, 5) = mrc.Fields(2) & ""
                .TextMatrix(.rows - 1, 6) = "占用"
                .TextMatrix(.rows - 1, 7) = mrc.Fields(7) & ""
                For i = 1 To .Cols - 1
                    .col = i
                    .row = j
                    .CellForeColor = &HFF&
                Next i
                j = j + 1
              Case -1
                .TextMatrix(.rows - 1, 3) = ""
                .TextMatrix(.rows - 1, 4) = ""
                .TextMatrix(.rows - 1, 5) = ""
                .TextMatrix(.rows - 1, 6) = "预订"
                .TextMatrix(.rows - 1, 7) = ""
                For i = 1 To .Cols - 1
                    .col = i
                    .row = j
                    .CellForeColor = vbBlue
                Next i
                j = j + 1
              Case -2
                .TextMatrix(.rows - 1, 3) = ""
                .TextMatrix(.rows - 1, 4) = ""
                .TextMatrix(.rows - 1, 5) = ""
                .TextMatrix(.rows - 1, 6) = "修整"
                .TextMatrix(.rows - 1, 7) = ""
                For i = 1 To .Cols - 1
                    .col = i
                    .row = j
                    .CellForeColor = &HFF00FF
                Next i
                j = j + 1
              Case 0
                .ForeColor = &H0&
                .TextMatrix(.rows - 1, 3) = ""
                .TextMatrix(.rows - 1, 4) = ""
                .TextMatrix(.rows - 1, 5) = ""
                .TextMatrix(.rows - 1, 6) = "空闲"
                .TextMatrix(.rows - 1, 7) = ""
                j = j + 1
           End Select
           mrc.MoveNext
        Loop
        .row = 1
        .col = 1
    End With
    mrc.Close
End Sub


Public Sub ShowTitle_info(list1 As Object)
    Dim i As Integer
    
    With flx_info
        .Cols = 7
        .rows = 11
        .TextMatrix(0, 0) = "序号"
        .TextMatrix(0, 1) = "编号"
        .TextMatrix(0, 2) = "名称"
        .TextMatrix(0, 3) = "单价"
        .TextMatrix(0, 4) = "数量"
        .TextMatrix(0, 5) = "金额"
        .TextMatrix(0, 6) = "单号"
        '固定表头
        .FixedRows = 1
                
        '设置各列的对齐方

        For i = 1 To 6
            .ColAlignment(i) = 2
        Next i
        
        '表头项居中
        .FillStyle = flexFillRepeat
        .col = 0
        .row = 0
        .RowSel = 1
        .ColSel = .Cols - 1
        .CellAlignment = 4
        
        '设置单元大小
        .colWidth(0) = 500
        .colWidth(1) = 700
        .colWidth(2) = 1800
        .colWidth(3) = 700
        .colWidth(4) = 600
        .colWidth(5) = 800
        .colWidth(6) = 600
'        .ColWidth(7) = 800
'        .ColWidth(8) = 800
        .row = 1
    End With
    For i = 1 To 10
        With flx_info
        .row = i
        .col = 3
        .CellBackColor = &HC0FFFF
        .col = 5
        .CellBackColor = &HC0FFFF
        End With
    Next i
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Cancel = True
End Sub

Private Sub msglist_Click()
Dim intcount As Integer

    If msglist.rows > 1 Then
       intcount = msglist.row
       TxtSQL = "select p_id,product_name,price,qty,finalprice,djnumber from sale_temp "
       TxtSQL = TxtSQL & " where room_number= '" & Trim(msglist.TextMatrix(intcount, 1)) & "'"
       TxtSQL = TxtSQL & " and okflag=true"
       TxtSQL = TxtSQL & " order by p_id"
       'Call ShowTitle_info(flx_info)
       Call ShowData_flx_info(flx_info)
    Else
        flx_info.Visible = False
    End If
End Sub
Public Sub ShowData_flx_info(list1 As Object)
    Dim j As Integer
    Dim i As Integer
    Dim total As Double
  
    Set mrc = ExecuteSQL(TxtSQL, msgtext)
    'If mrc.EOF Then
        'list1.Visible = False
    'Else
        'list1.Visible = True
        'flx_info.Clear
        With list1
        .rows = 1
        total = 0
        Do While Not mrc.EOF
            .rows = .rows + 1
            .TextMatrix(.rows - 1, 0) = .rows - 1
            .row = .rows - 1
            .col = 3
            .CellBackColor = &HC0FFFF
            .col = 5
            .CellBackColor = &HC0FFFF
            For i = 1 To mrc.Fields.Count
                Select Case mrc.Fields(i - 1).Type
                    
                    Case adDBDate
                    
                        .TextMatrix(.rows - 1, i) = Format(mrc.Fields(i - 1) & "", "yyyy-mm-dd")
                    Case Else
                        .TextMatrix(.rows - 1, i) = mrc.Fields(i - 1) & ""
                End Select
            Next i
            total = total + Val(.TextMatrix(.rows - 1, 5))
            mrc.MoveNext
        Loop
        .rows = .rows + 1
        .TextMatrix(.rows - 1, 1) = "合计"
        .TextMatrix(.rows - 1, 5) = "" & total
        .row = 1
        .col = 1
        End With
    'End If
    mrc.Close
End Sub


Private Sub msglist_KeyPress(KeyAscii As Integer)
Dim intcount As Integer

If KeyAscii = 13 Then
    If msglist.rows > 1 Then
       intcount = msglist.row
       TxtSQL = "select p_id,product_name,price,qty,finalprice,djnumber from sale_temp "
       TxtSQL = TxtSQL & " where room_number= '" & Trim(msglist.TextMatrix(intcount, 1)) & "'"
       TxtSQL = TxtSQL & " order by p_id"
       'Call ShowTitle_info(flx_info)
       Call ShowData_flx_info(flx_info)
    Else
        flx_info.Visible = False
    End If
End If
End Sub


Private Sub Text1_Change()
Dim m, j, i As Integer

        m = 0
        With msglist
            For i = 1 To .rows - 1
                For j = 1 To Len(Trim(Me.Text1.text))
                    If Mid(Trim(.TextMatrix(i, 1)), j, 1) = UCase(Mid(Trim(Text1.text), j, 1)) Then
                        If j > m Then
                            .col = 1
                            .row = i
                            .TopRow = i
                            m = j
                        End If
                    Else
                        Exit For
                    End If
                Next j
            Next i
        End With

End Sub