动态改变控件大小的有关问题，目前只能向左和向上拉伸，向右和向下出错，vb.net2008，附代码

2013-03-26

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

求助动态改变控件大小的问题，目前只能向左和向上拉伸，向右和向下出错，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

动态改变控件大小的有关问题，目前只能向左和向上拉伸，向右和向下出错，vb.net2008，附代码