在运行时拖动控件 - 如何锁定控件

时间:2015-11-22 15:53:19

标签: vb.net

我希望能够在运行时拖动控件。

下面的代码是我在网络上找到的一个例子,它完全符合我的需要。这篇文章可以追溯到2009年,而且已经相当死了,所以我无法提出任何问题。 此代码的问题在于可以移动表单上的每个控件。即使锁定某些控件也是如此。

有没有办法防止移动某些控件?

Public Class Form1
    Dim dragging As Boolean
    Dim startX As Integer
    Dim startY As Integer
    Private Sub Form1_Load(ByVal sender As System.Object, _
        ByVal e As System.EventArgs) Handles MyBase.Load
        'TODO: This line of code loads data into the 
        ''NorthwindDataSet.Employees' table. You can move, or remove it, as needed.
        Me.EmployeesTableAdapter.Fill(Me.NorthwindDataSet.Employees)
        For Each Control As Control In Me.Controls
            AddHandler Control.MouseDown, AddressOf startDrag
            AddHandler Control.MouseMove, AddressOf whileDragging
            AddHandler Control.MouseUp, AddressOf endDrag
        Next
        For Each Control As Control In Me.Controls
            For Each item In My.Settings.controlLocations
                If Split(item, "!")(0) = Control.Name Then
                    Control.Location = New Point(Split(item, "!")(1), _
                        Split(item, "!")(2))
                End If
            Next
        Next
    End Sub
    Private Sub startDrag(ByVal sender As Object, _
        ByVal e As System.Windows.Forms.MouseEventArgs)
        dragging = True
        startX = e.X
        startY = e.Y
    End Sub
    Private Sub whileDragging(ByVal sender As System.Object, _
        ByVal e As System.Windows.Forms.MouseEventArgs)
        If dragging = True Then
            sender.Location = New Point(sender.Location.X + _
        e.X - startX, sender.Location.Y + e.Y - startY)
            Me.Refresh()
        End If
    End Sub
    Private Sub endDrag(ByVal sender As System.Object, ByVal e As System.EventArgs)
        dragging = False
        My.Settings.controlLocations.Clear()
        For Each Control As Control In Me.Controls
            My.Settings.controlLocations.Add(Control.Name & "!" _
        & Control.Location.X & "!" & Control.Location.Y)
        Next
        My.Settings.Save()
    End Sub
End Class

3个子工作完成所有工作,并且有一个名为controlLocations的空白My.Settings存储位置。

编辑1 例如:

For Each label1 As Control In Me.Controls
            AddHandler label1.MouseDown, AddressOf startDrag
            AddHandler label1.MouseMove, AddressOf whileDragging
            AddHandler label1.MouseUp, AddressOf endDrag
        Next
        For Each label1 As Control In Me.Controls
            For Each item In My.Settings.controlLocations
                If Split(item, "!")(0) = label1.Name Then
                    label1.Location = New Point(Split(item, "!")(1), Split(item, "!")(2))
                End If
            Next
        Next

1 个答案:

答案 0 :(得分:1)

找到解决方案。下面的代码将允许用户在窗体中移动控件(只有他们希望移动的控件)。只需为sub后面的每个控件添加处理程序。

        Dim startx As Integer
        Dim starty As Integer
        Dim endy As Integer
        Dim endx As Integer
        Dim finalx As Integer
        Dim finaly As Integer
        Dim mdown As Boolean
        Dim valx As Boolean
        Dim valy As Boolean

        Private Sub Main_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)

        End Sub

        Private Sub MuisDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
            startx = MousePosition.X
            starty = MousePosition.Y
            mdown = True
            valx = False
            valy = False
        End Sub

        Private Sub MuisUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
            mdown = False
            valx = False
            valy = False
        End Sub

        Private Sub MuisMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs)
            If mdown = True Then
                endx = (MousePosition.X - Me.Left)
                endy = (MousePosition.Y - Me.Top)

                If valy = False Then
                    starty = endy - sender.top
                    valy = True
                End If
                If valx = False Then
                    startx = endx - sender.left
                    valx = True
                End If
                sender.left = endx - startx
                sender.top = endy - starty
            End If
        End Sub

示例Label1 + PictureBox1

Private Sub MuisDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Label1.MouseDown, PictureBox1.MouseDown

Private Sub MuisUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Label1.MouseUp, PictureBox1.MouseUp

Private Sub MuisMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Label1.MouseMove, PictureBox1.MouseMove