RichTextBox Control

Multiple undo/redo

The RichTextBox actually supports multiple undo and redo. However, this functionality is hidden from VB programmers. In order to be able to use the undo and redo facilities, you need to add the following code.

Add this code to the Form_Load() event of the form that contains the RichTextBox control. We are calling the RichTextBox rtfText

Dim lStyle As Long
'// required to 'reveal' multiple undo
'// set rich text box style
lStyle = TM_RICHTEXT Or TM_MULTILEVELUNDO Or TM_MULTICODEPAGE
SendMessageLong rtfText.hwnd, EM_SETTEXTMODE, lStyle, 0

Then, add the code below. This code also adds cut/copy/paste/clear functionality, and expects the following menu items:

Menu Name Caption
mnuEdit &Edit
mnuEditUndo &Undo
mnuEditRedo &Redo
mnuEditCut Cu&t
mnuEditCopy &Copy
mnuEditPaste &Paste
mnuEditClear C&lear

Call the UpdateItems procedure in the mnuEdit_Click() event. This procedure updates the menu items. 

Public Property Get UndoType() As ERECUndoTypeConstants
    UndoType = SendMessageLong(rtfText.hWnd, EM_GETUNDONAME, 0, 0)
End Property
Public Property Get RedoType() As ERECUndoTypeConstants
    RedoType = SendMessageLong(rtfText.hWnd, EM_GETREDONAME, 0, 0)
End Property
Public Property Get CanPaste() As Boolean
   CanPaste = SendMessageLong(rtfText.hWnd, EM_CANPASTE, 0, 0)
End Property
Public Property Get CanCopy() As Boolean
   If rtfText.SelLength > 0 Then
      CanCopy = True
   End If
End Property
Public Property Get CanUndo() As Boolean
    CanUndo = SendMessageLong(rtfText.hWnd, EM_CANUNDO, 0, 0)
End Property
Public Property Get CanRedo() As Boolean
    CanRedo = SendMessageLong(rtfText.hWnd, EM_CANREDO, 0, 0)
End Property

'///////////////////////////////////////////////////////
'// Methods
Public Sub Undo()
    SendMessageLong rtfText.hWnd, EM_UNDO, 0, 0
End Sub
Public Sub Redo()
    SendMessageLong rtfText.hWnd, EM_REDO, 0, 0
End Sub
Public Sub Cut()
   SendMessageLong rtfText.hWnd, WM_CUT, 0, 0
End Sub
Public Sub Copy()
   SendMessageLong rtfText.hWnd, WM_COPY, 0, 0
End Sub
Public Sub Paste()
   SendMessageLong rtfText.hWnd, WM_PASTE, 0, 0
End Sub
Public Sub Clear()
   rtfText.SelText = Empty
End Sub
Public Sub UpdateItems()
    Dim bCanUndo As Boolean
    '// Undo/Redo options:
    bCanUndo = CanUndo
    mnuEditUndo.Enabled = bCanUndo
    '// Set Undo Text
    If (bCanUndo) Then
        mnuEditUndo.Caption = "&Undo " & TranslateUndoType(UndoType)
    Else
        mnuEditUndo.Caption = "&Undo"
    End If
    '// Set Redo Text
    bCanUndo = CanRedo
    If (bCanUndo) Then
        mnuEditRedo.Caption = "&Redo " & TranslateUndoType(RedoType)
    Else
        mnuEditRedo.Caption = "&Redo"
    End If
    mnuEditRedo.Enabled = bCanUndo
    tbToolBar.Buttons("Redo").Enabled = bCanUndo
    '// Cut/Copy/Paste/Clear options
    mnuEditCut.Enabled = CanCopy
    mnuEditCopy.Enabled = CanCopy
    mnuEditPaste.Enabled = CanPaste
    mnuEditClear.Enabled = CanCopy
End Sub
'// Returns the undo/redo type
Private Function TranslateUndoType(ByVal eType As ERECUndoTypeConstants) As String
   Select Case eType
   Case ercUID_UNKNOWN
      TranslateUndoType = "Last Action"
   Case ercUID_TYPING
      TranslateUndoType = "Typing"
   Case ercUID_PASTE
      TranslateUndoType = "Paste"
   Case ercUID_DRAGDROP
      TranslateUndoType = "Drag Drop"
   Case ercUID_DELETE
      TranslateUndoType = "Delete"
   Case ercUID_CUT
      TranslateUndoType = "Cut"
   End Select
End Function

Then, add this code to a module

'// View Types
Public Enum ERECViewModes
    ercDefault = 0
    ercWordWrap = 1
    ercWYSIWYG = 2
End Enum
'// Undo Types
Public Enum ERECUndoTypeConstants
    ercUID_UNKNOWN = 0
    ercUID_TYPING = 1
    ercUID_DELETE = 2
    ercUID_DRAGDROP = 3
    ercUID_CUT = 4
    ercUID_PASTE = 5
End Enum
'// Text Modes
Public Enum TextMode
    TM_PLAINTEXT = 1
    TM_RICHTEXT = 2 ' /* default behavior */
    TM_SINGLELEVELUNDO = 4
    TM_MULTILEVELUNDO = 8 ' /* default behavior */
    TM_SINGLECODEPAGE = 16
    TM_MULTICODEPAGE = 32 ' /* default behavior */
End Enum

Public Const WM_COPY = &H301
Public Const WM_CUT = &H300
Public Const WM_PASTE = &H302

Public Const WM_USER = &H400
Public Const EM_SETTEXTMODE = (WM_USER + 89)
Public Const EM_UNDO = &HC7
Public Const EM_REDO = (WM_USER + 84)
Public Const EM_CANPASTE = (WM_USER + 50)
Public Const EM_CANUNDO = &HC6&
Public Const EM_CANREDO = (WM_USER + 85)
Public Const EM_GETUNDONAME = (WM_USER + 86)
Public Const EM_GETREDONAME = (WM_USER + 87)

Public Declare Function SendMessageLong Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long

And that's it! What you thought is impossible, is actually possible in a few lines of code. Of course, it would have been much easier if Microsoft had provided these functions for VB programmers anyway. This code has been adapted from VB Accelerator's RichEdit control.

You might also like...

Comments

About the author

James Crowley

James Crowley United Kingdom

James first started this website when learning Visual Basic back in 1999 whilst studying his GCSEs. The site grew steadily over the years while being run as a hobby - to a regular monthly audien...

Interested in writing for us? Find out more.

Contribute

Why not write for us? Or you could submit an event or a user group in your area. Alternatively just tell us what you think!

Our tools

We've got automatic conversion tools to convert C# to VB.NET, VB.NET to C#. Also you can compress javascript and compress css and generate sql connection strings.

“I invented the term Object-Oriented, and I can tell you I did not have C++ in mind.” - Alan Kay