Feedback

VB - Control Resize wie in der IDE auch zur Laufzeit - Extended

Veröffentlicht von am 8/9/2007
(0 Bewertungen)
Basierend auf dem Code von Khartak und desen freundlicher Genehmigung zur Veröffentlichung, stelle ich hier die etwas Modifizierte Resizeklasse zur Verfügung.
Ich habe hier das Label als Control Hardcodiert, und das Control nach allen Seiten Resizable gemacht.
Außerdem habe ich ein Kontextmenu zum Aktivieren/Deaktivieren des Controls implementiert.

Original: http://dotnet-snippets.de/dns/Snippet_detail.aspx?=321
Public Class clsResizeLabel
  Inherits System.Windows.Forms.Label

  Private cl_cmsLabel As New ContextMenuStrip

  Private WithEvents cl_Control As Control
  Private WithEvents cl_OwnerForm As Form
  Private cl_nGRS As Integer = 6
  Private cl_bInResizeMode As Boolean = False
  Private cl_bMoveControl As Boolean = False
  Private cl_pLastMousePos As Point
  Private cl_nMinWidth As Integer = 20
  Private cl_nMinHeigth As Integer = 20
  Private cl_bActive As Boolean = False

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

  Public Sub Deactivate()
    RemoveHandler cl_OwnerForm.Paint, AddressOf ControlPaint

    RemoveHandler cl_Control.MouseMove, AddressOf ControlMouseMove
    cl_Control.Cursor = Cursors.Default

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

      cl_cGrabRects(nCount).Visible = False
    Next

    cl_bActive = False
    cl_OwnerForm.Refresh()
  End Sub

  Sub New(ByVal frmOwnerForm As Form)
    cl_Control = Me
    cl_OwnerForm = frmOwnerForm
  End Sub

  Public Sub Activate()
    AddHandler cl_OwnerForm.Paint, AddressOf ControlPaint

    AddHandler cl_Control.MouseMove, AddressOf ControlMouseMove

    cl_Control.Cursor = Cursors.SizeAll

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

      cl_cGrabRects(nCount).Visible = True
    Next

    cl_bActive = True
    cl_OwnerForm.Refresh()
  End Sub

  Private Sub ControlMouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Me.MouseDown
    If e.Button = Windows.Forms.MouseButtons.Left Then
      cl_bMoveControl = True
      cl_pLastMousePos = New Point(e.X, e.Y)

      For nCount As Integer = 0 To cl_cGrabRects.Length - 1
        If cl_bActive = True Then cl_cGrabRects(nCount).Visible = False
      Next

      cl_OwnerForm.Refresh()
    ElseIf e.Button = Windows.Forms.MouseButtons.Right Then
      AddHandler cl_cmsLabel.Opening, AddressOf cmsLabel_Opening
      Me.ContextMenuStrip = cl_cmsLabel
    End If
  End Sub

  Private Sub ControlMouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) 'Handles Me.MouseMove
    If cl_bMoveControl = True Then
      cl_Control.Left = cl_Control.Left + e.X - cl_pLastMousePos.X
      cl_Control.Top = cl_Control.Top + e.Y - cl_pLastMousePos.Y
      cl_OwnerForm.Refresh()
    End If
  End Sub

  Private Sub ControlMouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) Handles Me.MouseUp
    cl_bMoveControl = False

    For nCount As Integer = 0 To cl_cGrabRects.Length - 1
      If cl_bActive = True Then cl_cGrabRects(nCount).Visible = True
    Next

    cl_OwnerForm.Refresh()
  End Sub

  Private Sub cmsLabel_Opening(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs)
    ' Rechtsklick PopupMenu
    cl_cmsLabel.Items.Clear()

    If cl_bActive = False Then
      cl_cmsLabel.Items.Add("Activate Control", Nothing, New System.EventHandler(AddressOf SelectedChildMenu_OnClick))
    Else
      cl_cmsLabel.Items.Add("Deactivate Control", Nothing, New System.EventHandler(AddressOf SelectedChildMenu_OnClick))
    End If

    RemoveHandler cl_cmsLabel.Opening, AddressOf cmsLabel_Opening

    e.Cancel = False
  End Sub

  Private Sub SelectedChildMenu_OnClick(ByVal sender As Object, ByVal e As System.EventArgs) ' DÜNSCH
    If sender.ToString = "Activate Control" Then
      Activate()
    ElseIf sender.ToString = "Deactivate Control" Then
      Deactivate()
    End If
  End Sub

  Public Sub ControlPaint(ByVal sender As Object, ByVal e As PaintEventArgs)
    If cl_bInResizeMode = True Or cl_bMoveControl = True Then Exit Sub
    With e.Graphics
      'Rahmen
      .DrawRectangle(Pens.Gray, New Rectangle( _
      cl_Control.Location.X - (cl_nGRS / 2), _
      cl_Control.Location.Y - (cl_nGRS / 2), _
      cl_Control.Width + cl_nGRS, _
      cl_Control.Height + cl_nGRS))

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

      For nCount As Integer = 0 To cl_cGrabRects.Length - 1
        cl_cGrabRects(nCount).Location = GrabRectPos(nCount)
        cl_cGrabRects(nCount).Size = New Size(cl_nGRS, cl_nGRS)
        cl_cGrabRects(nCount).BackColor = Color.LightGray
        cl_cGrabRects(nCount).Parent = cl_OwnerForm
      Next

    End With
  End Sub

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

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

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

  Private Sub GrabRectMouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)
    Dim cCurrControl As Control = CType(sender, Control)
    Dim nIndex As Integer = GetCurrIndex(sender)
    Dim MousePos As Point
    Static cnRight As Integer
    Static cnBottom As Integer

    Select Case nIndex
      Case 0 : cCurrControl.Cursor = Cursors.SizeNWSE
      Case 1 : cCurrControl.Cursor = Cursors.SizeNS
      Case 2 : cCurrControl.Cursor = Cursors.SizeNESW

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

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

    If cl_bInResizeMode = True Then
      MousePos = cl_OwnerForm.PointToClient(Windows.Forms.Cursor.Position)
      cCurrControl.Left = cl_OwnerForm.PointToClient(Windows.Forms.Cursor.Position).X 'cCurrControl.Left + e.X
      cCurrControl.Top = cl_OwnerForm.PointToClient(Windows.Forms.Cursor.Position).Y 'cCurrControl.Top + e.Y

      Dim nTmpHeigth As Integer
      Dim nTmpWidth As Integer
      Dim nTmpDelta As Integer

      Select Case nIndex
        Case 0 'TopLeft GrabButton
          nTmpDelta = cl_Control.Top - cCurrControl.Top
          nTmpHeigth = cl_Control.Height + nTmpDelta

          nTmpDelta = cl_Control.Left - cCurrControl.Left
          nTmpWidth = cl_Control.Width + nTmpDelta

          If nTmpHeigth < cl_nMinHeigth Then Exit Select
          If nTmpWidth < cl_nMinWidth Then Exit Select

          cl_Control.Size = New Size(nTmpWidth, nTmpHeigth)
          cl_Control.Top = cCurrControl.Top
          cl_Control.Left = cCurrControl.Left

        Case 1 'TopMiddle GrabButton
          nTmpDelta = cl_Control.Top - cCurrControl.Top
          nTmpHeigth = cl_Control.Height + nTmpDelta

          If nTmpHeigth < cl_nMinHeigth Then Exit Select

          cl_Control.Height = nTmpHeigth
          cl_Control.Top = cCurrControl.Top

        Case 2 'TopRight GrabButton
          nTmpDelta = cl_Control.Top - cCurrControl.Top
          nTmpHeigth = cl_Control.Height + nTmpDelta

          nTmpWidth = cCurrControl.Left - cl_Control.Left

          If nTmpHeigth < cl_nMinHeigth Then Exit Select
          If nTmpWidth < cl_nMinWidth Then nTmpWidth = cl_nMinWidth

          cl_Control.Size = New Size(nTmpWidth, nTmpHeigth)
          cl_Control.Top = cCurrControl.Top

        Case 3 'MiddleLeft GrabButton
          nTmpDelta = cl_Control.Left - cCurrControl.Left
          nTmpWidth = cl_Control.Width + nTmpDelta

          If nTmpWidth < cl_nMinWidth Then Exit Select

          cl_Control.Width = nTmpWidth
          cl_Control.Left = cCurrControl.Left

        Case 4 'MiddleRight GrabButton
          nTmpWidth = cl_cGrabRects(4).Left - cl_Control.Left

          If nTmpWidth < cl_nMinWidth Then nTmpWidth = cl_nMinWidth

          cl_Control.Width = nTmpWidth

        Case 5 'BottomLeft GrabButton
          nTmpHeigth = cCurrControl.Top - cl_Control.Top
          nTmpDelta = cl_Control.Left - cCurrControl.Left
          nTmpWidth = cl_Control.Width + nTmpDelta

          If nTmpHeigth < cl_nMinHeigth Then nTmpHeigth = cl_nMinHeigth
          If nTmpWidth < cl_nMinWidth Then Exit Select

          cl_Control.Size = New Size(nTmpWidth, nTmpHeigth)
          cl_Control.Left = cCurrControl.Left

        Case 6 'BottomMiddle GrabButton
          nTmpHeigth = cCurrControl.Top - cl_Control.Top

          If nTmpHeigth < cl_nMinHeigth Then nTmpHeigth = cl_nMinHeigth

          cl_Control.Height = nTmpHeigth

        Case 7 'BottomcnRight GrabButton
          nTmpHeigth = cCurrControl.Top - cl_Control.Top
          nTmpWidth = cCurrControl.Left - cl_Control.Left

          If nTmpHeigth < cl_nMinHeigth Then nTmpHeigth = cl_nMinHeigth
          If nTmpWidth < cl_nMinWidth Then nTmpWidth = cl_nMinWidth

          cl_Control.Size = New Size(nTmpWidth, nTmpHeigth)

      End Select
      cl_OwnerForm.Refresh()
    Else
      cnRight = cl_Control.Right
      cnBottom = cl_Control.Bottom
    End If
  End Sub

  Private Sub GrabRectMouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)
    cl_bInResizeMode = True
    For nCount As Integer = 0 To cl_cGrabRects.Length - 1
      cl_cGrabRects(nCount).Visible = False
    Next
    cl_OwnerForm.Refresh()
  End Sub

  Private Sub GrabRectMouseUp(ByVal sender As Object, ByVal e As MouseEventArgs)
    cl_bInResizeMode = False
    For nCount As Integer = 0 To cl_cGrabRects.Length - 1
      cl_cGrabRects(nCount).Visible = True
    Next
    cl_OwnerForm.Refresh()
  End Sub

  Private Function GetCurrIndex(ByVal sender As Object) As Integer
    Dim CurrControl As Control = CType(sender, Control)
    For nCount As Integer = 0 To cl_cGrabRects.Length
      If cl_cGrabRects(nCount) Is CurrControl Then
        Return nCount
      End If
    Next
  End Function

End Class
Abgelegt unter Control, Resize, Laufzeit, IDE.

Kommentare zum Snippet

 

Logge dich ein, um hier zu kommentieren!