读书人

动态改变控件大小的有关问题目前只能

发布时间: 2012-12-22 12:05:07 作者: rapoo

求助动态改变控件大小的问题,目前只能向左和向上拉伸,向右和向下出错,vb.net2008,附代码请指教



Public Class tuofang
Dim OldX As Integer
Dim OldY As Integer
Enum mPosition

Left

Right

Top

Bottom

End Enum

Dim Adjust As mPosition
Private Sub Label1_MouseDown(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Label1.MouseDown
OldX = e.X
OldY = e.Y
End Sub

Private Sub Label1_MouseMove(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Label1.MouseMove
Dim rectLeft As New Rectangle(0, 2, 2, Label1.Height - 4)
Dim rectRight As New Rectangle(Label1.Width - 2, 2, 2, Label1.Height - 4)
Dim rectTop As New Rectangle(2, 0, Label1.Width - 4, 2)
Dim rectBottom As New Rectangle(2, Label1.Height - 2, Label1.Width - 4, 2)

If rectLeft.Contains(e.X, e.Y) Then
Adjust = mPosition.Left
Label1.Cursor = Cursors.SizeWE
ElseIf rectRight.Contains(e.X, e.Y) Then
Adjust = mPosition.Right
Label1.Cursor = Cursors.SizeWE
ElseIf rectTop.Contains(e.X, e.Y) Then
Adjust = mPosition.Top
Label1.Cursor = Cursors.SizeNS
ElseIf rectBottom.Contains(e.X, e.Y) Then
Adjust = mPosition.Bottom
Label1.Cursor = Cursors.SizeNS
Else
Label1.Cursor = Cursors.Default
End If

If e.Button = Windows.Forms.MouseButtons.Left Then
Dim dx As Integer = e.X - OldX
Dim dy As Integer = e.Y - OldY
TextBox1.Text = dx


Select Case Adjust
Case mPosition.Left
Label1.Left += dx
Label1.Width -= dx
Case mPosition.Right
Dim cy As Integer = Label1.Right '这里像上面直接用Label1.Right-=dx会提示出错,显示"Right"为"ReadOnly",不明白是为什么。只有这样写了代码才不提示出错。郁闷~~
cy -= dx
Label1.Width += dx
Case mPosition.Top
Label1.Top += dy
Label1.Height -= dy
Case mPosition.Bottom
Dim cb As Integer = Me.Label1.Bottom
cb -= dy
Label1.Height += dy
End Select
End If
End Sub

Private Sub Label1_MouseUp(ByVal sender As System.Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Label1.MouseUp
ss = False
If e.Button = Windows.Forms.MouseButtons.Left Then
Dim dx As Integer = e.X - OldX
Dim dy As Integer = e.Y - OldY
Select Case Adjust
Case mPosition.Left
Label1.Left += dx
Label1.Width -= dx
Case mPosition.Right
Dim cy As Integer = Label1.Right
cy -= dx


Label1.Width += dx
Case mPosition.Top
Label1.Top += dy
Label1.Height -= dy
Case mPosition.Bottom
Label1.Height += dy
End Select
End If
End Sub



向右和向上拉伸均正常,可使用同样代码向右和向下拉伸就出错了。图像显示不成确,好像是label改变大小后找不到边界,一直无限向右或向下延伸~~~
请高手指点代码错误~~~
只要指点个向右或向下其中一个方向的编写方法即可,其它方向便都明白了。多谢
[最优解释]

'矩形Rectangle只有Location和SIZE可以修改,其它的都是自动根据这两项生成的为只读属性
If e.Button = Windows.Forms.MouseButtons.Left Then
Dim dx As Integer = e.X - OldX
Dim dy As Integer = e.Y - OldY
TextBox1.Text = dx
'此处新增
Application.DoEvents()
Select Case Adjust
Case mPosition.Left
Label1.Left += dx
Label1.Width -= dx
Case mPosition.Right
'此处新增
OldX = e.X
Label1.Width += dx
Case mPosition.Top
Label1.Top += dy
Label1.Height -= dy
Case mPosition.Bottom
'此处新增
OldY = e.Y


Label1.Height += dy
End Select
End If


[其他解释]
动态改变向右和向下不能得到效果,不能判断边界
[其他解释]
哎呀一下明白~~~又钻牛角了刚才~~多谢老师指导~~~

读书人网 >VB Dotnet

热点推荐