Members

Technology Zones

IBM Learning Center

Articles

Hosted By

MaximumASP

Info

Rated
Read 137,854 times

Contents

Related Categories

RichTextBox Control - Multiple undo/redo

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.

James first started writing tutorials on Visual Basic in 1999 whilst starting this website (then known as VB Web). Since then, the site has grown rapidly, and James has written numerous tutorials, articles and reviews on VB, PHP, ASP and C#. In October 2003, James formed the company Developer Fusion Ltd, which owns this website, and also offers various development services. In his spare time, he's a 3rd year undergraduate studying Computer Science in the UK. He's also a Visual Basic MVP.

Comments

  • Re: Read Only Property

    Posted by mmarksbury on 24 Apr 2008

    This is long past the topic post date but...

     I used the selection method (where you select text and then update it), for formatting the output of an application's process in a RTF. ...

  • Re: Read Only Property

    Posted by magiel on 06 Jan 2007

    I am had the same proplems;


    RichTextBox1.SelectionFont.Bold
    RichTextBox1.SelectionFont.Underline etc are readonly


    Solved them the following way


    ...

  • Re: Pre-formatted text/Cursor position

    Posted by Verdi on 21 Sep 2006

    Kylua, your efforts were not wasted...


    You have probably saved me a week's worth of head-pounding. Why it is so difficult to programmatically modify RTF using this control is beyond me. All...

  • Re: Pre-formatted text/Cursor position

    Posted by Kylua on 31 Jul 2006

    I spent AGES working thru this one and couldn't find it anywhere!


    The basic problem is that you have to update the richtextbox.rtf, not .text.


    And it is very fussy about goes in the...

  • can't get EM_SETTEXTMODE to respond

    Posted by vb_lover on 06 Dec 2005

    James Crowley:

    I am using vb6sp6(EM_SETTEXTMODE didn't work with vb6sp4 either) RTB control, I have already implemented URL detection similar to yours. However now i am trying to get MULTI-LEVEL U...