我希望能够在运行时拖动控件。
下面的代码是我在网络上找到的一个例子,它完全符合我的需要。这篇文章可以追溯到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
答案 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