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

📄 frmlbsetup.frm

📁 餐饮经销系统
💻 FRM
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmLBSETUP 
   Caption         =   "房台类别设置"
   ClientHeight    =   2640
   ClientLeft      =   3864
   ClientTop       =   3336
   ClientWidth     =   5400
   LinkTopic       =   "Form1"
   ScaleHeight     =   2640
   ScaleWidth      =   5400
   Begin VB.CommandButton cmdADDC 
      Caption         =   "设置容纳人数"
      Height          =   375
      Left            =   3960
      TabIndex        =   4
      Top             =   600
      Width           =   1215
   End
   Begin VB.CommandButton cmdADDP 
      Caption         =   "添加类别"
      Height          =   375
      Left            =   3960
      TabIndex        =   3
      Top             =   120
      Width           =   1215
   End
   Begin VB.CommandButton cmdEnter 
      Caption         =   "确定"
      Height          =   375
      Left            =   3960
      TabIndex        =   2
      Top             =   1560
      Width           =   1215
   End
   Begin VB.CommandButton cmdCancel 
      Caption         =   "取消"
      Height          =   375
      Left            =   3960
      TabIndex        =   1
      Top             =   2040
      Width           =   1215
   End
   Begin VB.CommandButton cmdDelete 
      Caption         =   "删除类"
      Height          =   375
      Left            =   3960
      TabIndex        =   0
      Top             =   1080
      Width           =   1215
   End
   Begin MSComctlLib.TreeView TreeView1 
      Height          =   1932
      Left            =   120
      TabIndex        =   5
      Top             =   480
      Width           =   3612
      _ExtentX        =   6371
      _ExtentY        =   3408
      _Version        =   393217
      LineStyle       =   1
      Style           =   6
      BorderStyle     =   1
      Appearance      =   0
      MousePointer    =   1
   End
   Begin VB.Label Label1 
      Caption         =   "选择指定类别并确定,鼠标选定可以修改类别内容。"
      Height          =   372
      Left            =   120
      TabIndex        =   6
      Top             =   120
      Width           =   3492
   End
End
Attribute VB_Name = "frmLBSETUP"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim parText As String
Private Sub cmdADDC_Click()
    Dim nodX As Node
    If Trim(parText) <> "" Then
        If TreeView1.Nodes(parText).Parent Is Nothing Then
            Set nodX = TreeView1.Nodes.Add(parText, tvwChild)
            nodX.Key = GetRkno()
            nodX.Text = "设置容纳人数(点击鼠标修改)"
            nodX.EnsureVisible
        Else
            MsgBox "不能添加第三层次类别,土鳖!!!", vbOKOnly, "警告"
        End If
    End If
End Sub

Private Sub cmdADDP_Click()
        Set nodX = TreeView1.Nodes.Add(, tvwChild)
        nodX.Key = GetRkno()
        nodX.Text = "新建房台类别(点击鼠标修改)"
End Sub

Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub cmdDelete_Click()
    Dim nodX As Node
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset
    
    If Trim(parText) <> "" Then
        With TreeView1
    
            If MsgBox("是否删除" & .Nodes(parText).Text & "?", vbOKCancel, "警告") = vbOK Then
                txtSQL = "select * from dm_room where dm <> 'l' and lbdm = '" & Trim(.Nodes(parText).Key) & "'"
                Set mrc = ExecuteSQL(txtSQL, MsgText)
                
                If Not mrc.EOF Then
                    MsgBox "房台信息中包括与" & Trim(TreeView1.Nodes(parText).Text) & "相关的纪录,不能删除!", vbOKOnly + vbExclamation, "警告"
                    Exit Sub
                Else
                    txtSQL = "delete from dm_room where lbdm = '" & Trim(.Nodes(parText).Key) & "'"
                    Set mrc = ExecuteSQL(txtSQL, MsgText)
                    
                    'If .Nodes(parText).Parent Is Nothing Then
                    '    txtSQL = "delete from dm_wzlb where lbcode = '" & Trim(.Nodes(parText).Key) & "'"
                    '    Set mrc = ExecuteSQL(txtSQL, MsgText)
                    'End If
                    TreeView1.Nodes.Clear
                    ShowClass
                End If
            Else
                Exit Sub
            End If
        End With
    End If
    
End Sub

Private Sub cmdEnter_Click()
    If Not Trim(parText) = "" Then
        If TreeView1.Nodes(parText).Parent Is Nothing Then
            If TreeView1.Nodes(parText).Child Is Nothing Then
                MsgBox "请设置该房台类别的容纳人数!", vbOKOnly, "警告"
                cmdADDC.SetFocus
                Exit Sub
            Else
                frmROOMSetup1.txtItem(3) = Trim(TreeView1.Nodes(parText).Text)
                frmROOMSetup1.txtItem(6) = Trim(parText)
                frmROOMSetup1.txtItem(4) = Trim(TreeView1.Nodes(parText).Child.Text)
                frmROOMSetup1.txtItem(7) = Trim(TreeView1.Nodes(parText).Child.Key)
                Unload Me
            End If
        Else
            MsgBox "请选择房台类别!", vbOKOnly, "警告"
            Exit Sub
        End If
    End If
End Sub

Private Sub Form_Load()
   ShowClass
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset
    
    txtSQL = "select lbdm,lbmc from dm_room where dm = 'l' and r_sl is null"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    If Not mrc.EOF Then
        MsgBox "请设置" & Trim(mrc.Fields(1)) & "的容纳人数!", vbOKOnly + vbExclamation, "警告"
        TreeView1.SetFocus
        Exit Sub
    End If
End Sub

Private Sub TreeView1_AfterLabelEdit(Cancel As Integer, NewString As String)
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset
    
    TreeView1.Nodes(parText).Text = NewString
        
    If TreeView1.Nodes(parText).Parent Is Nothing Then
        txtSQL = "select lbmc from dm_room where dm = 'l' and lbdm = '" & Trim(TreeView1.Nodes(parText).Key) & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        If Not mrc.EOF Then
            mrc.Fields(0) = NewString
            mrc.Update
            mrc.Close
        Else
            txtSQL = "insert dm_room (dm,lbdm,lbmc) values ('l','" & Trim(TreeView1.Nodes(parText).Key) & "','" & Trim(NewString) & "')"
            Set mrc = ExecuteSQL(txtSQL, MsgText)
        End If
    Else
        txtSQL = "select r_sl,bz from dm_room where dm = 'l' and lbdm = '" & Trim(TreeView1.Nodes(parText).Parent.Key) & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        
        If Not mrc.EOF Then
            mrc.Fields(0) = NewString
            mrc.Fields(1) = Trim(TreeView1.Nodes(parText).Key)
            mrc.Update
            mrc.Close
        End If
    End If
End Sub

Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
    parText = Node.Key
End Sub
Private Sub ShowClass()
    Dim txtSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset
    
    txtSQL = "select lbdm,lbmc from dm_room where dm = 'l'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    If Not mrc.EOF Then
        Do While Not mrc.EOF
            Set nodX = TreeView1.Nodes.Add(, tvwChild)
            nodX.Key = Trim(mrc.Fields(0))
            nodX.Text = Trim(mrc.Fields(1))
            mrc.MoveNext
        Loop
        mrc.Close
    End If
    
    txtSQL = "select lbdm,r_sl,bz from dm_room where dm = 'l'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)
    
    If Not mrc.EOF Then
        Do While Not mrc.EOF
            Set nodX = TreeView1.Nodes.Add(Trim(mrc.Fields(0)), tvwChild)
            nodX.Key = mrc.Fields(2)
            nodX.Text = mrc.Fields(1)
            mrc.MoveNext
            
        Loop
    End If
End Sub


⌨️ 快捷键说明

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