frmauthority.frm

星级酒店管理系统（附带系统自写控件源码）

VERSION 5.00
Begin VB.Form frmAuthority 
   BackColor       =   &H00008000&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "操作员权限配置表"
   ClientHeight    =   4245
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   7560
   Icon            =   "frmAuthority.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4245
   ScaleWidth      =   7560
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton cmdClose 
      Cancel          =   -1  'True
      Caption         =   "关闭(E&XIT)"
      Default         =   -1  'True
      Height          =   405
      Left            =   5805
      TabIndex        =   1
      Top             =   3645
      Width           =   1560
   End
   Begin VB.ListBox lstAuthority 
      BackColor       =   &H00E0E0E0&
      Columns         =   2
      Height          =   3630
      Left            =   135
      Style           =   1  'Checkbox
      TabIndex        =   0
      Top             =   315
      Width           =   5415
   End
   Begin VB.PictureBox Picture1 
      AutoSize        =   -1  'True
      BorderStyle     =   0  'None
      Height          =   3300
      Left            =   5775
      Picture         =   "frmAuthority.frx":0442
      ScaleHeight     =   3300
      ScaleWidth      =   1500
      TabIndex        =   2
      Top             =   180
      Width           =   1500
   End
   Begin VB.Shape Shape1 
      BorderColor     =   &H00404040&
      FillColor       =   &H00404040&
      FillStyle       =   0  'Solid
      Height          =   3675
      Left            =   210
      Top             =   405
      Width           =   5430
   End
End
Attribute VB_Name = "frmAuthority"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdClose_Click()

  Unload Me
  
End Sub

Private Sub Form_Load()

  LoadList
  QueryList
  
End Sub

Private Sub LoadList()

  lstAuthority.AddItem "座位分类" '1
  lstAuthority.AddItem "单位分类" '2
  lstAuthority.AddItem "菜单分类" '3
  lstAuthority.AddItem "菜单管理" '4
  lstAuthority.AddItem "单号分类" '5
  lstAuthority.AddItem "单号发放" '6
  lstAuthority.AddItem "查看未消单号" '7
  lstAuthority.AddItem "付款分类" '8
  lstAuthority.AddItem "客人上台" '9
  lstAuthority.AddItem "营业汇总表" '10
  lstAuthority.AddItem "结帐后退单" '11
  lstAuthority.AddItem "操作员管理" '12
  lstAuthority.AddItem "系统重建" '13
  lstAuthority.AddItem "数据备份与恢复" '14
  lstAuthority.AddItem "营业明细表" '15
  
End Sub

Private Sub Form_Unload(Cancel As Integer)

 WriteResult

End Sub

Private Sub WriteResult()

  Dim Ef As Recordset, DB As Database, TmpStr As String
  Dim Us As String, FieldsName As String, ValueName As String
  
      Us = frmOperator.Grid1.Text
  
  Set DB = OpenDatabase(ConData, False, False, Constr)
  Set Ef = DB.OpenRecordset("Authority", dbOpenDynaset)
      TmpStr = "UserName='" & Us & "'"
      Ef.FindFirst TmpStr
    
    Dim X As Integer
    
    For X = 0 To 14
      If X < 14 Then
         FieldsName = FieldsName + Ef.Fields(X + 1).Name + ","
         If lstAuthority.Selected(X) = True Then
            ValueName = ValueName + "True" + ","
         Else
            ValueName = ValueName + "False" + ","
         End If
      Else
         FieldsName = FieldsName + Ef.Fields(X + 1).Name
         If lstAuthority.Selected(X) = True Then
            ValueName = ValueName + "True"
         Else
            ValueName = ValueName + "False"
         End If
      End If
      
    Next
   
  If Ef.NoMatch Then
    TmpStr = "Insert Into Authority (UserName," & FieldsName & ") Values('" & Us & "'," & ValueName & ")"
   Else
    '清除原来设置
    TmpStr = "Delete * From Authority Where UserName='" & Us & "'"
    DB.Execute TmpStr
    '重新设置
    TmpStr = "Insert Into Authority (UserName," & FieldsName & ") Values('" & Us & "'," & ValueName & ")"
  End If
  
  DB.Execute TmpStr
  
  Ef.Close
  DB.Close
  
End Sub

Private Sub QueryList()

  Dim Ef As Recordset, DB As Database, TmpStr As String
  Dim Us As String
  
      Us = frmOperator.Grid1.Text
  
  Set DB = OpenDatabase(ConData, False, False, Constr)
  Set Ef = DB.OpenRecordset("Authority", dbOpenDynaset)
      TmpStr = "UserName='" & Us & "'"
      Ef.FindFirst TmpStr
  If Not Ef.NoMatch Then
    Dim X As Integer
    For X = 0 To 14
     If Ef.Fields(X + 1).Value = True Then
        lstAuthority.Selected(X) = True
      Else
        lstAuthority.Selected(X) = False
     End If
    Next
  End If
   
  Ef.Close
  DB.Close

End Sub