main_xtgl_qxgl.frm
来自「星级酒店客房管理系统一套很不错的系统」· FRM 代码 · 共 846 行 · 第 1/2 页
FRM
846 行
ColumnCount = 5
BeginProperty Column00
DataField = "操作员"
Caption = "操作员"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = "姓名"
Caption = "姓名"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column02
DataField = "级别"
Caption = "级别"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column03
DataField = "密码"
Caption = "密码"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column04
DataField = "权限"
Caption = "权限"
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
BeginProperty Column00
ColumnWidth = 900.284
EndProperty
BeginProperty Column01
ColumnWidth = 900.284
EndProperty
BeginProperty Column02
ColumnWidth = 1005.165
EndProperty
BeginProperty Column03
Object.Visible = 0 'False
ColumnWidth = 599.811
EndProperty
BeginProperty Column04
ColumnWidth = 599.811
EndProperty
EndProperty
End
Begin MSDataGridLib.DataGrid DataGrid2
Bindings = "main_xtgl_qxgl.frx":9B56
Height = 5205
Left = -74880
TabIndex = 24
Top = 480
Width = 5610
_ExtentX = 9895
_ExtentY = 9181
_Version = 393216
AllowUpdate = 0 'False
AllowArrows = 0 'False
BackColor = 49152
HeadLines = 2
RowHeight = 15
BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ColumnCount = 2
BeginProperty Column00
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
BeginProperty Column00
EndProperty
BeginProperty Column01
EndProperty
EndProperty
End
Begin VB.Image Image1
BorderStyle = 1 'Fixed Single
Height = 4560
Left = 4440
Picture = "main_xtgl_qxgl.frx":9B6B
Top = 480
Width = 3060
End
Begin VB.Label Label3
Caption = "操作员级别："
Height = 240
Left = -68880
TabIndex = 23
Top = 2985
Width = 1125
End
Begin VB.Shape Shape1
Height = 2760
Left = -69240
Top = 2880
Width = 1815
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "请输入1~间数字"
ForeColor = &H0000C000&
Height = 375
Left = -69000
TabIndex = 22
Top = 5385
Width = 1575
End
End
End
Attribute VB_Name = "main_xtgl_qxgl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'定义数据集对象
Dim rs1 As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
Dim rs3 As New ADODB.Recordset
Dim rs4 As New ADODB.Recordset
Dim rs5 As New ADODB.Recordset
Dim rs6 As New ADODB.Recordset
Dim myval, str1 As String '定义字符串变量
Dim i As Integer '定义整型变量
Public flag As Boolean
Public checkCount As Integer
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Command2_Click()
Dim aa As String
Dim aalen, bblen, i, j As Integer
Dim flag As Boolean
flag = True
aa = Adodc3.Recordset.Fields("使用者")
aalen = Len(aa)
bblen = Len(Text4.Text)
For j = 1 To bblen
For i = 1 To aalen
If Mid(aa, i, 1) = Mid(Text4.Text, j, 1) Then flag = False
Next
Next
If flag = True Then
If Val(Text4.Text) < 10 Or Val(Text4.Text) = 0 Or (Not IsNull(Text4.Text)) Then
Adodc3.Recordset.Fields("使用者") = Adodc3.Recordset.Fields("使用者") & Trim(Text4.Text)
Adodc3.Recordset.Update
Else
MsgBox "非法设置,请输入1~9之间的数字!", vbOKOnly, "错误"
End If
Else
End If
End Sub
Private Sub Command3_Click()
Dim jb, jt As String
Dim i, j As Integer
If Text4.Text <> "" Or (Not IsNull(Text4.Text)) Then
jt = Trim(Text4.Text)
jb = Adodc3.Recordset.Fields("使用者")
For j = 1 To Len(jt)
For i = 1 To Len(Trim(jb))
If Mid(jb, i, 1) = Mid(jt, j, 1) Then
If i <> 1 Then
If i = Len(Trim(jb)) Then
jb = Left(jb, Len(Trim(jb)) - 1)
Else
jb = Left(jb, i) & Right(jb, Len(Trim(jb)) - i - 1)
End If
Else
jb = Right(jb, Len(Trim(jb)) - 1)
End If
End If
Next
Next
If jb = "" Then jb = "1"
'Adodc3.Recordset.Edit
Adodc3.Recordset.Fields("使用者") = jb
Adodc3.Recordset.Update
End If
End Sub
Private Sub Command4_Click()
Unload Me
End Sub
Private Sub Form_Activate()
'添加员工级别列表
rs2.Open "select 级别名称 from 员工级别表 group by 级别名称", My_PROVIDER, adOpenKeyset, adLockOptimistic
If rs2.BOF = False Then rs2.MoveFirst
For i = 0 To rs2.RecordCount - 1
Combo2.AddItem (Trim(rs2.Fields("级别名称")))
rs2.MoveNext
Next i
If Combo2.ListCount > 0 Then Combo2.ListIndex = 0
rs2.Close
Me.Caption = Me.Caption & " " & CzyName
flag = False
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Text2.SetFocus
End Sub
Private Sub text3_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Text1.SetFocus
End Sub
Private Sub Form_Load()
Dim i As Integer
'窗口显示位置
Me.Left = MDIForm1.Picture1.Width
Me.Top = (MDIForm1.Height - Me.Height) / 2
Adodc3.ConnectionString = My_PROVIDER
Adodc3.CommandType = adCmdText
Adodc3.RecordSource = "select 编号,名称,使用者 from 菜单"
Adodc3.Refresh
Set DataGrid2.DataSource = Adodc3
DataGrid2.ReBind
DataGrid2.Refresh
DataGrid2.Columns(0).Caption = "编号"
DataGrid2.Columns(1).Caption = "菜单名称"
DataGrid2.Columns(2).Caption = "使用者"
DataGrid2.Columns(0).Width = 500
Adodc1.ConnectionString = My_PROVIDER
Adodc1.ConnectionTimeout = 30
Adodc1.CursorType = adOpenStatic
Adodc1.CommandType = adCmdText
Adodc2.ConnectionString = My_PROVIDER
Adodc1.RecordSource = "select 操作员,姓名,密码,级别,权限 from 权限信息表 "
Adodc1.Refresh
End Sub
Private Sub List1_Click()
Dim i As Integer
Dim flag As Boolean
flag = True
For i = 1 To List2.ListCount
If List2.list(i - 1) = List1.Text Then flag = False
Next
If flag = True Then List2.AddItem List1.Text
End Sub
Private Sub List2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 46 Then List2.RemoveItem List2.ListIndex
End Sub
Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then Combo2.SetFocus '回车combo2获得焦点
End Sub
Private Sub ComSave_Click() '保存操作员信息
rs4.Open "select * from 权限信息表 where 操作员='" + Trim(Text3.Text) + "'", My_PROVIDER, adOpenKeyset, adLockOptimistic
If rs4.RecordCount > 0 Then
myval = MsgBox("确定要修改该操作员吗？", vbYesNo)
If myval = vbYes Then
rs4.Fields("操作员") = Trim(Text3.Text)
rs4.Fields("姓名") = Trim(Text1.Text)
rs4.Fields("密码") = Trim(Text2.Text)
rs4.Fields("级别") = Trim(Combo2.Text)
If Option2.Value = True Then
rs4.Update '更新数据库
Adodc1.Refresh
End If
Else
If Text3.Text <> "" Then
myval = MsgBox("确定要保存该操作员吗？", vbYesNo)
If myval = vbYes Then
rs4.AddNew
rs4.Fields("操作员") = Trim(Text3.Text)
rs4.Fields("姓名") = Trim(Text1.Text)
rs4.Fields("密码") = Trim(Text2.Text)
rs4.Fields("级别") = Trim(Combo2.Text)
rs4.Update '更新数据库
Adodc1.Refresh
End If
End If
End If
rs4.Close
Frame1.Visible = False
flag = False
End Sub
Private Sub ComAdd_Click() '允许添加
Text1.Text = "": Text2.Text = "": Text3.Text = "": Combo2.Text = ""
Frame1.Visible = True: Text3.Enabled = True
Text1.Enabled = True: Text2.Enabled = True
Combo2.Clear
For i = 1 To 18
Combo2.AddItem i
Next
Combo2.Text = Combo2.list(0)
Adodc1.Recordset.AddNew
Text3.SetFocus
flag = True
End Sub
Private Sub Comcancel_Click() '取消操作
Frame1.Visible = False
If flag = True Then
Adodc1.Recordset.CancelBatch adAffectCurrent
Adodc1.Recordset.MoveFirst
Else
End If
flag = False
End Sub
Private Sub Comdel_Click() '删除操作员
If Adodc1.Recordset.RecordCount > 0 And Adodc1.Recordset.Fields("级别") <> "系统管理员" Then
myval = MsgBox("确定要删除该操作员吗？", vbYesNo)
If myval = vbYes Then
Adodc1.Recordset.Delete
Adodc1.Refresh
End If
Else
MsgBox "无法删除空记录或者删除对象为系统管理员！"
End If
End Sub
Private Sub Commod_Click() '修改操作员信息
If Adodc1.Recordset.RecordCount > 0 And Adodc1.Recordset.Fields("级别") <> "系统管理员" Then
Combo2.Clear
Frame1.Visible = True
Text3.Text = Trim(Adodc1.Recordset.Fields("操作员"))
Text1.Text = Trim(Adodc1.Recordset.Fields("姓名"))
Text2.Text = Trim(Adodc1.Recordset.Fields("密码"))
Combo2.Text = Trim(Adodc1.Recordset.Fields("级别"))
Else
MsgBox "没有要修改的记录！"
End If
End Sub
Private Sub Comend_Click()
MDIForm1.Enabled = True
Unload Me
End Sub
Private Sub Form_Unload(Cancel As Integer)
MDIForm1.Enabled = True
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?