Feedback

VB - ControlResize wie in der IDE auch zur Laufzeit

Veröffentlicht von am 11/19/2006
(3 Bewertungen)
Diese Klasse ermöglicht es einem die Größe und Position eines Controls während der Laufzeit zu verändern, dazu werden 8 sogenannte GrabRects um das Control gezeichnet (wie man es aus der IDE kennt) von denen man 3 (gelb untermalt) benutzen kann um die Größe zu verändern (in Visual Studio geht das bei allen Ecken). Um das Control zu verschieben geht man genauso vor wie in VS.

Wenn man die Funktionalität entfernen will muss man die Finish-Methode aufrufen.
Public Class clsResizeControl
    Private WithEvents mControl As Control
    Private WithEvents mOwnerForm As Form
    Private GRS As Integer = 6
    Private InResizeMode As Boolean = False
    Private MoveControl As Boolean = False
    Private LastMousePos As Point
    Private mMinWidth As Integer = 20
    Private mMinHeigth As Integer = 20
    Public GrabRectColor As Color = Color.Yellow

    Private GrabRects() As Control = { _
        New Control, _
        New Control, _
        New Control, _
        New Control, _
        New Control, _
        New Control, _
        New Control, _
        New Control}

    ''' <summary>
    ''' Diese Routine muss aufgerufen werden wenn man die Resize-Funktionalität vom Control entfernen möchte.
    ''' </summary>
    Public Sub Finish()
        RemoveHandler mOwnerForm.Paint, AddressOf Paint

        RemoveHandler mControl.MouseDown, AddressOf ControlMouseDown
        RemoveHandler mControl.MouseMove, AddressOf ControlMouseMove
        RemoveHandler mControl.MouseUp, AddressOf ControlMouseUp

        For i As Integer = 0 To GrabRects.Length - 1
            RemoveHandler GrabRects(i).Paint, AddressOf GrabRectPaint
            RemoveHandler GrabRects(i).MouseClick, AddressOf GrabRectMouseClick
            RemoveHandler GrabRects(i).MouseMove, AddressOf GrabRectMouseMove
            RemoveHandler GrabRects(i).MouseDown, AddressOf GrabRectMouseDown
            RemoveHandler GrabRects(i).MouseUp, AddressOf GrabRectMouseUp
            RemoveHandler GrabRects(i).Move, AddressOf GrabRectMove

            GrabRects(i).Dispose()
        Next

        GrabRects = Nothing

        mOwnerForm.Refresh()
    End Sub

    Sub New(ByVal NewControl As Control, ByVal OwnerForm As Form)
        mControl = NewControl
        mOwnerForm = OwnerForm

        AddHandler mOwnerForm.Paint, AddressOf Paint

        AddHandler mControl.MouseDown, AddressOf ControlMouseDown
        AddHandler mControl.MouseMove, AddressOf ControlMouseMove
        AddHandler mControl.MouseUp, AddressOf ControlMouseUp

        mControl.Cursor = Cursors.SizeAll

        For i As Integer = 0 To GrabRects.Length - 1
            AddHandler GrabRects(i).Paint, AddressOf GrabRectPaint
            AddHandler GrabRects(i).MouseClick, AddressOf GrabRectMouseClick
            AddHandler GrabRects(i).MouseMove, AddressOf GrabRectMouseMove
            AddHandler GrabRects(i).MouseDown, AddressOf GrabRectMouseDown
            AddHandler GrabRects(i).MouseUp, AddressOf GrabRectMouseUp
            AddHandler GrabRects(i).Move, AddressOf GrabRectMove
        Next

        mOwnerForm.Refresh()
    End Sub

    Private Sub ControlMouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)
        MoveControl = True
        LastMousePos = New Point(e.X, e.Y)

        For i As Integer = 0 To GrabRects.Length - 1
            GrabRects(i).Visible = False
        Next
        mOwnerForm.Refresh()
    End Sub

    Private Sub ControlMouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)
        If MoveControl = True Then
            mControl.Left = mControl.Left + e.X - LastMousePos.X
            mControl.Top = mControl.Top + e.Y - LastMousePos.Y
            mOwnerForm.Refresh()
        End If
    End Sub

    Private Sub ControlMouseUp(ByVal sender As Object, ByVal e As MouseEventArgs)
        MoveControl = False

        For i As Integer = 0 To GrabRects.Length - 1
            GrabRects(i).Visible = True
        Next
        mOwnerForm.Refresh()
    End Sub

    Public Sub Paint(ByVal sender As Object, ByVal e As PaintEventArgs)
        If InResizeMode = True Or MoveControl = True Then Exit Sub
        With e.Graphics
            'Rahmen
            .DrawRectangle(Pens.Gray, New Rectangle( _
            mControl.Location.X - (GRS / 2), _
            mControl.Location.Y - (GRS / 2), _
            mControl.Width + GRS, _
            mControl.Height + GRS))

            'Positionen für die GrabRects in der Reihenfolge:
            'TopLeft, TopMiddle, TopRight, MiddleLeft, MiddleRight, BottomLeft,BottomMiddle,BottomRight
            Dim GrabRectPos() As Point = { _
            New Point(mControl.Location.X - GRS, mControl.Location.Y - GRS), _
            New Point(mControl.Location.X + (mControl.Width / 2) - (GRS / 2), mControl.Location.Y - GRS), _
            New Point(mControl.Location.X + mControl.Width, mControl.Location.Y - GRS), _
            New Point(mControl.Location.X - GRS, mControl.Location.Y + (mControl.Height / 2) - (GRS / 2)), _
            New Point(mControl.Location.X + (mControl.Width), mControl.Location.Y + (mControl.Height / 2) - (GRS / 2)), _
            New Point(mControl.Location.X - GRS, mControl.Location.Y + (mControl.Height)), _
            New Point(mControl.Location.X + (mControl.Width / 2) - (GRS / 2), mControl.Location.Y + (mControl.Height)), _
            New Point(mControl.Location.X + mControl.Width, mControl.Location.Y + (mControl.Height))}

            For i As Integer = 0 To GrabRects.Length - 1
                GrabRects(i).Location = GrabRectPos(i)
                GrabRects(i).Size = New Size(GRS, GRS)
                GrabRects(i).BackColor = Color.White
                GrabRects(i).Parent = mOwnerForm
            Next

            GrabRects(4).BackColor = GrabRectColor
            GrabRects(6).BackColor = GrabRectColor
            GrabRects(7).BackColor = GrabRectColor
        End With
    End Sub

    Private Sub GrabRectPaint(ByVal sender As Object, ByVal e As PaintEventArgs)
        e.Graphics.DrawRectangle(Pens.Black, New Rectangle(0, 0, GRS - 1, GRS - 1))
    End Sub

    Private Sub GrabRectMove(ByVal sender As Object, ByVal e As System.EventArgs)
        Dim CurrControl As Control = CType(sender, Control)
        Dim Index As Integer = GetCurrIndex(sender)
    End Sub

    Private Sub GrabRectMouseClick(ByVal sender As Object, ByVal e As MouseEventArgs)
        Dim CurrControl As Control = CType(sender, Control)
        Dim Index As Integer = GetCurrIndex(sender)
    End Sub

    Private Sub GrabRectMouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)
        Dim CurrControl As Control = CType(sender, Control)
        Dim Index As Integer = GetCurrIndex(sender)
        Dim MousePos As Point
        Static Right As Integer
        Static Bottom As Integer

        Select Case Index
            Case 0 : CurrControl.Cursor = Cursors.SizeNWSE
            Case 1 : CurrControl.Cursor = Cursors.SizeNS
            Case 2 : CurrControl.Cursor = Cursors.SizeNESW

            Case 3 : CurrControl.Cursor = Cursors.SizeWE
            Case 4 : CurrControl.Cursor = Cursors.SizeWE

            Case 5 : CurrControl.Cursor = Cursors.SizeNESW
            Case 6 : CurrControl.Cursor = Cursors.SizeNS
            Case 7 : CurrControl.Cursor = Cursors.SizeNWSE
        End Select

        If InResizeMode = True Then
            MousePos = mOwnerForm.PointToClient(Cursor.Position)
            CurrControl.Left = mOwnerForm.PointToClient(Cursor.Position).X 'CurrControl.Left + e.X
            CurrControl.Top = mOwnerForm.PointToClient(Cursor.Position).Y 'CurrControl.Top + e.Y

            Dim TmpHeigth As Integer
            Dim TmpWidth As Integer

            Select Case Index
                Case 0 'TopLeft GrabButton

                Case 1 'TopMiddle GrabButton

                Case 2 'TopRight GrabButton

                Case 3 'MiddleLeft GrabButton

                Case 4 'MiddleRight GrabButton
                    TmpWidth = GrabRects(4).Left - mControl.Left
                    If TmpWidth < mMinWidth Then TmpWidth = mMinWidth
                    mControl.Width = TmpWidth

                Case 5 'BottomLeft GrabButton

                Case 6 'BottomMiddle GrabButton
                    TmpHeigth = CurrControl.Top - mControl.Top
                    If TmpHeigth < mMinHeigth Then TmpHeigth = mMinHeigth
                    mControl.Height = TmpHeigth

                Case 7 'BottomRight GrabButton
                    TmpHeigth = CurrControl.Top - mControl.Top
                    TmpWidth = CurrControl.Left - mControl.Left

                    If TmpHeigth < mMinHeigth Then TmpHeigth = mMinHeigth
                    If TmpWidth < mMinWidth Then TmpWidth = mMinWidth

                    mControl.Size = New Size(TmpWidth, TmpHeigth)
            End Select
            mOwnerForm.Refresh()
        Else
            Right = mControl.Right
            Bottom = mControl.Bottom
        End If
    End Sub

    Private Sub GrabRectMouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)
        InResizeMode = True
        For i As Integer = 0 To GrabRects.Length - 1
            GrabRects(i).Visible = False
        Next
        mOwnerForm.Refresh()
    End Sub

    Private Sub GrabRectMouseUp(ByVal sender As Object, ByVal e As MouseEventArgs)
        InResizeMode = False
        For i As Integer = 0 To GrabRects.Length - 1
            GrabRects(i).Visible = True
        Next
        mOwnerForm.Refresh()
    End Sub

    Private Function GetCurrIndex(ByVal sender As Object) As Integer
        Dim CurrControl As Control = CType(sender, Control)
        For i As Integer = 0 To GrabRects.Length
            If GrabRects(i) Is CurrControl Then
                Return i
            End If
        Next
    End Function
End Class
Abgelegt unter Größe, Control.

1 Kommentare zum Snippet

Ed.Monsur schrieb am 10/30/2020:
und wie tut man es zum laufen bringen?
 

Logge dich ein, um hier zu kommentieren!