Recent

Author Topic: Undo/Redo function of TMemo (support undo by word, support drag)  (Read 1837 times)

tomitomy

  • Sr. Member
  • ****
  • Posts: 251
I found there are people still need TMemo's Undo/Redo function, and Handoko messaged me, he wants to undo by word, not by character. So I rewrote UndoRedoDemo to implement undo by word and simplify the code.

The code test environment: Arch Linux, Lazarus 2.0.12, GTK 2

Since I don't use windows, this code has not been tested in windows. I don't think it will work properly in windows.

I give this code to the public domain, so everyone can use it, just like using your own code.

If there is no problem with this code, I will delete my previous post about Undo/Redo because the code posted before is imperfect and difficult to read.



Here I record my ideas, so that you can understand the code.

To record TMemo history data, it is necessary to operate in the OnChange event of TMemo, so we need to know the features of OnChange event. After some tests, I found the following features (arch Linux, Lazarus 2.0.12, GTK 2):

1. When typing, SelLength is 0, and SelStart is after the newly added content.
2. When deleting, SelLength is 0 and SelStart is before the deleted content.
3. If you select the text and then type, the selected content will be deleted first, and then new content will be added.

4. When dragging content inside TMemo, the selected content will be copied to the target location first (SelLength is the length of the selected content), and then the previously selected content will be deleted (SelLength is 0). The location of SelStart is the same as the following situation.

5. When you drag content from outside to TMemo, SelLength is 0. SelStart can be divided into two cases:

  A. If you drag backward (drag to a position after the last typing position), SelStart will still stay in the position before the drag operation

  B. If you drag forward (drag to a position before the last typing position, or just drag to the last typing position), SelStart remains in the position before the drag operation occurs, except that SelStart will be moved backwards because of the content inserted before (offset is the length of the selected content), which is similar to the normal type (or paste) operation, which is difficult to distinguish. At present, I can't distinguish them, so I must use the same inefficient algorithm to handle the common typing operation.

First of all, I captured the normal typing and deleting operations in the OnChange event, and did not consider the drag and drop operation for the time being.

In order to distinguish between typing and deleting operations, I need to compare the contents of TMemo before and after the OnChange event. If the length of the content before OnChange is less than that after the OnChange, it is typed, otherwise it is deleted.

The following code demonstrates this process (test results will be output to the terminal):
Code: Pascal  [Select][+][-]
  1. unit uHistory;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, StdCtrls, lazUTF8;
  9.  
  10. type
  11.  
  12.   { THistory }
  13.  
  14.   THistory = class
  15.     FMemo        : TMemo;
  16.     FOldOnChange : TNotifyEvent;
  17.     FPrevContent : String;
  18.  
  19.     constructor Create(Memo: TMemo);
  20.     destructor  Destroy; override;
  21.  
  22.     procedure MemoOnChange(Sender: TObject);
  23.   end;
  24.  
  25.  
  26. implementation
  27.  
  28.  
  29. constructor THistory.Create(Memo: TMemo);
  30. begin
  31.   FMemo          := Memo;
  32.  
  33.   FOldOnChange   := FMemo.OnChange;
  34.   FMemo.OnChange := @MemoOnChange;
  35.  
  36.   FPrevContent   := FMemo.Text;
  37. end;
  38.  
  39.  
  40. destructor THistory.Destroy;
  41. begin
  42.   FMemo.OnChange := FOldOnChange;
  43.  
  44.   inherited Destroy;
  45. end;
  46.  
  47.  
  48. procedure THistory.MemoOnChange(Sender: TObject);
  49. var
  50.   Content: String;
  51.   Len, SelStart: SizeInt;
  52.  
  53. begin
  54.   Content := FMemo.Text;
  55.   Len := UTF8Length(Content) - UTF8Length(FPrevContent);
  56.   SelStart := FMemo.SelStart;
  57.  
  58.   if Len > 0 then begin
  59.     SelStart := SelStart - Len;
  60.  
  61.     Write('On Add: ', SelStart, ' ', Len, ' ');
  62.     WriteLn(UTF8Copy(Content, SelStart + 1, Len));
  63.   end
  64.  
  65.   else if Len < 0 then begin
  66.     Write('On Del: ', SelStart, ' ', -Len, ' ');
  67.     WriteLn(UTF8Copy(FPrevContent, SelStart + 1, - Len));
  68.   end
  69.  
  70.   else
  71.     Exit;
  72.  
  73.   FPrevContent := Content;
  74.  
  75.   if Assigned(FOldOnChange) then
  76.     FOldOnChange(Sender);
  77. end;
  78.  
  79. end.

The usage is as follows (you need to activate the OnCreate and OnDestroy events of TForm1):
Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, uHistory;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Memo1: TMemo;
  16.     procedure FormCreate(Sender: TObject);
  17.     procedure FormDestroy(Sender: TObject);
  18.   private
  19.     FHistory: THistory;
  20.   public
  21.  
  22.   end;
  23.  
  24. var
  25.   Form1: TForm1;
  26.  
  27. implementation
  28.  
  29. {$R *.lfm}
  30.  
  31. { TForm1 }
  32.  
  33. procedure TForm1.FormCreate(Sender: TObject);
  34. begin
  35.   Memo1.Text := '01234567890123456789';
  36.   FHistory := THistory.Create(Memo1);
  37. end;
  38.      
  39. procedure TForm1.FormDestroy(Sender: TObject);
  40. begin
  41.   FHistory.Free;
  42. end;
  43.  
  44. end.

Next, I need to identify the drag operation.

For the drag inside TMemo, since its SelLength is not 0, it is easy to identify.

However, there is no good way to identify the operation dragged into TMemo from the outside of TMemo, which can not be distinguished from ordinary typing operations, and only a part of it can be recognized (5.A).

For ordinary typing operation, SelStart is different before and after typing, but drag operation (5.A) is the same, which can be distinguished.

To get the SelStart before typing, I can use the Application.OnIdle Event.

The demo code is as follows (The drag content is not parsed, so it is not accurately, but the drag operation can be recognized):

Code: Pascal  [Select][+][-]
  1. unit uHistory;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, StdCtrls, Forms, lazUTF8;
  9.  
  10. type
  11.  
  12.   { THistory }
  13.  
  14.   THistory = class
  15.     FMemo        : TMemo;
  16.     FOldOnChange : TNotifyEvent;
  17.     FPrevContent : String;
  18.  
  19.     FOldApplicationIdle : TIdleEvent;
  20.     FPrevSelStart       : SizeInt;
  21.  
  22.     constructor Create(Memo: TMemo);
  23.     destructor  Destroy; override;
  24.  
  25.     procedure MemoOnChange(Sender: TObject);
  26.     procedure ApplicationIdle(Sender: TObject; var Done: Boolean);
  27.   end;
  28.  
  29.  
  30. implementation
  31.  
  32.  
  33. constructor THistory.Create(Memo: TMemo);
  34. begin
  35.   FMemo          := Memo;
  36.  
  37.   FOldOnChange   := FMemo.OnChange;
  38.   FMemo.OnChange := @MemoOnChange;
  39.  
  40.   FOldApplicationIdle := Application.OnIdle;
  41.   Application.OnIdle  := @ApplicationIdle;
  42.  
  43.   FPrevContent   := FMemo.Text;
  44.   FPrevSelStart  := FMemo.SelStart;
  45. end;
  46.  
  47.  
  48. destructor THistory.Destroy;
  49. begin
  50.   FMemo.OnChange := FOldOnChange;
  51.  
  52.   Application.OnIdle := FOldApplicationIdle;
  53.  
  54.   inherited Destroy;
  55. end;
  56.  
  57.  
  58. procedure THistory.MemoOnChange(Sender: TObject);
  59. var
  60.   Content: String;
  61.   Len, SelStart: SizeInt;
  62.  
  63. begin
  64.   Content := FMemo.Text;
  65.   Len := UTF8Length(Content) - UTF8Length(FPrevContent);
  66.  
  67.   if Len > 0 then begin
  68.     SelStart := FMemo.SelStart;
  69.     if FMemo.SelLength > 0 then
  70.       WriteLn('Drag from inside TMemo')
  71.     else if SelStart = FPrevSelStart then
  72.       WriteLn('Drag from outside TMemo and drop after Last Typing Position')
  73.     else begin
  74.       WriteLn('Typing or "Drag from outside TMemo and drop before Last Typing Position');
  75.       SelStart := SelStart - Len;
  76.     end;
  77.  
  78.     Write('On Add: ', SelStart, ' ', Len, ' ');
  79.     WriteLn(UTF8Copy(Content, SelStart + 1, Len));
  80.   end
  81.  
  82.   else if Len < 0 then begin
  83.     Write('On Del: ', FMemo.SelStart, ' ', -Len, ' ');
  84.     WriteLn(UTF8Copy(FPrevContent, FMemo.SelStart + 1, - Len));
  85.   end
  86.  
  87.   else
  88.     Exit;
  89.  
  90.   FPrevContent := Content;
  91.  
  92.   if Assigned(FOldOnChange) then
  93.     FOldOnChange(Sender);
  94. end;
  95.  
  96.  
  97. procedure THistory.ApplicationIdle(Sender: TObject; var Done: Boolean);
  98. begin
  99.   FPrevSelStart := FMemo.SelStart;
  100.  
  101.   if Assigned(FOldApplicationIdle) then
  102.     FOldApplicationIdle(Sender, Done);
  103. end;
  104.  
  105. end.

After all the different operations are distinguished, the historical data can be recorded.

For drag and drop operations, I must compare the full text to correctly obtain the changed data, and the drag and drop operations cannot be distinguished from ordinary typing operations, and drag operations cannot be disabled, so ordinary typing operations must also be analyzed by full text comparison.

Please refer to the code for specific implementation and usage(in the attachment).

« Last Edit: April 10, 2021, 12:16:51 pm by tomitomy »

lucamar

  • Hero Member
  • *****
  • Posts: 4219
Re: Undo/Redo function of TMemo (support undo by word, support drag)
« Reply #1 on: April 10, 2021, 12:48:41 pm »
I found there are people still need TMemo's Undo/Redo function, and Handoko messaged me, he wants to undo by word, not by character. So I rewrote UndoRedoDemo to implement undo by word and simplify the code.

I was just thinking on implementing it, so many thanks for saving me the effort :D

Quote
Since I don't use windows, this code has not been tested in windows. I don't think it will work properly in windows.

And IIRC it's not needed there since the widgetset supports it.

Quote
If there is no problem with this code, I will delete my previous post about Undo/Redo because the code posted before is imperfect and difficult to read.

No, please, don't do that. Let's keep it for history's sake, if nothing else. If anything, edit it to add a link to this thread.
Turbo Pascal 3 CP/M - Amstrad PCW 8256 (512 KB !!!) :P
Lazarus/FPC 2.0.8/3.0.4 & 2.0.12/3.2.0 - 32/64 bits on:
(K|L|X)Ubuntu 12..18, Windows XP, 7, 10 and various DOSes.

Handoko

  • Hero Member
  • *****
  • Posts: 5131
  • My goal: build my own game engine using Lazarus
Re: Undo/Redo function of TMemo (support undo by word, support drag)
« Reply #2 on: April 10, 2021, 06:58:46 pm »
Thank you, tomitomy.
I now can use it in my projects.

tomitomy

  • Sr. Member
  • ****
  • Posts: 251
Re: Undo/Redo function of TMemo (support undo by word, support drag)
« Reply #3 on: April 11, 2021, 05:13:13 am »
I was just thinking on implementing it, so many thanks for saving me the effort :D

I'm glad the code is useful. :)

And IIRC it's not needed there since the widgetset supports it.

Thank you tell me that.

No, please, don't do that. Let's keep it for history's sake, if nothing else. If anything, edit it to add a link to this thread.

Ok, I will keep my previous post and add link to this thread.

tomitomy

  • Sr. Member
  • ****
  • Posts: 251
Re: Undo/Redo function of TMemo (support undo by word, support drag)
« Reply #4 on: April 11, 2021, 05:15:09 am »
Thank you, tomitomy.
I now can use it in my projects.

You are welcome, I'm glad the code helped. :)

mgc

  • New Member
  • *
  • Posts: 12
Re: Undo/Redo function of TMemo (support undo by word, support drag)
« Reply #5 on: April 14, 2022, 02:01:21 am »
It works on Windows 10 as a charm.

Phoenix

  • Jr. Member
  • **
  • Posts: 87
Re: Undo/Redo function of TMemo (support undo by word, support drag)
« Reply #6 on: September 02, 2023, 08:51:47 pm »
I was doing a search and luckily I found this post: thanks tomitomy  :D

I wanted to report the presence of a memory leak and the solution
Code: Pascal  [Select][+][-]
  1. destructor THistory.Destroy;
  2. begin
  3.   FMemo.OnChange     := FOldOnChange;
  4.   Application.OnIdle := FOldApplicationIdle;
  5.  
  6.   //#
  7.   Reset;
  8.   FSteps.Free;
  9.  
  10.   inherited Destroy;
  11. end;
  12.  
« Last Edit: September 02, 2023, 09:04:11 pm by Phoenix »

Phoenix

  • Jr. Member
  • **
  • Posts: 87
Re: Undo/Redo function of TMemo (support undo by word, support drag)
« Reply #7 on: March 07, 2024, 11:37:53 am »
Since I don't use windows, this code has not been tested in windows. I don't think it will work properly in windows.

There is a problem with the demo using with:
Windows 10; FPC 3.2.2; Laz 3.2 64bit.
To reproduce the problem just start the demo and add "1" after the first "Z" and after the second "Z" put "2". Then I press "CTRL-Z" instead of removing "2" and then "1" removes only "1". At the moment I don't have the possibility to try with Linux. So I'm not sure if it depends on Windows..

Phoenix

  • Jr. Member
  • **
  • Posts: 87
Re: Undo/Redo function of TMemo (support undo by word, support drag)
« Reply #8 on: March 07, 2024, 11:46:17 am »
I don't remember what I used for the test the first time. But when I tried it it seems strange that I didn't notice this problem  :-\.

It works on Windows 10 as a charm.

I don't know which version of Lazarus you tested with, but does everything still work correctly?


 

TinyPortal © 2005-2018