📄 rl_administrator.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Begin VB.Form RL_User
BorderStyle = 3 'Fixed Dialog
Caption = "管理员设置"
ClientHeight = 5475
ClientLeft = 45
ClientTop = 330
ClientWidth = 5175
Icon = "RL_Administrator.frx":0000
KeyPreview = -1 'True
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MDIChild = -1 'True
MinButton = 0 'False
ScaleHeight = 5475
ScaleWidth = 5175
ShowInTaskbar = 0 'False
Begin MSHierarchicalFlexGridLib.MSHFlexGrid msh_User
Height = 2250
Left = 120
TabIndex = 19
Top = 3105
Width = 4935
_ExtentX = 8705
_ExtentY = 3969
_Version = 393216
TextStyleFixed = 1
AllowUserResizing= 1
_NumberOfBands = 1
_Band(0).Cols = 2
_Band(0).GridLinesBand= 1
_Band(0).TextStyleBand= 0
_Band(0).TextStyleHeader= 0
End
Begin VB.Frame fra_Administrator
Height = 2970
Left = 120
TabIndex = 18
Top = 0
Width = 4950
Begin VB.CheckBox chk_Stop
Caption = "是/否"
Height = 300
Left = 1365
TabIndex = 13
Top = 2550
Width = 1590
End
Begin MSComCtl2.DTPicker dtp_UserRegisterDate
Height = 300
Left = 1365
TabIndex = 11
Top = 2100
Width = 2000
_ExtentX = 3519
_ExtentY = 529
_Version = 393216
Enabled = 0 'False
Format = 24444928
CurrentDate = 38427
End
Begin VB.TextBox txt_TelNumber
Height = 300
Left = 1365
MaxLength = 13
TabIndex = 9
Top = 1710
Width = 2000
End
Begin VB.TextBox txt_Name
Height = 300
Left = 1365
MaxLength = 8
TabIndex = 7
Top = 1320
Width = 2000
End
Begin VB.CommandButton cmd_Quit
Caption = "关闭(&Q)"
Height = 345
Left = 3630
TabIndex = 17
Top = 1635
Width = 1095
End
Begin VB.CommandButton cmd_Delete
Caption = "删除(&D)"
Height = 345
Left = 3630
TabIndex = 16
Top = 1155
Width = 1095
End
Begin VB.CommandButton cmd_Modification
Caption = "修改(&M)"
Height = 345
Left = 3630
TabIndex = 15
Top = 690
Width = 1095
End
Begin VB.CommandButton cmd_Add
Caption = "添加(&A)"
Height = 345
Left = 3630
TabIndex = 14
Top = 240
Width = 1095
End
Begin VB.ComboBox cbo_UserGroup
Height = 300
ItemData = "RL_Administrator.frx":0CCA
Left = 1365
List = "RL_Administrator.frx":0CD4
Style = 2 'Dropdown List
TabIndex = 5
Top = 945
Width = 1995
End
Begin VB.TextBox txt_Password
Height = 300
IMEMode = 3 'DISABLE
Left = 1365
MaxLength = 10
PasswordChar = "*"
TabIndex = 3
Top = 585
Width = 2000
End
Begin VB.TextBox txt_UserName
Height = 300
Left = 1365
MaxLength = 10
TabIndex = 1
Top = 225
Width = 2000
End
Begin VB.Label lbl_Stop
Caption = "停用(&S)"
Height = 210
Left = 195
TabIndex = 12
Top = 2595
Width = 675
End
Begin VB.Label lbl_UserRegisterDate
Caption = "注册日期"
Height = 255
Left = 180
TabIndex = 10
Top = 2190
Width = 975
End
Begin VB.Label lbl_TelNumber
Caption = "联系电话(&T)"
Height = 255
Left = 180
TabIndex = 8
Top = 1800
Width = 1185
End
Begin VB.Label lbl_Name
Caption = "姓名(&N)"
Height = 255
Left = 180
TabIndex = 6
Top = 1395
Width = 855
End
Begin VB.Label lbl_Group
Caption = "权限组(&G)"
Height = 255
Left = 180
TabIndex = 4
Top = 1020
Width = 1155
End
Begin VB.Label lbl_Password
Caption = "密码(&P)"
Height = 405
Left = 180
TabIndex = 2
Top = 630
Width = 855
End
Begin VB.Label lbl_UserName
Caption = "用户名(&U)"
Height = 210
Left = 180
TabIndex = 0
Top = 270
Width = 960
End
End
End
Attribute VB_Name = "RL_User"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'***************************************************************
'*公司名：华夏学院晨光网络公司
'*系统名：红杉图书信息管理系统
'*程序名：管理员设置
'*程序ID：RL_User
'*版本：1.0.0
'*最后修改时间：2005/3/16
'*修改人：cuitianlong
'*
'*-------------------------------------------------------------
'* [年月日] [制造者]
'*-------------------------------------------------------------
'* 2005/3/16 cuitianlong
'*
'***************************************************************
Option Explicit
Dim rc As New ADODB.Recordset '定义记录集
'***************************************************************
'* 窗体加载
'*
'* [参数]
'* 无
'* [返回]
'* 无
'***************************************************************
Private Sub Form_Load()
On Error GoTo Form_Load
'--- 窗体居中设置
Call Cmn_Form_Center(Me)
'--- 设置各个控件初始值
Call Item_Clear
'---表格控件加载数据
Call Fr_Mshf
Exit Sub
Form_Load:
MsgBox "Form_Load()---出错", vbCritical, "错误"
End Sub
'***************************************************************
'* 窗体退出 [QueryUnload]
'*
'* [参数]
'* 1：系统参数
'* 2：系统参数
'* [返回]
'* 无
'***************************************************************
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
On Error GoTo Form_QueryUnload
Dim YesNo As Integer
'---执行前确认
YesNo = MsgBox("真的要退出用户管理吗？", vbYesNo + vbQuestion, "提示")
If YesNo = vbYes Then
Unload Me
Else
Cancel = 1
End If
Exit Sub
Form_QueryUnload:
MsgBox "Form_QueryUnload()---出错", vbCritical, "错误"
End Sub
'***************************************************************
'* 窗体卸载 [Unload]
'*
'* [参数]
'* 1：系统参数
'* [返回]
'* 无
'***************************************************************
Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Form_Unload
Call Cmn_Ado_DisRecordset(rc) '关闭记录集
Exit Sub
Form_Unload:
MsgBox "Form_Unload()---出错", vbCritical, "错误"
End Sub
'***************************************************************
'* 窗体项目清空
'*
'* [参数]
'* 无
'* [返回]
'* 无
'***************************************************************
Private Sub Item_Clear()
On Error GoTo Item_Clear
txt_UserName.text = ""
txt_Password.text = ""
txt_Name.text = ""
cbo_UserGroup.ListIndex = 0
txt_TelNumber.text = ""
dtp_UserRegisterDate.Value = Date
chk_Stop.Value = 0
Exit Sub
Item_Clear:
MsgBox "Item_Clear()---出错", vbCritical, "错误"
End Sub
'****************************************************************
'* Form_KeyPress
'*
'* [参数]
'* 1:系统参数
'* [返回]
'* 无
'****************************************************************
Private Sub Form_KeyPress(KeyAscii As Integer)
On Error GoTo Form_KeyPress
Select Case KeyAscii
Case vbKeyReturn
KeyAscii = &H0
If TypeOf ActiveControl Is CommandButton Then Exit Sub
'--- 焦点移动
Select Case ActiveControl.hWnd
Case Else
SendKeys "{TAB}", True
End Select
End Select
Exit Sub
Form_KeyPress:
MsgBox "Form_KeyPress()---出错", vbCritical, "错误"
End Sub
'****************************************************************
'* 项目检测
'*
'* [参数]
'* 无
'* [返回]
'* True:成功
'* False:失败
'****************************************************************
Private Function Item_Check() As Boolean
On Error GoTo Item_Check
'---返回值初始设置
Item_Check = False
Dim S_Check_UserName As String
Dim S_Check_Password As String
Dim S_Check_Name As String
Dim S_Check_TelNumber As String
'---设置用户名长度检测
S_Check_UserName = Check_Txt(txt_UserName, 0, 10, "用户名", "管理员设置")
'---设置密码长度检测
S_Check_Password = Check_Txt(txt_Password, 0, 10, "密码", "管理员设置")
'---设置姓名长度检测
S_Check_Name = Check_Txt(txt_Name, 0, 8, "姓名", "管理员设置")
'---设置联系电话长度检测
S_Check_TelNumber = Check_Txt(txt_TelNumber, 0, 13, "联系电话", "管理员设置")
'[txt_UserName]
If (False = S_Check_UserName) Then
txt_UserName.SetFocus
Exit Function
End If
'[txt_Password]
If (False = S_Check_Password) Then
txt_Password.SetFocus
Exit Function
End If
'[txt_Name]
If (False = S_Check_Name) Then
txt_Name.SetFocus
Exit Function
End If
'[txt_TelNumber]
If (False = S_Check_TelNumber) Then
txt_TelNumber.SetFocus
Exit Function
End If
'---返回值正确设置
Item_Check = True
Exit Function
Item_Check:
MsgBox "Item_Check()---出错", vbCritical, "错误"
End Function
'****************************************************************
'* 表格控件加载数据
'*
'* [参数]
'* 无
'* [返回]
'* 无
'****************************************************************
Public Function Fr_Mshf()
On Error GoTo err_Fr_Mshf
Dim S_SQL As String
S_SQL = ""
S_SQL = S_SQL & " SELECT"
S_SQL = S_SQL & " UserName as 用户名,"
S_SQL = S_SQL & " UserGroup as 权限,"
S_SQL = S_SQL & " Name as 姓名,"
S_SQL = S_SQL & " TelNumber as 联系电话,"
S_SQL = S_SQL & " UserRegisterDate as 注册日期,"
S_SQL = S_SQL & " Stop as 停用"
S_SQL = S_SQL & " From T_User"
'---执行查询语句
Call Cmn_Ado_Select_Nolock(S_SQL, rc)
msh_User.Redraw = False '不数据表格重绘
If rc.RecordCount <> 0 Then
'---有数据的情况
Set msh_User.DataSource = rc
msh_User.Row = 1
msh_User.TextMatrix(msh_User.RowSel, 0) = " →" '标出表格控件最左边的选定当前行标志"→"
Else
'---没有数据的情况
Set msh_User.DataSource = rc
msh_User.Rows = 2
msh_User.Col = 0
msh_User.Enabled = False
End If
'---设置表格控件最左边的选定当前行标志"→"列的宽度
msh_User.ColWidth(0) = 400
'---数据表格重绘
msh_User.Redraw = True
Exit Function
err_Fr_Mshf:
MsgBox "Fr_Mshf()---出错", vbCritical, "错误"
End Function
'***************************************************************
'* cmd_ADD_Click
'*
'* [参数]
'* 无
'* [返回]
'* 无
'***************************************************************
Private Sub cmd_Add_Click()
On Error GoTo cmd_Add_Click
'---项目检测
If Item_Check() = False Then
Exit Sub
End If
Call Data_Insert
Call Fr_Mshf
Exit Sub
cmd_Add_Click:
MsgBox "cmd_ADD_Click()---出错", vbCritical, "错误"
End Sub
'***************************************************************
'* cmd_Modification_Click
'*
'* [参数]
'* 无
'* [返回]
'* 无
'***************************************************************
Private Sub cmd_Modification_Click()
On Error GoTo cmd_Modification_Click
Call Data_Upd
Call Item_Clear
txt_UserName.Enabled = True
Exit Sub
cmd_Modification_Click:
MsgBox "cmd_Modification_Click()---出错", vbCritical, "错误"
End Sub
'***************************************************************
'* cmd_Delete_Click
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -