⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frm_chage.frm

📁 ktv场所的包房开房、迎宾、预定管理系统。
💻 FRM
字号:
VERSION 5.00
Begin VB.Form frm_chage 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "换位"
   ClientHeight    =   3165
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4575
   Icon            =   "frm_chage.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3165
   ScaleWidth      =   4575
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton Command1 
      Caption         =   "确定(&O)"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   990
      TabIndex        =   7
      Top             =   2370
      Width           =   1275
   End
   Begin VB.CommandButton Command2 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   435
      Left            =   2580
      TabIndex        =   6
      Top             =   2370
      Width           =   1275
   End
   Begin VB.TextBox txt_y 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   345
      Left            =   1905
      TabIndex        =   5
      Text            =   "Text1"
      Top             =   765
      Width           =   1740
   End
   Begin VB.ComboBox cmb_fw 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   330
      Left            =   1875
      TabIndex        =   3
      Text            =   "Combo2"
      Top             =   1740
      Width           =   1755
   End
   Begin VB.ComboBox cmb_n 
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   330
      Left            =   1890
      TabIndex        =   0
      Text            =   "Combo1"
      Top             =   1245
      Width           =   1755
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "原 桌 号:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   945
      TabIndex        =   4
      Top             =   795
      Width           =   1050
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "服 务 员:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   915
      TabIndex        =   2
      Top             =   1755
      Width           =   1050
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "新 桌 号:"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   10.5
         Charset         =   134
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   210
      Left            =   930
      TabIndex        =   1
      Top             =   1290
      Width           =   1050
   End
End
Attribute VB_Name = "frm_chage"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public TxtSQL As String
Public mrc As ADODB.Recordset
Public mrc1 As ADODB.Recordset
Dim msgtext As String

Private Sub cmb_fw_KeyPress(KeyAscii As Integer)
Dim i As Integer
    Dim roomnum As Integer
    Dim roomstr As String
            
    If KeyAscii = 13 Then
        roomnum = InStr(1, Me.cmb_fw.text, ",") - 1
        If roomnum > -1 Then
            roomstr = Mid(Me.cmb_fw.text, 1, roomnum)
        Else
            roomstr = Me.cmb_fw.text
        End If
        For i = 0 To Me.cmb_fw.ListCount - 1
            If roomstr = cmb_fw.ItemData(i) Then
                 'customer is in list ,select customer
                 Me.cmb_fw.ListIndex = i
                 'loadcustomer
                 Command1.SetFocus
                 Exit Sub
            End If
        Next i
    End If
End Sub

Private Sub cmb_n_KeyPress(KeyAscii As Integer)
    Dim i As Integer
    Dim roomnum As Integer
    Dim roomstr As String
            
    If KeyAscii = 13 Then
        roomnum = InStr(1, Me.cmb_n.text, ",") - 1
        If roomnum > -1 Then
            roomstr = Mid(Me.cmb_n.text, 1, roomnum)
        Else
            roomstr = Me.cmb_n.text
        End If

        For i = 0 To Me.cmb_n.ListCount - 1
            If roomstr = Me.cmb_n.ItemData(i) Then
                 Me.cmb_n.ListIndex = i
                 cmb_fw.SetFocus
                 Exit Sub
            End If
        Next i
    End If
End Sub

Private Sub Command1_Click()
Dim daima_n As String
Dim ru, roomnum As Integer

    On Error GoTo errpro:
    roomnum = InStr(1, Me.cmb_n.text, ",") - 1
    If roomnum > -1 Then
        daima_n = Trim(Mid(Me.cmb_n.text, 1, roomnum))
    Else
        daima_n = Trim(Me.cmb_n.text)
    End If
    TxtSQL = "select * from roominfo where room_number='" & daima_n & "'"
    Set mrc = ExecuteSQL(TxtSQL, msgtext)
    If mrc.Fields("user_flag") = 1 Then
        ru = MsgBox("新的桌号已经在用,是否合并?", 33, "合并")
        If ru = 2 Then
            Exit Sub
        Else
            TxtSQL = "update sale_temp set room_number='" & daima_n & "'"
            TxtSQL = TxtSQL & " where room_number='" & Trim(txt_y.text) & "'"
            Set mrc = ExecuteSQL(TxtSQL, msgtext)
            TxtSQL = "update roominfo set user_flag=0 where room_number='" & Trim(txt_y.text) & "'"
            Set mrc = ExecuteSQL(TxtSQL, msgtext)
            frm_main.TxtSQL = "select room_number,room_name,employee_id,starttime,planpeoplecount,user_flag,supplier_id,roomcount from"
            frm_main.TxtSQL = frm_main.TxtSQL & " roominfo"
            frm_main.TxtSQL = frm_main.TxtSQL & " order by 1"
            Call frm_main.ShowData(frm_main.msglist)
            Unload Me
        End If
    Else
        TxtSQL = "select starttime,endtime,employee_id,planpeoplecount,roomcount from roominfo"
        TxtSQL = TxtSQL & " where room_number='" & Trim(txt_y.text) & "'"
        Set mrc1 = ExecuteSQL(TxtSQL, msgtext)
        
        TxtSQL = "update roominfo set starttime='" & mrc1.Fields(0) & "'"
        TxtSQL = TxtSQL & " ,endtime='" & mrc1.Fields(1) & "'"
        TxtSQL = TxtSQL & " ,employee_id='" & mrc1.Fields(2) & "'"
        TxtSQL = TxtSQL & " ,planpeoplecount=" & Val(mrc1.Fields(3))
        TxtSQL = TxtSQL & " ,roomcount=" & Val(mrc1.Fields(4))
        TxtSQL = TxtSQL & " ,user_flag=1"
        TxtSQL = TxtSQL & " where val(room_number)=" & Val(daima_n)
        Set mrc = ExecuteSQL(TxtSQL, msgtext)
        mrc1.Close
        TxtSQL = "update sale_temp set room_number='" & daima_n & "'"
        TxtSQL = TxtSQL & " where room_number='" & Trim(txt_y.text) & "'"
        Set mrc = ExecuteSQL(TxtSQL, msgtext)
        
        TxtSQL = "update roominfo set user_flag=0 where room_number='" & Trim(txt_y.text) & "'"
        Set mrc = ExecuteSQL(TxtSQL, msgtext)
        frm_main.TxtSQL = "select room_number,room_name,employee_id,starttime,planpeoplecount,user_flag,supplier_id,roomcount from"
        frm_main.TxtSQL = frm_main.TxtSQL & " roominfo"
        frm_main.TxtSQL = frm_main.TxtSQL & " order by 1"
        Call frm_main.ShowData(frm_main.msglist)
        Unload Me
    End If
    Exit Sub
errpro:
    MsgBox Err.Number
End Sub

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    loadpop
End Sub
Public Sub loadpop()
Dim partiddiama As String

    TxtSQL = "select room_number,room_name from roominfo order by 1"
    Set mrc = ExecuteSQL(TxtSQL, msgtext)
    cmb_n.Clear
    If Not mrc.EOF Then
        Do Until mrc.EOF
            TxtSQL = mrc.Fields("room_number") & "," & mrc.Fields("room_name")
            cmb_n.AddItem TxtSQL
            partiddiama = mrc.Fields("room_number")
            cmb_n.ItemData(cmb_n.NewIndex) = partiddiama
            mrc.MoveNext 'move to next record.
        Loop
        cmb_n.ListIndex = 0
        partiddiama = cmb_n.ItemData(0)
    End If
    
    'TxtSQL = "select HomeZip,LastName & FirstName as name from employees where LocationID=" & g_currentlocation
    TxtSQL = "select employee_id,employee_name from Employee"
    TxtSQL = TxtSQL & " order by 1"
    Set mrc = ExecuteSQL(TxtSQL, msgtext)
    cmb_fw.Clear
    If Not mrc.EOF Then
        Do Until mrc.EOF
            TxtSQL = mrc.Fields("employee_id") & "," & mrc.Fields("employee_name")
            cmb_fw.AddItem TxtSQL
            partiddiama = mrc.Fields("employee_id")
            cmb_fw.ItemData(cmb_fw.NewIndex) = partiddiama
            mrc.MoveNext 'move to next record.
        Loop
        cmb_fw.ListIndex = 0
        partiddiama = cmb_fw.ItemData(0)
    End If

End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -