⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frm_aduser.frm

📁 宇迪erp,企业erp模块一
💻 FRM
📖 第 1 页 / 共 2 页
字号:
        .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 + -