📄 frm_aduser.frm
字号:
.MoveNext
Loop
.Close
Set aDo_Group = Nothing
End With
'------------------
Set aDo_User = Conn_System.Execute("select * from " & ListView1.Tag & ".dbo.Gy_Czygl ORDER BY czymc")
ListView1.ListItems.Clear
With aDo_User
Do While Not .EOF
Set mitem = ListView1.ListItems.Add()
mitem.Text = !czymc
mitem.SmallIcon = "U"
mitem.Icon = "U"
mitem.SubItems(1) = "" & !Explain
mitem.Key = "T" & Trim(!czybm)
.MoveNext
Loop
.Close
Set aDo_Group = Nothing
End With
Exit Sub
error_exit:
MsgBox Err.Description, 16
Unload Me
End Sub
Private Sub Form_Load()
SizeControls Image1.Top
End Sub
Private Sub Form_Resize()
On Error Resume Next
If Me.Height < 4000 Then Me.Height = 4000
SizeControls Image1.Top
End Sub
Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
With Image1
Picture1.Move .Left, .Top, .Width, .Height / 2
End With
Picture1.Visible = True
mbMoving = True
End Sub
Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim sglPos As Single
If mbMoving Then
sglPos = Y + Image1.Top
If sglPos < sglSplitLimit Then
Picture1.Top = sglSplitLimit
ElseIf sglPos > Me.Height - sglSplitLimit Then
Picture1.Top = Me.Height - sglSplitLimit
Else
Picture1.Top = sglPos
End If
End If
End Sub
Private Sub Image1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
SizeControls Picture1.Top
Picture1.Visible = False
mbMoving = False
End Sub
Sub SizeControls(X As Single)
On Error Resume Next
If X < 1000 Then X = 1000
If X > Me.Height - 1500 - Toolbar.Height Then X = Me.Height - 1500 + Toolbar.Height
ListView1.Height = X - Toolbar.Height
Image1.Top = X
ListView2.Top = X + 140
ListView2.Height = Me.Height - (ListView1.Height + Image1.Height + 400) - Toolbar.Height
ListView1.Width = Me.Width - 100
ListView2.Width = Me.Width - 100
Image1.Width = Me.Width - 100
End Sub
Private Sub ListView1_DblClick()
If ListView1.ListItems.Count <= 0 Then Exit Sub
Requery_TF = True
Frm_NewUser.SSTab.Tag = ListView1.Tag
Frm_NewUser.Tag = "UE"
Frm_NewUser.UserCode = Mid(ListView1.SelectedItem.Key, 2, Len(ListView1.SelectedItem.Key))
Frm_NewUser.Text1(0).Text = Trim(ListView1.SelectedItem.Text)
Frm_NewUser.Text1(3).Text = ListView1.SelectedItem.SubItems(1)
Frm_NewUser.Text1(0).Tag = ListView1.SelectedItem.Key
Frm_NewUser.Show 1
If UserGroupName <> "" Then
ListView1.SelectedItem.Text = UserGroupName
ListView1.SelectedItem.SubItems(1) = Explain
End If
End Sub
Private Sub ListView1_GotFocus()
UserGroupTF = True
End Sub
Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
UserGroupTF = True
PopupMenu Me.User, , X, Y + ListView1.Top
End If
End Sub
Private Sub ListView2_DblClick()
If ListView2.ListItems.Count <= 0 Then Exit Sub
Requery_TF = True
Frm_NewUser.SSTab.Tag = ListView1.Tag
If UserGroupTF = False Then
Frm_NewUser.Tag = "GE"
Frm_NewUser.Text2(0).Text = ListView2.SelectedItem.Text
Frm_NewUser.Text2(1).Text = ListView2.SelectedItem.SubItems(1)
Frm_NewUser.Text2(0).Tag = ListView2.SelectedItem.Key
Frm_NewUser.Show 1
If UserGroupName <> "" Then
ListView2.SelectedItem.Text = UserGroupName
ListView2.SelectedItem.SubItems(1) = Explain
ListView2.SelectedItem.Key = UserGroupName
End If
End If
End Sub
Private Sub ListView2_GotFocus()
UserGroupTF = False
End Sub
Private Sub ListView2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
UserGroupTF = False
PopupMenu Me.gurop, , X, Y + ListView2.Top
End If
End Sub
Private Sub NewUser_Click()
Tool_comm NewUser.Name
End Sub
Private Sub NewUserGroup_Click()
Tool_comm NewUserGroup.Name
End Sub
Private Sub Properth_Click()
Tool_comm Properth.Name
End Sub
Private Sub Authorization_Click()
Tool_comm Authorization.Name
End Sub
Private Sub Del_Click()
Tool_comm Del.Name
End Sub
Private Sub GroupProperth_Click()
Tool_comm "Properth"
End Sub
Private Sub GroupAuthorization_Click()
Tool_comm "Authorization"
End Sub
Private Sub GroupDel_Click()
Tool_comm "Del"
End Sub
Private Sub Toolbar_ButtonMenuClick(ByVal ButtonMenu As MSComctlLib.ButtonMenu)
Tool_comm ButtonMenu.Key
End Sub
Sub Tool_comm(KeyStr As String)
Select Case KeyStr
Case "Exit"
Unload Me
Case "NewUserGroup"
Requery_TF = True
Frm_NewUser.SSTab.Tag = ListView1.Tag
Frm_NewUser.Tag = "G"
Frm_NewUser.Show 1
If UserGroupName <> "" Then
Set mitem = ListView2.ListItems.Add()
mitem.Text = UserGroupName
mitem.SmallIcon = "G"
mitem.Icon = "G"
mitem.SubItems(1) = Explain
mitem.Key = UserGroupName
End If
Case "NewUser"
Requery_TF = True
Frm_NewUser.SSTab.Tag = ListView1.Tag
Frm_NewUser.Tag = "U"
Frm_NewUser.Show 1
If UserGroupName <> "" Then
Set mitem = ListView1.ListItems.Add()
mitem.Text = Trim(UserGroupName)
mitem.SmallIcon = "U"
mitem.Icon = "U"
mitem.SubItems(1) = Trim(Explain)
mitem.Key = "T" & UserId
End If
Case "Properth"
Requery_TF = True
Frm_NewUser.SSTab.Tag = ListView1.Tag
If UserGroupTF = False Then
If ListView2.ListItems.Count <= 0 Then Exit Sub
Frm_NewUser.Tag = "GE"
Frm_NewUser.Text2(0).Text = ListView2.SelectedItem.Text
Frm_NewUser.Text2(1).Text = ListView2.SelectedItem.SubItems(1)
Frm_NewUser.Text2(0).Tag = ListView2.SelectedItem.Key
Frm_NewUser.Show 1
If UserGroupName <> "" Then
ListView2.SelectedItem.Text = UserGroupName
ListView2.SelectedItem.SubItems(1) = Explain
ListView2.SelectedItem.Key = UserGroupName
End If
End If
'-----------------
If UserGroupTF = True Then
If ListView1.ListItems.Count <= 0 Then Exit Sub
Frm_NewUser.Tag = "UE"
Frm_NewUser.UserCode = Mid(ListView1.SelectedItem.Key, 2, Len(ListView1.SelectedItem.Key))
Frm_NewUser.Text1(0).Text = Trim(ListView1.SelectedItem.Text)
Frm_NewUser.Text1(3).Text = ListView1.SelectedItem.SubItems(1)
Frm_NewUser.Text1(0).Tag = ListView1.SelectedItem.Key
Frm_NewUser.Show 1
If UserGroupName <> "" Then
ListView1.SelectedItem.Text = UserGroupName
ListView1.SelectedItem.SubItems(1) = Explain
End If
End If
Case "Del"
On Error GoTo err_exit
If UserGroupTF = False And ListView2.ListItems.Count > 0 Then
YesNoStr = MsgBox("你是否要删除此组? ", vbYesNo + 32)
If YesNoStr = vbNo Then Exit Sub
Conn_System.Execute "delete " & ListView1.Tag & ".dbo.System_UserGroup " _
& "where GroupName='" & ListView2.SelectedItem.Text & "'"
ListView2.ListItems.Remove (ListView2.SelectedItem.Index)
End If
If UserGroupTF = True And ListView1.ListItems.Count > 0 Then
YesNoStr = MsgBox("你是否要删除此用户? ", vbYesNo + 32)
If YesNoStr = vbNo Then Exit Sub
Conn_System.Execute "delete " & ListView1.Tag & ".dbo.Gy_Czygl " _
& "where czymc='" & ListView1.SelectedItem.Text & "'"
ListView1.ListItems.Remove (ListView1.SelectedItem.Index)
End If
SendKeys "{left}", True
Exit Sub
err_exit:
MsgBox Err.Description, 16
Case "Refresh"
Form_Activate
Case "Authorization"
Requery_TF = True
Frm_Authorization.Tag = ListView1.Tag
If UserGroupTF = False Then
If ListView2.ListItems.Count <= 0 Then Exit Sub
Frm_Authorization.Caption = Frm_Authorization.Caption & "---" & Trim(ListView2.SelectedItem.Text) & "(组)"
Frm_Authorization.TreeView1.Tag = ListView2.SelectedItem.Text
Frm_Authorization.ListView1.Tag = "G"
End If
If UserGroupTF = True Then
If ListView1.ListItems.Count <= 0 Then Exit Sub
Frm_Authorization.Caption = Frm_Authorization.Caption & "---" & Trim(ListView1.SelectedItem.Text) & "(用户)"
Frm_Authorization.TreeView1.Tag = Mid(ListView1.SelectedItem.Key, 2, Len(ListView1.SelectedItem.Key))
Frm_Authorization.ListView1.Tag = "U"
End If
Frm_Authorization.Show 1
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -