form1.frm

本文件包含200个visual baisc实例

         End
      End
      Begin VB.Frame Frame4 
         Caption         =   "日结"
         Height          =   3030
         Left            =   5475
         TabIndex        =   7
         Top             =   465
         Width           =   1665
         Begin VB.CheckBox Check1 
            Caption         =   "登记预收报表"
            Height          =   315
            Index           =   12
            Left            =   135
            TabIndex        =   9
            Top             =   510
            Width           =   1425
         End
         Begin VB.CheckBox Check1 
            Caption         =   "客房销售报表"
            Height          =   315
            Index           =   13
            Left            =   150
            TabIndex        =   8
            Top             =   945
            Width           =   1425
         End
      End
      Begin VB.Frame Frame5 
         Caption         =   "系统设置"
         Height          =   3030
         Left            =   7335
         TabIndex        =   5
         Top             =   465
         Width           =   1620
         Begin VB.CheckBox Check1 
            Caption         =   "操作员设置"
            Height          =   315
            Index           =   14
            Left            =   165
            TabIndex        =   6
            Top             =   525
            UseMaskColor    =   -1  'True
            Width           =   1215
         End
         Begin VB.CheckBox Check1 
            Caption         =   "密码设置"
            Height          =   315
            Index           =   15
            Left            =   165
            TabIndex        =   0
            Top             =   990
            Width           =   1125
         End
         Begin VB.CheckBox Check1 
            Caption         =   "初始化"
            DataSource      =   "Data1"
            Height          =   315
            Index           =   16
            Left            =   180
            TabIndex        =   10
            Top             =   1440
            Width           =   1290
         End
         Begin VB.CheckBox Check1 
            Caption         =   "权限设置"
            Height          =   315
            Index           =   17
            Left            =   165
            TabIndex        =   12
            Top             =   1920
            UseMaskColor    =   -1  'True
            Visible         =   0   'False
            Width           =   1110
         End
      End
   End
   Begin VB.Label Label1 
      Caption         =   "管理员"
      Height          =   195
      Left            =   90
      TabIndex        =   28
      Top             =   270
      Width           =   1755
   End
End
Attribute VB_Name = "form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim mystr As String
Dim i As Integer
Private Sub Form_Activate()
  Dim mydb1 As Database
  Dim myrs1 As Recordset
  Dim sql As String
  Set mydb1 = Workspaces(0).OpenDatabase(App.Path & "\qxsz.mdb") '设置数据库
  sql = "select 操作员 from qxsz "
  Set myrs1 = mydb1.OpenRecordset(sql)
  If myrs1.EOF = False Then myrs1.MoveLast
  If myrs1.BOF = False Then myrs1.MoveFirst
  For i = 0 To myrs1.RecordCount - 1
      If myrs1.Fields(0) <> "" Then List1.AddItem (myrs1.Fields(0))   '将管理员添加到管理员列表框
      myrs1.MoveNext
  Next i
  If List1.ListCount > 0 Then List1.ListIndex = 0 '移动记录到第一条
  myrs1.Close
  mydb1.Close
End Sub
Private Sub Command5_Click()                                    '保存权限设置
  Dim mydb1 As Database
  Dim myrs1 As Recordset
  mystr = List1.Text
  Set mydb1 = Workspaces(0).OpenDatabase(App.Path & "\qxsz.mdb")     '打开数据库qxsz.mdb
  Set myrs1 = mydb1.OpenRecordset("qxsz", dbOpenDynaset)   '打开表qxsz,建立一个Dynase 对象
  If mystr <> "" Then
     myrs1.FindFirst "操作员 like " + Chr(34) + mystr + Chr(34) + ""      '选定管理员
     If myrs1.NoMatch Then
      Else
        myrs1.Edit                                               '设置相应权限
        myrs1.Fields("客房预定") = IIf(Check1(0).Value = 1, -1, 0)
        myrs1.Fields("住宿登记") = IIf(Check1(1).Value = 1, -1, 0)
        myrs1.Fields("续住登记") = IIf(Check1(2).Value = 1, -1, 0)
        myrs1.Fields("调房登记") = IIf(Check1(3).Value = 1, -1, 0)
        myrs1.Fields("退宿登记") = IIf(Check1(4).Value = 1, -1, 0)
        myrs1.Fields("客房管理") = IIf(Check1(5).Value = 1, -1, 0)
        myrs1.Fields("客房查询") = IIf(Check1(6).Value = 1, -1, 0)
        myrs1.Fields("房态查看") = IIf(Check1(7).Value = 1, -1, 0)
        myrs1.Fields("预定房查询") = IIf(Check1(8).Value = 1, -1, 0)
        myrs1.Fields("住宿查询") = IIf(Check1(9).Value = 1, -1, 0)
        myrs1.Fields("退宿查询") = IIf(Check1(10).Value = 1, -1, 0)
        myrs1.Fields("宿费提醒") = IIf(Check1(11).Value = 1, -1, 0)
        myrs1.Fields("登记预收报表") = IIf(Check1(12).Value = 1, -1, 0)
        myrs1.Fields("客房销售报表") = IIf(Check1(13).Value = 1, -1, 0)
        myrs1.Fields("操作员设置") = IIf(Check1(14).Value = 1, -1, 0)
        myrs1.Fields("密码设置") = IIf(Check1(15).Value = 1, -1, 0)
        myrs1.Fields("初始化") = IIf(Check1(16).Value = 1, -1, 0)
        myrs1.Fields("权限设置") = IIf(Check1(17).Value = 1, -1, 0)
        myrs1.Update '保存数据修改
     End If
  End If
  myrs1.Close
  mydb1.Close
End Sub
Private Sub List1_Click() '选择管理员
  Dim mydb1 As Database
  Dim myrs1 As Recordset
  mystr = List1.Text
  Set mydb1 = Workspaces(0).OpenDatabase(App.Path & "\qxsz.mdb")       '打开数据库
  Set myrs1 = mydb1.OpenRecordset("qxsz", dbOpenSnapshot)             '打开数据表
  If myrs1.BOF = False Then myrs1.MoveFirst
  myrs1.FindFirst "操作员 = '" & mystr & "'" '选择管理员
  If myrs1.NoMatch Then
     mystr = 0
    Else '设置各项权限
     Check1(0).Value = IIf(myrs1.Fields("客房预定") = -1, 1, 0)
     Check1(1).Value = IIf(myrs1.Fields("住宿登记") = -1, 1, 0)
     Check1(2).Value = IIf(myrs1.Fields("续住登记") = -1, 1, 0)
     Check1(3).Value = IIf(myrs1.Fields("退宿登记") = -1, 1, 0)
     Check1(4).Value = IIf(myrs1.Fields("客房管理") = -1, 1, 0)
     Check1(5).Value = IIf(myrs1.Fields("客房查询") = -1, 1, 0)
     Check1(6).Value = IIf(myrs1.Fields("预定房查询") = -1, 1, 0)
     Check1(7).Value = IIf(myrs1.Fields("住宿查询") = -1, 1, 0)
     Check1(8).Value = IIf(myrs1.Fields("退宿查询") = -1, 1, 0)
     Check1(9).Value = IIf(myrs1.Fields("宿费提醒") = -1, 1, 0)
     Check1(10).Value = IIf(myrs1.Fields("登记预收报表") = -1, 1, 0)
     Check1(11).Value = IIf(myrs1.Fields("客房销售报表") = -1, 1, 0)
     Check1(12).Value = IIf(myrs1.Fields("操作员设置") = -1, 1, 0)
     Check1(13).Value = IIf(myrs1.Fields("密码设置") = -1, 1, 0)
     Check1(14).Value = IIf(myrs1.Fields("初始化") = -1, 1, 0)
     Check1(15).Value = IIf(myrs1.Fields("权限设置") = -1, 1, 0)
     Check1(16).Value = IIf(myrs1.Fields("房态查看") = -1, 1, 0)
     Check1(17).Value = IIf(myrs1.Fields("调房登记") = -1, 1, 0)
  End If
  If mystr = "系统管理员" Then                       '系统管理员享有所有权限
     MsgBox ("系统管理员具有全部权限，不能修改")  '不能修改系统管理员权限
     Frame1.Enabled = False
     Frame2.Enabled = False
     Frame3.Enabled = False
     Frame4.Enabled = False
     Frame5.Enabled = False
     Command1.Enabled = False
     Command2.Enabled = False
   Else                                '如果不是系统管理员，权限可以修改
     Frame1.Enabled = True
     Frame2.Enabled = True
     Frame3.Enabled = True
     Frame4.Enabled = True
     Frame5.Enabled = True
     Command1.Enabled = True
     Command2.Enabled = True
  End If
End Sub
Private Sub Command1_Click()           '选中全部权限
  For i = 0 To 17
      Check1(i).Value = 1
  Next i
End Sub
Private Sub Command2_Click()           '取消全部权限
  For i = 0 To 17
      Check1(i).Value = 0
  Next i
End Sub
Private Sub Command3_Click()
  End
End Sub