frm_aduser.frm

VB开发的ERP系统

    Dim mItem  As ListItem
    
    Set aDo_Group = Conn_System.Execute("Select * from " & lvUser.Tag & ".dbo.System_UserGroup")
    lvGroup.ListItems.Clear
    With aDo_Group
        Do While Not .EOF
            Set mItem = lvGroup.ListItems.Add()
            mItem.Text = !GroupName
            mItem.SmallIcon = "G"
            mItem.Icon = "G"
            mItem.SubItems(1) = !Explain
            mItem.Key = "G" & !GroupName
            .MoveNext
        Loop
        .Close
        Set aDo_Group = Nothing
    End With
    
    '--------------------------------
    Set aDo_User = Conn_System.Execute("select * from " & lvUser.Tag & ".dbo.Gy_Czygl ORDER BY czymc")
    lvUser.ListItems.Clear
    With aDo_User
    Do While Not .EOF
        Set mItem = lvUser.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
     lvUser.Height = X - Toolbar.Height
     Image1.Top = X
     lvGroup.Top = X + 140
     lvGroup.Height = Me.Height - (lvUser.Height + Image1.Height + 400) - Toolbar.Height

     lvUser.Width = Me.Width - 100
     lvGroup.Width = Me.Width - 100
     Image1.Width = Me.Width - 100
End Sub

Private Sub lvUser_DblClick()
     If lvUser.ListItems.Count <= 0 Then Exit Sub
     Requery_TF = True
     Frm_NewUser.SSTab.Tag = lvUser.Tag
     Frm_NewUser.Tag = "UE"
     Frm_NewUser.UserCode = Mid(lvUser.SelectedItem.Key, 2, Len(lvUser.SelectedItem.Key))
     Frm_NewUser.Text1(0).Text = Trim(lvUser.SelectedItem.Text)
     Frm_NewUser.Text1(3).Text = lvUser.SelectedItem.SubItems(1)
     Frm_NewUser.Text1(0).Tag = lvUser.SelectedItem.Key
     Frm_NewUser.Show 1
     If UserGroupName <> "" Then
        lvUser.SelectedItem.Text = UserGroupName
        lvUser.SelectedItem.SubItems(1) = Explain
     End If
End Sub

Private Sub lvUser_GotFocus()
    UserGroupTF = True
End Sub

Private Sub lvUser_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        UserGroupTF = True
        PopupMenu Me.User, , X, Y + lvUser.Top
    End If
End Sub

Private Sub lvGroup_DblClick()
    If lvGroup.ListItems.Count <= 0 Then Exit Sub
    
    Requery_TF = True
    Frm_NewUser.SSTab.Tag = lvUser.Tag
    If UserGroupTF = False Then
        Frm_NewUser.Tag = "GE"
        Frm_NewUser.Text2(0).Text = lvGroup.SelectedItem.Text
        Frm_NewUser.Text2(1).Text = lvGroup.SelectedItem.SubItems(1)
        Frm_NewUser.Text2(0).Tag = lvGroup.SelectedItem.Key
        Frm_NewUser.Show 1
        If UserGroupName <> "" Then
            lvGroup.SelectedItem.Text = UserGroupName
            lvGroup.SelectedItem.SubItems(1) = Explain
            lvGroup.SelectedItem.Key = UserGroupName
        End If
    End If
End Sub

Private Sub lvGroup_GotFocus()
    UserGroupTF = False
End Sub

Private Sub lvGroup_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then
        UserGroupTF = False
        PopupMenu Me.gurop, , X, Y + lvGroup.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 = lvUser.Tag
         Frm_NewUser.Tag = "G"
         Frm_NewUser.Show 1
         If UserGroupName <> "" Then
             Set mItem = lvGroup.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 = lvUser.Tag
         Frm_NewUser.Tag = "U"
         Frm_NewUser.Show 1
         If UserGroupName <> "" Then
             Set mItem = lvUser.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 = lvUser.Tag
         If UserGroupTF = False Then
          If lvGroup.ListItems.Count <= 0 Then Exit Sub
          Frm_NewUser.Tag = "GE"
          Frm_NewUser.Text2(0).Text = lvGroup.SelectedItem.Text
          Frm_NewUser.Text2(1).Text = lvGroup.SelectedItem.SubItems(1)
          Frm_NewUser.Text2(0).Tag = lvGroup.SelectedItem.Key
          Frm_NewUser.Show 1
          If UserGroupName <> "" Then
             lvGroup.SelectedItem.Text = UserGroupName
             lvGroup.SelectedItem.SubItems(1) = Explain
             lvGroup.SelectedItem.Key = UserGroupName
          End If
         End If
         '-----------------
         If UserGroupTF = True Then
          If lvUser.ListItems.Count <= 0 Then Exit Sub
          Frm_NewUser.Tag = "UE"
          Frm_NewUser.UserCode = Mid(lvUser.SelectedItem.Key, 2, Len(lvUser.SelectedItem.Key))
          Frm_NewUser.Text1(0).Text = Trim(lvUser.SelectedItem.Text)
          Frm_NewUser.Text1(3).Text = lvUser.SelectedItem.SubItems(1)
          Frm_NewUser.Text1(0).Tag = lvUser.SelectedItem.Key
          Frm_NewUser.Show 1
          If UserGroupName <> "" Then
             lvUser.SelectedItem.Text = UserGroupName
             lvUser.SelectedItem.SubItems(1) = Explain
          End If
         End If
         
         
    Case "Del"
         On Error GoTo ERR_EXIT
          If UserGroupTF = False And lvGroup.ListItems.Count > 0 Then
          YesNoStr = MsgBox("你是否要删除此组？  ", vbYesNo + 32)
          If YesNoStr = vbNo Then Exit Sub
          
          Conn_System.Execute "delete " & lvUser.Tag & ".dbo.System_UserGroup " _
                           & "where GroupName='" & lvGroup.SelectedItem.Text & "'"
          lvGroup.ListItems.Remove (lvGroup.SelectedItem.Index)
          
          End If
          
          If UserGroupTF = True And lvUser.ListItems.Count > 0 Then
             YesNoStr = MsgBox("你是否要删除此用户？  ", vbYesNo + 32)
             If YesNoStr = vbNo Then Exit Sub
             Conn_System.Execute "delete " & lvUser.Tag & ".dbo.Gy_Czygl " _
                              & "where czymc='" & lvUser.SelectedItem.Text & "'"
             lvUser.ListItems.Remove (lvUser.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 = lvUser.Tag
         If UserGroupTF = False Then
             If lvGroup.ListItems.Count <= 0 Then Exit Sub
             Frm_Authorization.Caption = Frm_Authorization.Caption & "---" & Trim(lvGroup.SelectedItem.Text) & "(组)"
             Frm_Authorization.TreeView1.Tag = lvGroup.SelectedItem.Text
             Frm_Authorization.lvUser.Tag = "G"
         End If
         
         If UserGroupTF = True Then
             If lvUser.ListItems.Count <= 0 Then Exit Sub
             Frm_Authorization.Caption = Frm_Authorization.Caption & "---" & Trim(lvUser.SelectedItem.Text) & "(用户)"
             Frm_Authorization.TreeView1.Tag = Mid(lvUser.SelectedItem.Key, 2, Len(lvUser.SelectedItem.Key))
             Frm_Authorization.lvUser.Tag = "U"
         End If
         
         Frm_Authorization.Show 1
    End Select
End Sub