TextBoxR

Public Class TextBoxR
  Inherits TextBox
#Windows form generated code
  ' ===========================================
  ' The TextBoxR Control inherited from TextBox
  ' Added features include:
  ' 1. Resizable and movable
  ' 2. alt-key activates resize mode
  ' 3. background color changes when in resize mode
  '                                    PC 2004-08-14
  ' details:
  ' Properties:
  ' Resizable (Boolean) : determine if the control is resizable
  ' ResizeColor (color) : BackColor during resize
  ' Operation:
  ' The (left) control key has to be pressed during resize
  ' -----------------------------------
  ' Revision history
  ' 2004-08-14  Initial version using the control-key
  ' ===========================================
  Dim bMouseDown As Boolean
  Dim bResizable As Boolean = False
  Dim _ResizeColor As Color = Color.Beige
  Dim StartX As Integer
  Dim StartY As Integer
  Property Resizable() As Boolean
    Get
      Resizable = bResizable
    End Get
    Set(ByVal Value As Boolean)
      bResizable = Value
    End Set
  End Property
  Property ResizeColor() As Color
    Get
      ResizeColor = _ResizeColor
    End Get
    Set(ByVal Value As Color)
      _ResizeColor = Value
    End Set
  End Property

  Private Function ResizeMode(ByVal e As System.Windows.Forms.MouseEventArgs) As Integer
    ' A border of 15 pixels from the window edge is used
    ' resizeMode=0 Undefined
    ' resizeMode=1 Diagonal resize bottom-right
    ' resizeMode=2 Diagonal resize Top-right
    ' resizeMode=3 Diagonal resize Bottom-left
    ' resizeMode=4 Diagonal resize top-left
    ' resizeMode=5 Horizontal resize middle-right
    ' resizeMode=6 Horizontal resize middle-left
    ' resizeMode=7 Vertical middle-top
    ' resizeMode=8 Vertical middle-bottom
    ' resizeMode=9 Move RichTextBox
    Dim w As Integer = Me.Width
    Dim h As Integer = Me.Height
    Dim x As Integer = e.X
    Dim y As Integer = e.Y
    Dim b As Integer = 15   ' border width
    Dim RMode As Integer = 0 'default = undefined
    If Not bResizable Then
      Return 0
    End If
    If x > w - b And y > h - b Then  ' Diagonal resize Bottom-right
      RMode = 1
      Me.Cursor = Cursors.SizeNWSE
    ElseIf x > w - b And y < b Then  ' Diagonal resize Top-right
      RMode = 2
      Me.Cursor = Cursors.SizeNESW
    ElseIf x < b And y > h - b Then  ' Diagonal resize Bottom-left
      RMode = 3
      Me.Cursor = Cursors.SizeNESW
    ElseIf x < b And y < b Then ' Diagonal resize Top-left
      RMode = 4
      Me.Cursor = Cursors.SizeNWSE
    ElseIf x > w - b And (y >= h / 2 - b And y <= h / 2 + b) Then
      ' Horizontal resize middle-right
      RMode = 5
      Me.Cursor = Cursors.VSplit
    ElseIf x < b And (y >= h / 2 - b And y <= h / 2 + b) Then
      ' Horizontal resize middle-left
      RMode = 6
      Me.Cursor = Cursors.VSplit
    ElseIf y < b And (x >= w / 2 - b And x <= w / 2 + b) Then
      ' Vertical resize middle-top
      RMode = 7
      Me.Cursor = Cursors.HSplit
    ElseIf y > h - b And (x >= w / 2 - b And x <= w / 2 + b) Then
      ' Vertical resize middle-top
      RMode = 8
      Me.Cursor = Cursors.HSplit
    Else
      RMode = 9
      Me.Cursor = Cursors.Cross
    End If
    Return RMode
  End Function
  Private Sub RichTextBoxR_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseDown
    bMouseDown = True
    Me.StartX = e.X
    Me.StartY = e.Y
  End Sub
  Private Sub RichTextBoxR_MouseMove(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseMove
    Dim RMode As Integer
    If bResizable And bMouseDown Then
      RMode = ResizeMode(e)
      If RMode = 0 Then
        ' do nothing
      ElseIf RMode = 1 Then ' Bottom-right
        Me.Width = e.X
        Me.Height = e.Y
      ElseIf RMode = 2 Then ' Top-right
        Me.Width = e.X
        Me.Top = Me.Top + e.Y - Me.StartY
        Me.Height = Me.Height - e.Y + Me.StartY
      ElseIf RMode = 3 Then ' Bottom-Left
        Me.Height = e.Y
        Me.Left = Me.Left + e.X - Me.StartX
        Me.Width = Me.Width - e.X + Me.StartX
      ElseIf RMode = 4 Then ' Top-Left
        Me.Top = Me.Top + e.Y - Me.StartY
        Me.Height = Me.Height - e.Y + Me.StartY
        Me.Left = Me.Left + e.X - Me.StartX
        Me.Width = Me.Width - e.X + Me.StartX
      ElseIf RMode = 5 Then 'Middle-right
        Me.Width = e.X
      ElseIf RMode = 6 Then 'Middle-left
        Me.Left = Me.Left + e.X - Me.StartX
        Me.Width = Me.Width - e.X + Me.StartX
      ElseIf RMode = 7 Then 'middle-Top
        Me.Top = Me.Top + e.Y - Me.StartY
        Me.Height = Me.Height - e.Y + Me.StartY
      ElseIf RMode = 8 Then 'middle-bottom
        Me.Height = e.Y
      Else  ' translation
        Dim dx As Integer = e.X - Me.StartX
        Dim dy As Integer = e.Y - Me.StartY
        Me.Left = Me.Left + dx
        Me.Top = Me.Top + dy
      End If
    ElseIf bResizable Then
      RMode = ResizeMode(e) ' just to update the cursor
    End If
  End Sub

  Private Sub RichTextBoxR_MouseUp(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles MyBase.MouseUp
    bMouseDown = False
    Me.Cursor = sender.Cursor
  End Sub

  Private Sub RichTextBoxR_KeyDown(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyDown
    If e.KeyCode = Keys.Menu Then
      Me.bResizable = True
      Me.BackColor = ResizeColor
    End If
  End Sub

  Private Sub RichTextBoxR_KeyUp(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyEventArgs) Handles MyBase.KeyUp
    If e.KeyCode = Keys.Menu Then
      Me.bResizable = False
      Me.BackColor = Color.White
      Me.Cursor = Cursors.IBeam
    End If
  End Sub
End Class