Unlimited Undo/Redo

I need an unlimited undo/redo code for my app...
i've found a code for RichTextBoxes but it didnt support
pictureboxes so i relly need som help with this! ;)

This should work...

VB Code:

' #VBIDEUtils#************************************************************
' * Programmer Name  : Steve McMahon
' * Web Site         : [url]http://www.vbaccelerator.com/[/url]
' * E-Mail           : [email][email protected][/email]
' * Date             : 20/12/1999
' * Time             : 10:17
' **********************************************************************
' * Comments         : Adding 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 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

thanks :) ill try that...

When i try to use this code i get a
Constant Expression Required Error Message with
WM_USER

can anyone help?:confused:

thanks ;)

im guessing it isnt declared in that code

Public Const WM_USER = &H400

If you can get that code to work please let me know since I never could.

hey martin buddy the code works now that that is declared.

and thanks alot ice i apreciate your help :):) :)

Quote:

---

Originally posted by brainprogrammer
hey martin buddy the code works now that that is declared.

and thanks alot ice i apreciate your help :):) :)

---

With VB6? If so I'd really appreciate it if you could attach a small demo app.

* bump *

with this code there are several things that are not defined.. you have to google the constants to get the values

anyway, i setup a demo project, and the identification of the kind of undo works ie Undo Typing, BUT it still behaves the same. that is, it acts just as if there was only 1 level of undo. pressing undo just toggles back and forth between the last action being there or not.

if someone could get this working that would be great :thumb:

I found this, but haven't tried it, yet.

Quote:

---

Originally Posted by dglienna

I found this, but haven't tried it, yet.

---

Did you forget an attachment? (Please don't bother attaching it if it doesn't work).

Oops. I hunted for quite a while, too. No idea. I'll see if i can find it in my history. It says this guy started the site. Still haven't tried it, but over 10K persons downloaded it.


http://www.developerfusion.co.uk/show/358/

I will try it, though. It does work with images, as well a text. A worthy addition to my code library.

I have attached the demo I was using, just so people don't keep having to create it from the code above.

The reason why this code doesn't work, and only seems to give you a single level undo, is because it's text mode is set to that.
In form load the code is:

Code:

---

Private Sub Form_Load()
Dim lStyle As Long
    lStyle = TM_RICHTEXT Or TM_MULTILEVELUNDO Or TM_MULTICODEPAGE
    SendMessageLong rtfText.hwnd, EM_SETTEXTMODE, lStyle, 0
End Sub

---

This should set the mode to multi level undo.
But what actually happens is that it doesn't get set.
I changed the above code to:

Code:

---

Private Sub Form_Load()
Dim lStyle As Long
    lStyle = TM_RICHTEXT Or TM_MULTILEVELUNDO Or TM_MULTICODEPAGE
    MsgBox "Style to be set: " & lStyle
    SendMessageLong rtfText.hwnd, EM_SETTEXTMODE, lStyle, 0
    MsgBox "Style after change: " & SendMessage(rtfText.hwnd, EM_GETTEXTMODE, 0&, 0&)
End Sub

---

and added the following to the module:

Code:

---

public Const EM_GETTEXTMODE = (WM_USER + 90)

---

What we actually see is that lStyle = 42, which is what we want. However, when we read back the style it's only got a value of 38 :(
This means it's style is:

Code:

---

lStyle = TM_RICHTEXT Or TM_SINGLELEVELUNDO Or TM_MULTICODEPAGE

---

So, I can think of only 2 reasons why this doesn't work. The SendMessageLong command is wrong (I have tried to use SendMessage but that fails too), or it doesn't actually support this...:confused:

Maybe we can solve this now we know whats up.

Woof

Mine doesn't have any advanced features, but it does do undo and redo for unlimited numbers, which can be set automatically. Default is 100. :wave:

the only problem with keeping track yourself is that the RTB is a little smarter about it.

when the RTB is in control if you type 'animal' and undo, 'animal' is undone.

but in the other example, l is undone, then a, then m, then i, then n, then a

Quote:

---

Originally Posted by dglienna

Mine doesn't have any advanced features, but it does do undo and redo for unlimited numbers, which can be set automatically. Default is 100. :wave:

---

And...eeeerrr...are you going to post the code?

Woof

I didn't write it, just found it, tested, and posted the link to it (above)
I agree that it could be improved, but in actuality, you are deleting one letter at at time, so it's right. I didn't paste but it un-did pasting, and then deleting a picture.

Sorry to bump an old thread, but I am having trouble with this exact problem at the moment.

Does anyone have any idea how to solve the problem that Woka mentioned in post #13, because that is the same problem I encountered yesterday.

The EM_SETTEXTMODE message is only supported in RichEdit 2.0 and above, however the VB RichTextBox is based on RichEdit 1.0. VBAccelerator used to have a RichTextBox control that was created purely from API which supported this. It is still available but only as part of some of the downloadable tools.

That makes sense. I ran across the RichEdit control from vbAccelerator, but whenever I try to run it I get different errors. I think I have all the type libraries and such registered that I need to. I will start a new thread about it when I get home.