frmdc.frm

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

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.Form frmDC 
   BackColor       =   &H00C0FFFF&
   BorderStyle     =   0  'None
   ClientHeight    =   6615
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   10320
   LinkTopic       =   "Form1"
   ScaleHeight     =   6615
   ScaleWidth      =   10320
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  '屏幕中心
   Begin VB.Frame Frame1 
      BackColor       =   &H00A56E3A&
      Height          =   6435
      Left            =   60
      TabIndex        =   0
      Top             =   60
      Width           =   10155
      Begin VB.TextBox txtfjfy 
         Alignment       =   1  'Right Justify
         Appearance      =   0  'Flat
         BackColor       =   &H00C0FFFF&
         Height          =   285
         Left            =   8160
         TabIndex        =   13
         Text            =   "0.00"
         Top             =   5430
         Width           =   1305
      End
      Begin VB.TextBox TxtTableId_yd 
         Appearance      =   0  'Flat
         BackColor       =   &H00C0FFFF&
         Enabled         =   0   'False
         Height          =   285
         Left            =   5790
         TabIndex        =   6
         Text            =   "Text1"
         Top             =   210
         Width           =   1485
      End
      Begin VB.TextBox TxtRoomId_dc 
         Appearance      =   0  'Flat
         BackColor       =   &H00C0FFFF&
         Enabled         =   0   'False
         Height          =   285
         Left            =   3420
         TabIndex        =   5
         Text            =   "Text1"
         Top             =   210
         Width           =   1485
      End
      Begin VB.TextBox TxtDh_dc 
         Appearance      =   0  'Flat
         BackColor       =   &H00C0FFFF&
         Height          =   285
         Left            =   5790
         TabIndex        =   4
         Text            =   "Text1"
         Top             =   5430
         Width           =   1485
      End
      Begin VB.TextBox TxtSum_dc 
         Appearance      =   0  'Flat
         BackColor       =   &H00C0FFFF&
         Enabled         =   0   'False
         Height          =   285
         Left            =   3420
         TabIndex        =   3
         Text            =   "Text1"
         Top             =   5430
         Width           =   1485
      End
      Begin VB.CommandButton cmdCancel_dc 
         Appearance      =   0  'Flat
         BeginProperty Font 
            Name            =   "MS Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   450
         Left            =   6780
         Picture         =   "frmDC.frx":0000
         Style           =   1  'Graphical
         TabIndex        =   2
         Top             =   5820
         Width           =   1455
      End
      Begin VB.CommandButton cmdEnt_dc 
         Appearance      =   0  'Flat
         BeginProperty Font 
            Name            =   "MS Serif"
            Size            =   8.25
            Charset         =   0
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   450
         Left            =   3660
         Picture         =   "frmDC.frx":07DA
         Style           =   1  'Graphical
         TabIndex        =   1
         Top             =   5820
         Width           =   1455
      End
      Begin MSComctlLib.TreeView TrvPs_dc 
         Height          =   6075
         Left            =   60
         TabIndex        =   7
         Top             =   180
         Width           =   2505
         _ExtentX        =   4419
         _ExtentY        =   10716
         _Version        =   393217
         LineStyle       =   1
         Style           =   7
         Appearance      =   1
      End
      Begin MSFlexGridLib.MSFlexGrid GrdMenu_dc 
         Height          =   4575
         Left            =   2550
         TabIndex        =   8
         Top             =   600
         Width           =   7545
         _ExtentX        =   13309
         _ExtentY        =   8070
         _Version        =   393216
         FixedCols       =   0
      End
      Begin VB.Label Label3 
         BackStyle       =   0  'Transparent
         Caption         =   "附加费用"
         Height          =   225
         Left            =   7380
         TabIndex        =   14
         Top             =   5490
         Width           =   825
      End
      Begin VB.Shape Shape1 
         FillColor       =   &H00C0FFFF&
         FillStyle       =   0  'Solid
         Height          =   285
         Left            =   7620
         Top             =   210
         Width           =   1155
      End
      Begin VB.Label Label14 
         BackStyle       =   0  'Transparent
         Caption         =   "桌   号"
         Height          =   225
         Left            =   5040
         TabIndex        =   12
         Top             =   270
         Width           =   795
      End
      Begin VB.Label Label7 
         BackStyle       =   0  'Transparent
         Caption         =   "房   间"
         Height          =   225
         Left            =   2700
         TabIndex        =   11
         Top             =   270
         Width           =   705
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "单   号"
         Height          =   225
         Left            =   5040
         TabIndex        =   10
         Top             =   5490
         Width           =   795
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "合计金额"
         Height          =   225
         Left            =   2640
         TabIndex        =   9
         Top             =   5490
         Width           =   825
      End
      Begin VB.Shape Shape2 
         FillColor       =   &H00C0FFFF&
         FillStyle       =   0  'Solid
         Height          =   285
         Index           =   0
         Left            =   2580
         Top             =   210
         Width           =   825
      End
      Begin VB.Shape Shape2 
         FillColor       =   &H00C0FFFF&
         FillStyle       =   0  'Solid
         Height          =   285
         Index           =   1
         Left            =   4950
         Top             =   210
         Width           =   825
      End
      Begin VB.Shape Shape2 
         FillColor       =   &H00C0FFFF&
         FillStyle       =   0  'Solid
         Height          =   285
         Index           =   2
         Left            =   2580
         Top             =   5430
         Width           =   825
      End
      Begin VB.Shape Shape2 
         FillColor       =   &H00C0FFFF&
         FillStyle       =   0  'Solid
         Height          =   285
         Index           =   3
         Left            =   4950
         Top             =   5430
         Width           =   825
      End
      Begin VB.Shape Shape2 
         FillColor       =   &H00C0FFFF&
         FillStyle       =   0  'Solid
         Height          =   285
         Index           =   4
         Left            =   7320
         Top             =   5430
         Width           =   825
      End
   End
End
Attribute VB_Name = "frmDC"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'菜单历史表 CDLSB
'消费菜单表 XFCDB 临时表
Option Explicit
Private iRows As Long           '记录菜单显示时已有多少菜
Private bFlag As Boolean

Private Type Menu
    id As String    '酒菜编号
    name As String  '酒菜名
    suu As Long     '数量
    tank As Double  '单价
    sum As Double   '合计
    flg As Boolean  '特价区分 TRUE 特价; FALSE 非特价
    row As Long     '记录所在GRID中行号从1开始
    mode As Integer '0:未落单 ;1:已落单
End Type
Private dcls() As Menu
Private node_tag As String  '记录树节点信息
Private remove_tag As String '移去点信息
Private sumkin As Double    '记录总合计金额
Private m_roomId As String
Private m_autoId As String
Private dhCode As String    '记录菜单单号
Private m_runMode As Integer
Private m_cjKbn As Integer '菜酒模式
Public Property Let cjKbn(ByVal VL As Integer)
    m_cjKbn = VL
End Property
Public Property Let runMode(ByVal md As Integer) '传入运行模式 0:点菜; 1:退菜; 2:赠送
    m_runMode = md
End Property
Public Property Let RoomId(VL As String)
    m_roomId = VL
End Property

Public Property Let autoId(VL As String)
    m_autoId = VL
End Property

Private Sub cmdCancel_dc_Click()
    Unload Me
End Sub

Private Sub cmdEnt_dc_Click()
    If MsgBox("是否落单", vbOKCancel, "信息提示") = vbCancel Then Exit Sub
    
'    If updateJK = False Then Exit Sub
    
    If updateProc = True Then
'        MsgBox "落单完毕!", vbInformation, "信息提示"
        Unload Me
    Else
        MsgBox "落单失败!", vbInformation, "信息提示"
    End If
End Sub
'Private Function GetCKDH() As String
'On Error Resume Next
'    GetCKDH = "CK"
'    GetCKDH = GetCKDH & CStr(Format(Date, "YYYYMMDD")) & CStr(Format(time, "hhmmss"))
'
'End Function
'
'Private Function updateJK() As Boolean
'On Error GoTo err_updatejk
'    Dim i As Long
'    Dim l As Long
'    Dim strsql As String
'
'    With GrdMenu_dc
'        For i = iRows + 1 To .Rows - 1
'            For l = 0 To 9999
'                If Trim(.TextMatrix(i, 0)) = Trim(sjylid(l)) Then
'                    strsql = "update jkkcb set sl=sl-" & Val(.TextMatrix(i, 2)) & " where ylid='"
'                    strsql = strsql & .TextMatrix(i, 0) & "'"
'                    Call ExeSQLByCmd(strsql)
'                    strsql = "insert into ckb (ckid,ylbm,ylmc,cksl,cksj,kid) values('"
'                    strsql = strsql & GetCKDH & "','"
'                    strsql = strsql & sjylid(l) & "','"
'                    strsql = strsql & sjylmc(l) & "',"
'                    strsql = strsql & Val(.TextMatrix(i, 2)) & ",'"
'                    strsql = strsql & Format(Date & " " & time, "YYYY-MM-dd hh:mm:ss") & "','"
'                    strsql = strsql & "1')"
'                    Call ExeSQLByCmd(strsql)
'                    Exit For
'                End If
'            Next
'        Next
'    End With
'    updateJK = True
'Exit Function
'err_updatejk:
'    updateJK = False
'End Function

Private Function updateProc() As Boolean '
    Dim l As Long
    Dim adocon As New ADODB.Connection

On Error GoTo errProc:
    updateProc = False
    Set adocon = OpenDB
    adocon.BeginTrans
    
    dhCode = ""
    If checkXfcdb(l, False) = False Then
        If m_runMode = 0 Or m_runMode = 1 Then
            If getDh("DC", dhCode) = False Then Exit Function '自动得到单号
        ElseIf m_runMode = 2 Then
            If getDh("ZS", dhCode) = False Then Exit Function '自动得到单号
        End If
    End If
    For l = 1 To UBound(dcls)
        
        If dcls(l).suu <> 0 And (m_runMode = 0 Or m_runMode = 2) Then
            If dcls(l).mode = 1 Then GoTo nexti '落单的数据
        '点菜或赠送模式点该道菜
            If checkXfcdb(l, True) = False Then '
                If insertXfcdb(l) = False Then GoTo errProc:
            Else '如果已有相同桌号和菜名(ID)的落单数据则插入
                If updateXfcdb(l) = False Then GoTo errProc:
            End If
            dcls(l).mode = 1 '将数据置成落单模式,点菜时不可修改
        ElseIf m_runMode = 1 Then '退菜模式
            If dcls(l).mode = 1 Then
                If updateXfcdb(l) = False Then GoTo errProc:
            End If
        End If
        
nexti:
    Next
    adocon.CommitTrans
    updateProc = True
    Exit Function
errProc:
    adocon.RollbackTrans
End Function
Private Function insertXfcdb(ByVal l As Long) As Boolean
    Dim wksql As String