A simpler undo / redo class for TMemo

[fedkad]

I tried to use tomitomy's class: https://forum.lazarus.freepascal.org/index.php/topic,38714.0.html; but I had some difficulties with that. And being a guy who likes to use his own code in his projects, I tried to develop a simpler Undo / Redo class for TMemo. I think it can be adapted for other controls too. And it works well in Windows and Linux (beware of the bug https://bugs.freepascal.org/view.php?id=32669).

I am sharing it in the attached ZIP file. Any comments are welcome. And of course, if you find it useful you can use it in your own projects.

[fedkad]

A quick question related to this:

As you know, Windows has a default context (popup) menu for a memo as indicated in the image below.

Is it possible to override or define the code executed when a menu item is selected from this default pop menu (such as "Undo")?

I do NOT want to define a new pop menu since the default one is good enough, except its Undo function.

[ASerge]

Is it possible to override or define the code executed when a menu item is selected from this default pop menu (such as "Undo")?

Code: Pascal  [Select]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, StdCtrls, Types;
9.  
10. type
11.   TForm1 = class(TForm)
12.     Edit1: TEdit;
13.     procedure Edit1DblClick(Sender: TObject);
14.   private
15.     function PopupBuiltInMenu(CanUndo, HasSelText, HasText: Boolean): DWORD;
16.   end;
17.  
18. var
19.   Form1: TForm1;
20.  
21. implementation
22.  
23. uses Windows, ClipBrd;
24.  
25. {$R *.lfm}
26.  
27. function TForm1.PopupBuiltInMenu(CanUndo, HasSelText, HasText: Boolean): DWORD;
28. const
29.   CEnable: array [Boolean] of DWORD = (MF_DISABLED or MF_GRAYED, MF_ENABLED);
30.   CFlags = TPM_LEFTALIGN or TPM_RIGHTBUTTON or TPM_NONOTIFY or TPM_RETURNCMD;
31. var
32.   HUser32: HMODULE;
33.   LMenu, LPopupMenu: HMENU;
34. begin
35.   HUser32 := LoadLibraryEx(user32, 0, LOAD_LIBRARY_AS_DATAFILE);
36.   if HUser32 <> 0 then
37.   try
38.     LMenu := LoadMenu(HUser32, MAKEINTRESOURCE(1));
39.     if LMenu <> 0 then
40.     try
41.       LPopupMenu := GetSubMenu(LMenu, 0);
42.       EnableMenuItem(LPopupMenu, WM_UNDO, CEnable[CanUndo]);
43.       EnableMenuItem(LPopupMenu, WM_CUT, CEnable[HasSelText]);
44.       EnableMenuItem(LPopupMenu, WM_COPY, CEnable[HasSelText]);
45.       EnableMenuItem(LPopupMenu, WM_PASTE, CEnable[Clipboard.HasFormat(CF_TEXT)]);
46.       EnableMenuItem(LPopupMenu, WM_CLEAR, CEnable[HasSelText]);
47.       EnableMenuItem(LPopupMenu, EM_SETSEL, CEnable[HasText]);
48.       BOOL(Result) := TrackPopupMenu(LPopupMenu, CFlags, Mouse.CursorPos.x, Mouse.CursorPos.y, 0, Handle, nil);
49.     finally
50.       DestroyMenu(LMenu);
51.     end;
52.   finally
53.     FreeLibrary(HUser32);
54.   end;
55. end;
56.  
57. procedure TForm1.Edit1DblClick(Sender: TObject);
58. begin
59.   case PopupBuiltInMenu(Edit1.CanUndo, Edit1.SelLength > 0, Edit1.GetTextLen > 0) of
60.     WM_UNDO:
61.       Caption := 'Undo';
62.     EM_SETSEL:
63.       Caption := 'Select all';
64.   end;
65. end;
66.  
67. end.

[fedkad]

It seems a bit complicated and system dependent; but thank you very much ASerge.

[tomitomy]

I tried to use tomitomy's class: https://forum.lazarus.freepascal.org/index.php/topic,38714.0.html; but I had some difficulties with that. And being a guy who likes to use his own code in his projects, I tried to develop a simpler Undo / Redo class for TMemo. I think it can be adapted for other controls too. And it works well in Windows and Linux (beware of the bug https://bugs.freepascal.org/view.php?id=32669).

I am sharing it in the attached ZIP file. Any comments are welcome. And of course, if you find it useful you can use it in your own projects.

Thank you for sharing, I read your code, it works well, but it consumes CPU resources very much. It will make a full content compare when you type every character into Memo, which is very bad for editing large text.

I wrote another Undo/Redo class with reference to your code. It doesn't do any contrastive operation, and it is very fast, but it can't support drag and drop operation. I hope someone can solve the drag and drop problem.

The Demo is in the attachment, I tested in lazarus 1.8.2 on Ubuntu 16.04.

uhistory.pas:

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.   PStep = ^TStep;
13.  
14.   TStep = record          
15.     BytePos : SizeInt;
16.     InsStr  : string;
17.     DelStr  : string;
18.   end;
19.  
20.   { THistory }
21.  
22.   THistory = class
23.   private
24.     FMemo        : TMemo;
25.     FSteps       : TList;         // History Records
26.     FIndex       : Integer;       // Based 0
27.     FOldOnChange : TNotifyEvent;
28.     FInEdit      : Boolean;
29.     FPrevContent : string;
30.  
31.     function    GetStep(AIndex: Integer): PStep;  
32.     function    CurStep: PStep;
33.  
34.     procedure   AddStep(ABytePos: SizeInt; AInsStr, ADelStr: string);
35.     procedure   DelStep(Index: Integer);
36.  
37.     procedure   MemoOnChange(Sender: TObject);
38.  
39.     function    StrDiff(out BytePos: SizeInt; out InsStr, DelStr: string): Boolean;
40.   public
41.     constructor Create(AMemo: TMemo);
42.     destructor  Destroy; override;
43.  
44.     function    CanUndo: Boolean;
45.     function    CanRedo: Boolean;
46.     procedure   Undo;
47.     procedure   Redo;
48.   end;
49.  
50. implementation
51.  
52. { THistory }
53.  
54. function THistory.GetStep(AIndex: Integer): PStep;
55. begin
56.   Result := PStep(FSteps[AIndex]);
57. end;
58.  
59. function THistory.CurStep: PStep;
60. begin
61.   Result := GetStep(FIndex);
62. end;
63.      
64. procedure THistory.AddStep(ABytePos: SizeInt; AInsStr, ADelStr: string);
65. begin
66.   DelStep(FIndex + 1);
67.  
68.   FSteps.Add(new(PStep));
69.   Inc(FIndex);
70.   with CurStep^ do begin
71.     BytePos  := ABytePos;
72.     InsStr    := AInsStr;
73.     DelStr    := ADelStr;
74.   end;
75. end;
76.  
77. procedure THistory.DelStep(Index: Integer);
78. var
79.   i: Integer;
80. begin
81.   for i := FSteps.Count - 1 downto Index do begin
82.     GetStep(i)^.InsStr := '';
83.     GetStep(i)^.DelStr := '';
84.     dispose(GetStep(i));
85.     FSteps.Delete(i);
86.   end;
87.   FIndex := Index - 1;
88. end;
89.  
90. procedure THistory.MemoOnChange(Sender: TObject);
91. var
92.   InsStr, DelStr: string;
93.   BytePos: SizeInt;
94. begin
95.   if FInEdit and StrDiff(BytePos, InsStr, DelStr) then begin
96.     AddStep(BytePos, InsStr, DelStr);
97.     FPrevContent := FMemo.Text;
98.   end;
99.  
100.   if Assigned(FOldOnChange) then
101.     FOldOnChange(Sender);
102. end;
103.  
104. function THistory.StrDiff(out BytePos: SizeInt; out InsStr, DelStr: string): Boolean;
105. var
106.   DiffLen: SizeInt;
107. begin
108.   DiffLen := Length(FMemo.Text) - Length(FPrevContent);
109.   // UTF8CharToByteIndex based 0
110.   BytePos := UTF8CharToByteIndex(PChar(FMemo.Text), Length(FMemo.Text), FMemo.SelStart) + 1;
111.  
112.   if DiffLen > 0 then begin
113.     BytePos := BytePos - DiffLen;
114.     InsStr := Copy(FMemo.Text, BytePos, DiffLen); // Copy based 1
115.     DelStr := '';
116.   end else if DiffLen < 0 then begin
117.     InsStr := '';
118.     DelStr := Copy(FPrevContent, BytePos, -DiffLen); // Copy based 1
119.   end else begin
120.     Result := False;
121.     Exit;
122.   end;
123.   Result := True;
124. end;
125.  
126. constructor THistory.Create(AMemo: TMemo);
127. begin
128.   inherited Create;
129.   FSteps := TList.Create;
130.   FMemo := AMemo;
131.   FOldOnChange := FMemo.OnChange;
132.   FMemo.OnChange := @MemoOnChange;
133.   FPrevContent := FMemo.Text;
134.   FIndex := -1;
135.   FInEdit := True;
136. end;
137.  
138. destructor THistory.Destroy;
139. begin
140.   FInEdit := False;
141.   FMemo.OnChange := FOldOnChange;
142.   FMemo := nil;
143.   FPrevContent := '';
144.   DelStep(0);
145.   FSteps.Free;
146.   inherited Destroy;
147. end;
148.  
149. function THistory.CanUndo: Boolean;
150. begin
151.   Result := FIndex >= 0;
152. end;
153.  
154. function THistory.CanRedo: Boolean;
155. begin
156.   Result := FIndex < FSteps.Count - 1;
157. end;
158.  
159. procedure THistory.Undo;
160. var
161.   NewSelStart: SizeInt;
162. begin
163.   if FIndex < 0 then Exit;
164.   FInEdit := False;
165.  
166.   // FPrevContent == FMemo.Text
167.   with CurStep^ do begin
168.     if InsStr <> '' then begin
169.       Delete(FPrevContent, BytePos, Length(InsStr));
170.       NewSelStart := FMemo.SelStart - UTF8LengthFast(InsStr);
171.     end else if DelStr <> '' then begin
172.       Insert(DelStr, FPrevContent, BytePos);
173.       NewSelStart := FMemo.SelStart + UTF8LengthFast(DelStr);
174.     end else begin
175.       writeln('Invalid history data!');
176.     end;
177.   end;
178.  
179.   FMemo.Text := FPrevContent;
180.   FMemo.SelStart := NewSelStart;
181.   FInEdit := True;
182.  
183.   Dec(FIndex);
184. end;
185.  
186. procedure THistory.Redo;
187. var
188.   NewSelStart: SizeInt;
189. begin            
190.   if FIndex >= FSteps.Count - 1 then Exit;
191.   FInEdit := False;
192.                  
193.   Inc(FIndex);
194.   // FPrevContent == FMemo.Text
195.   with CurStep^ do begin
196.     if InsStr <> '' then begin
197.       Insert(InsStr, FPrevContent, BytePos);
198.       NewSelStart := FMemo.SelStart + UTF8LengthFast(InsStr);
199.     end else if DelStr <> '' then begin
200.       Delete(FPrevContent, BytePos, Length(DelStr));
201.       NewSelStart := FMemo.SelStart - UTF8LengthFast(DelStr);
202.     end else begin
203.       writeln('Invalid history data!');
204.     end;
205.   end;
206.  
207.   FMemo.Text := FPrevContent;
208.   FMemo.SelStart := NewSelStart;
209.   FInEdit := True;
210. end;
211.  
212. end.

[tomitomy]

I'm sorry, I was wrong, my code is not faster. So, I use your UTF8Diff instead of my StrDiff, make it support drag and drop.

New uhistory.pas:

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.   PStep = ^TStep;
13.  
14.   TStep = record          
15.     BytePos  : SizeInt;
16.     SelStart : SizeInt;
17.     InsStr   : string;
18.     DelStr   : string;
19.   end;
20.  
21.   { THistory }
22.  
23.   THistory = class
24.   private
25.     FMemo        : TMemo;
26.     FSteps       : TList;         // History Records
27.     FIndex       : Integer;       // Based 0
28.     FOldOnChange : TNotifyEvent;
29.     FInEdit      : Boolean;
30.     FPrevContent : string;
31.  
32.     function    GetStep(AIndex: Integer): PStep;  
33.     function    CurStep: PStep;
34.  
35.     procedure   AddStep(ABytePos, ASelStart: SizeInt; AInsStr, ADelStr: string);
36.     procedure   DelStep(Index: Integer);
37.  
38.     procedure   MemoOnChange(Sender: TObject);
39.  
40.     function    StrDiff(out ABytePos, ASelStart: SizeInt; out AInsStr, ADelStr: string): Boolean;
41.   public
42.     constructor Create(AMemo: TMemo);
43.     destructor  Destroy; override;
44.  
45.     function    CanUndo: Boolean;
46.     function    CanRedo: Boolean;
47.     procedure   Undo;
48.     procedure   Redo;
49.   end;
50.  
51. implementation
52.  
53. { THistory }
54.  
55. function THistory.GetStep(AIndex: Integer): PStep;
56. begin
57.   Result := PStep(FSteps[AIndex]);
58. end;
59.  
60. function THistory.CurStep: PStep;
61. begin
62.   Result := GetStep(FIndex);
63. end;
64.      
65. procedure THistory.AddStep(ABytePos, ASelStart: SizeInt; AInsStr, ADelStr: string);
66. begin
67.   DelStep(FIndex + 1);
68.  
69.   FSteps.Add(new(PStep));
70.   Inc(FIndex);
71.   with CurStep^ do begin
72.     BytePos  := ABytePos;
73.     SelStart := ASelStart;
74.     InsStr   := AInsStr;
75.     DelStr   := ADelStr;
76.   end;
77. end;
78.  
79. procedure THistory.DelStep(Index: Integer);
80. var
81.   i: Integer;
82. begin
83.   for i := FSteps.Count - 1 downto Index do begin
84.     GetStep(i)^.InsStr := '';
85.     GetStep(i)^.DelStr := '';
86.     dispose(GetStep(i));
87.     FSteps.Delete(i);
88.   end;
89.   FIndex := Index - 1;
90. end;
91.  
92. procedure THistory.MemoOnChange(Sender: TObject);
93. var
94.   InsStr, DelStr: string;
95.   BytePos, SelStart: SizeInt;
96.   // TickCount: Int64;
97. begin
98.   // TickCount := GetTickCount64;
99.   if FInEdit and StrDiff(BytePos, SelStart, InsStr, DelStr) then begin
100.     // write(GetTickCount64 - TickCount, ' + ');
101.     // TickCount := GetTickCount64;
102.     AddStep(BytePos, SelStart, InsStr, DelStr);
103.     FPrevContent := FMemo.Text;
104.   end;          
105.   // writeln(GetTickCount64 - TickCount);
106.  
107.   if Assigned(FOldOnChange) then
108.     FOldOnChange(Sender);
109. end;
110.  
111. function THistory.StrDiff(out ABytePos, ASelStart: SizeInt; out AInsStr, ADelStr: string): Boolean;
112. var
113.   CurContent, CurPos, CurEnd, PrevPos: PChar;
114.   CurLen, PrevLen, DiffLen: SizeInt;
115.   CharLen: Integer;
116. begin
117.   CurContent := PChar(FMemo.Text);
118.   CurPos := CurContent;
119.   PrevPos := PChar(FPrevContent);
120.  
121.   CurLen := Length(CurPos);
122.   PrevLen := Length(PrevPos);
123.   DiffLen := CurLen - PrevLen;
124.  
125.   if DiffLen < 0 then
126.     CurEnd := CurPos + CurLen - 1
127.   else if DiffLen > 0 then
128.     CurEnd := CurPos + PrevLen - 1
129.   else begin
130.     Result := False;
131.     Exit;
132.   end;
133.  
134.   while (CurPos <= CurEnd) do begin
135.     if CurPos^ <> PrevPos^ then
136.       Break;
137.     Inc(CurPos);
138.     Inc(PrevPos);
139.   end;
140.   Utf8TryFindCodepointStart(CurContent, CurPos, CharLen);
141.   ABytePos := CurPos - CurContent + 1;
142.   if DiffLen > 0 then begin
143.     AInsStr := Copy(FMemo.Text, ABytePos, DiffLen);
144.     ADelStr := '';
145.   end else if DiffLen < 0 then begin
146.     AInsStr := '';
147.     ADelStr := Copy(FPrevContent, ABytePos, -DiffLen);
148.   end;  
149.   ASelStart := FMemo.SelStart;
150.  
151.   Result := True;
152. end;
153.  
154. constructor THistory.Create(AMemo: TMemo);
155. begin
156.   inherited Create;
157.   FSteps := TList.Create;
158.   FMemo := AMemo;
159.   FOldOnChange := FMemo.OnChange;
160.   FMemo.OnChange := @MemoOnChange;
161.   FPrevContent := FMemo.Text;
162.   FIndex := -1;
163.   FInEdit := True;
164. end;
165.  
166. destructor THistory.Destroy;
167. begin
168.   FInEdit := False;
169.   FMemo.OnChange := FOldOnChange;
170.   FMemo := nil;
171.   FPrevContent := '';
172.   DelStep(0);
173.   FSteps.Free;
174.   inherited Destroy;
175. end;
176.  
177. function THistory.CanUndo: Boolean;
178. begin
179.   Result := FIndex >= 0;
180. end;
181.  
182. function THistory.CanRedo: Boolean;
183. begin
184.   Result := FIndex < FSteps.Count - 1;
185. end;
186.  
187. procedure THistory.Undo;
188. var
189.   NewSelStart: SizeInt;
190. begin
191.   if FIndex < 0 then Exit;
192.   FInEdit := False;
193.  
194.   // FPrevContent == FMemo.Text
195.   with CurStep^ do begin
196.     if InsStr <> '' then begin
197.       Delete(FPrevContent, BytePos, Length(InsStr));
198.       NewSelStart := SelStart - UTF8LengthFast(InsStr);
199.     end else if DelStr <> '' then begin
200.       Insert(DelStr, FPrevContent, BytePos);
201.       NewSelStart := SelStart + UTF8LengthFast(DelStr);
202.     end else begin
203.       writeln('Invalid history data!');
204.     end;
205.   end;
206.  
207.   FMemo.Text := FPrevContent;
208.   FMemo.SelStart := NewSelStart;
209.   FInEdit := True;
210.  
211.   Dec(FIndex);
212. end;
213.  
214. procedure THistory.Redo;
215. var
216.   NewSelStart: SizeInt;
217. begin            
218.   if FIndex >= FSteps.Count - 1 then Exit;
219.   FInEdit := False;
220.                  
221.   Inc(FIndex);
222.   // FPrevContent == FMemo.Text
223.   with CurStep^ do begin
224.     if InsStr <> '' then begin
225.       Insert(InsStr, FPrevContent, BytePos);
226.       NewSelStart := SelStart + UTF8LengthFast(InsStr);
227.     end else if DelStr <> '' then begin
228.       Delete(FPrevContent, BytePos, Length(DelStr));
229.       NewSelStart := SelStart - UTF8LengthFast(DelStr);
230.     end else begin
231.       writeln('Invalid history data!');
232.     end;
233.   end;
234.  
235.   FMemo.Text := FPrevContent;
236.   FMemo.SelStart := NewSelStart;
237.   FInEdit := True;
238. end;
239.  
240. end.

[tomitomy]

I did a speed test (typing at the end of the 10MB text), found the "FMemo.Text" operation and "Length(PChar)" operation takes up a lot of time. I made some changes and raised the speed of 46%.

New uhistory.pas

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.   PStep = ^TStep;
13.  
14.   TStep = record          
15.     BytePos  : SizeInt;
16.     SelStart : SizeInt;
17.     InsStr   : string;
18.     DelStr   : string;
19.   end;
20.  
21.   { THistory }
22.  
23.   THistory = class
24.   private
25.     FMemo        : TMemo;
26.     FSteps       : TList;         // History Records
27.     FIndex       : Integer;       // Based 0
28.     FOldOnChange : TNotifyEvent;
29.     FInEdit      : Boolean;
30.     FPrevContent : string;
31.  
32.     function    GetStep(AIndex: Integer): PStep;  
33.     function    CurStep: PStep;
34.  
35.     procedure   AddStep(ABytePos, ASelStart: SizeInt; AInsStr, ADelStr: string);
36.     procedure   DelStep(Index: Integer);
37.  
38.     procedure   MemoOnChange(Sender: TObject);
39.  
40.     function    StrDiff(const ACurContent: string;
41.                         out ABytePos, ASelStart: SizeInt;
42.                         out AInsStr, ADelStr: string): Boolean;
43.   public
44.     constructor Create(AMemo: TMemo);
45.     destructor  Destroy; override;
46.  
47.     function    CanUndo: Boolean;
48.     function    CanRedo: Boolean;
49.     procedure   Undo;
50.     procedure   Redo;
51.   end;
52.  
53. implementation
54.  
55. { THistory }
56.  
57. function THistory.GetStep(AIndex: Integer): PStep;
58. begin
59.   Result := PStep(FSteps[AIndex]);
60. end;
61.  
62. function THistory.CurStep: PStep;
63. begin
64.   Result := GetStep(FIndex);
65. end;
66.      
67. procedure THistory.AddStep(ABytePos, ASelStart: SizeInt; AInsStr, ADelStr: string);
68. begin
69.   DelStep(FIndex + 1);
70.   FSteps.Add(new(PStep));
71.   Inc(FIndex);
72.   with CurStep^ do begin
73.     BytePos   := ABytePos;
74.     SelStart  := ASelStart;
75.     InsStr    := AInsStr;
76.     DelStr    := ADelStr;
77.   end;
78. end;
79.  
80. procedure THistory.DelStep(Index: Integer);
81. var
82.   i: Integer;
83. begin
84.   for i := FSteps.Count - 1 downto Index do begin
85.     GetStep(i)^.InsStr := '';
86.     GetStep(i)^.DelStr := '';
87.     dispose(GetStep(i));
88.     FSteps.Delete(i);
89.   end;
90.   FIndex := Index - 1;
91. end;
92.  
93. procedure THistory.MemoOnChange(Sender: TObject);
94. var
95.   CurContent, InsStr, DelStr: string;
96.   BytePos, SelStart: SizeInt;
97.   // TickCount: Int64;
98. begin
99.   // TickCount := GetTickCount64;
100.   CurContent := FMemo.Text; // Only get FMemo.Text one times.
101.   if FInEdit and StrDiff(CurContent, BytePos, SelStart, InsStr, DelStr) then begin
102.     AddStep(BytePos, SelStart, InsStr, DelStr);
103.     FPrevContent := CurContent;
104.   end;
105.   // writeln(GetTickCount64 - TickCount);
106.  
107.   if Assigned(FOldOnChange) then
108.     FOldOnChange(Sender);
109. end;
110.  
111. function THistory.StrDiff(const ACurContent: string;
112.   out ABytePos, ASelStart: SizeInt;
113.   out AInsStr, ADelStr: string): Boolean;
114. var
115.   CurStart, CurPos, CurEnd, PrevPos: PChar;
116.   CurLen, PrevLen, DiffLen: SizeInt;
117.   CharLen: Integer;
118. begin
119.   CurStart := PChar(ACurContent);
120.   CurPos := CurStart;
121.   PrevPos := PChar(FPrevContent);
122.  
123.   CurLen := Length(ACurContent);   // Use Length(string) DO NOT use Length(PChar)
124.   PrevLen := Length(FPrevContent);
125.   DiffLen := CurLen - PrevLen;
126.  
127.   if DiffLen < 0 then
128.     CurEnd := CurPos + CurLen - 1
129.   else if DiffLen > 0 then
130.     CurEnd := CurPos + PrevLen - 1
131.   else begin
132.     Result := False;
133.     Exit;
134.   end;
135.  
136.   while (CurPos <= CurEnd) do begin
137.     if CurPos^ <> PrevPos^ then Break;
138.     Inc(CurPos);
139.     Inc(PrevPos);
140.   end;
141.  
142.   Utf8TryFindCodepointStart(CurStart, CurPos, CharLen);
143.   ABytePos := CurPos - CurStart + 1;
144.  
145.   if DiffLen > 0 then begin
146.     AInsStr := Copy(ACurContent, ABytePos, DiffLen);
147.     ADelStr := '';
148.   end else begin
149.     AInsStr := '';
150.     ADelStr := Copy(FPrevContent, ABytePos, -DiffLen);
151.   end;
152.     ASelStart := FMemo.SelStart;
153.  
154.   Result := True;
155. end;
156.  
157. constructor THistory.Create(AMemo: TMemo);
158. begin
159.   inherited Create;
160.   FSteps := TList.Create;
161.   FMemo := AMemo;
162.   FOldOnChange := FMemo.OnChange;
163.   FMemo.OnChange := @MemoOnChange;
164.   FPrevContent := FMemo.Text;
165.   FIndex := -1;
166.   FInEdit := True;
167. end;
168.  
169. destructor THistory.Destroy;
170. begin
171.   FInEdit := False;
172.   FMemo.OnChange := FOldOnChange;
173.   FMemo := nil;
174.   FPrevContent := '';
175.   DelStep(0);
176.   FSteps.Free;
177.   inherited Destroy;
178. end;
179.  
180. function THistory.CanUndo: Boolean;
181. begin
182.   Result := FIndex >= 0;
183. end;
184.  
185. function THistory.CanRedo: Boolean;
186. begin
187.   Result := FIndex < FSteps.Count - 1;
188. end;
189.  
190. procedure THistory.Undo;
191. var
192.   NewSelStart: SizeInt;
193. begin
194.   if FIndex < 0 then Exit;
195.   FInEdit := False;
196.  
197.   // FPrevContent == FMemo.Text
198.   with CurStep^ do begin
199.     if InsStr <> '' then begin
200.       Delete(FPrevContent, BytePos, Length(InsStr));
201.       NewSelStart := SelStart - UTF8LengthFast(InsStr);
202.     end else begin
203.       Insert(DelStr, FPrevContent, BytePos);
204.       NewSelStart := SelStart + UTF8LengthFast(InsStr);
205.     end;
206.   end;
207.  
208.   FMemo.Text := FPrevContent;
209.   FMemo.SelStart := NewSelStart;
210.   FInEdit := True;
211.  
212.   Dec(FIndex);
213. end;
214.  
215. procedure THistory.Redo;
216. var
217.   NewSelStart: SizeInt;
218. begin            
219.   if FIndex >= FSteps.Count - 1 then Exit;
220.   FInEdit := False;
221.                  
222.   Inc(FIndex);
223.   // FPrevContent == FMemo.Text
224.   with CurStep^ do begin
225.     if InsStr <> '' then begin
226.       Insert(InsStr, FPrevContent, BytePos);
227.       NewSelStart := SelStart;
228.     end else begin
229.       Delete(FPrevContent, BytePos, Length(DelStr));
230.       NewSelStart := SelStart;
231.     end;
232.   end;
233.  
234.   FMemo.Text := FPrevContent;
235.   FMemo.SelStart := NewSelStart;
236.   FInEdit := True;
237. end;
238.  
239. end.

------------------------------------------------------------

Add Note: There is an error in line #204 of history.pas, the code "NewSelStart := SelStart + UTF8LengthFast(InsStr);" should be "NewSelStart := SelStart + UTF8LengthFast(DelStr);"

------------------------------------------------------------

Add Note: Using this code below to instead of "THistory.StrDiff" in above code can increase the speed by 30% (the OnChange speed, not the Undo/Redo speed). But does not support drag and drop (Because of the wrong FMemo.SelStart after drag and drop).

The attachment does not updated.

Code: Pascal  [Select]

1. function UTF8PosToBytePos(const AStr: string; const ASize: SizeInt; APos: SizeInt): SizeInt;
2. begin
3.   if APos < 1 then Result := -1 else Result := 0;
4.  
5.   while (APos > 1) and (Result < ASize) do begin
6.     case AStr[Result] of
7.       // #0..#127: Inc(Result);
8.       #192..#223: Inc(Result, 2);
9.       #224..#239: Inc(Result, 3);
10.       #240..#247: Inc(Result, 4);
11.       else Inc(Result);
12.     end;
13.     Dec(APos);
14.   end;
15.  
16.   Inc(Result)
17. end;
18.  
19. function THistory.StrDiff(const ACurContent: string;
20.   out ABytePos, ASelStart: SizeInt;
21.   out AInsStr, ADelStr: string): Boolean;
22. var
23.   DiffLen: SizeInt;
24. begin
25.   DiffLen := Length(ACurContent) - Length(FPrevContent);
26.   // UTF8CharToByteIndex based 0
27.   // ABytePos := UTF8CharToByteIndex(PChar(ACurContent), Length(ACurContent), FMemo.SelStart) + 1;
28.   ABytePos := UTF8PosToBytePos(PChar(ACurContent), Length(ACurContent), FMemo.SelStart + 1);
29.                              
30.   ASelStart := FMemo.SelStart;
31.   if DiffLen > 0 then begin
32.     ABytePos := ABytePos - DiffLen;
33.     AInsStr := Copy(ACurContent, ABytePos, DiffLen); // Copy based 1
34.     ADelStr := '';
35.   end else if DiffLen < 0 then begin
36.     AInsStr := '';
37.     ADelStr := Copy(FPrevContent, ABytePos, -DiffLen); // Copy based 1
38.   end else begin
39.     Result := False;
40.     Exit;
41.   end;
42.  
43.   Result := True;
44. end;

------------------------------------------------------------

[tomitomy]

This code can make the Paste has a better Undo/Redo, if you selected some text then paste, you will undo twice to back to the before of paste, this code only need undo one times.

Code: Pascal  [Select]

1. unit uhistory;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, StdCtrls, lazUTF8, Clipbrd;
9.  
10. type
11.  
12.   PStep = ^TStep;
13.  
14.   TStep = record
15.     BytePos  : SizeInt;
16.     SelStart : SizeInt;
17.     InsStr   : string;
18.     DelStr   : string;
19.   end;
20.  
21.   { THistory }
22.  
23.   THistory = class
24.   private
25.     FMemo        : TMemo;
26.     FSteps       : TList;         // History Records
27.     FIndex       : Integer;       // Based 0
28.     FOldOnChange : TNotifyEvent;
29.     FInEdit      : Boolean;
30.     FPrevContent : string;
31.  
32.     function    GetStep(AIndex: Integer): PStep;
33.     function    CurStep: PStep;
34.  
35.     procedure   AddStep(ABytePos, ASelStart: SizeInt; AInsStr, ADelStr: string);
36.     procedure   DelStep(Index: Integer);
37.  
38.     procedure   MemoOnChange(Sender: TObject);
39.  
40.     function    StrDiff(const ACurContent: string;
41.                         out ABytePos, ASelStart: SizeInt;
42.                         out AInsStr, ADelStr: string): Boolean;
43.   public
44.     constructor Create(AMemo: TMemo);
45.     destructor  Destroy; override;
46.  
47.     function    CanUndo: Boolean;
48.     function    CanRedo: Boolean;
49.     procedure   Undo;
50.     procedure   Redo;
51.     procedure   Paste;
52.   end;
53.  
54. implementation
55.  
56. { THistory }
57.  
58. function THistory.GetStep(AIndex: Integer): PStep;
59. begin
60.   Result := PStep(FSteps[AIndex]);
61. end;
62.  
63. function THistory.CurStep: PStep;
64. begin
65.   Result := GetStep(FIndex);
66. end;
67.  
68. procedure THistory.AddStep(ABytePos, ASelStart: SizeInt; AInsStr, ADelStr: string);
69. begin
70.   DelStep(FIndex + 1);
71.  
72.   FSteps.Add(new(PStep));
73.   Inc(FIndex);
74.   with CurStep^ do begin
75.     BytePos  := ABytePos;
76.     SelStart := ASelStart;
77.     InsStr   := AInsStr;
78.     DelStr   := ADelStr;
79.   end;
80. end;
81.  
82. procedure THistory.DelStep(Index: Integer);
83. var
84.   i: Integer;
85. begin
86.   for i := FSteps.Count - 1 downto Index do begin
87.     GetStep(i)^.InsStr := '';
88.     GetStep(i)^.DelStr := '';
89.     dispose(GetStep(i));
90.     FSteps.Delete(i);
91.   end;
92.   FIndex := Index - 1;
93. end;
94.  
95. procedure THistory.MemoOnChange(Sender: TObject);
96. var
97.   CurContent, InsStr, DelStr: string;
98.   BytePos, SelStart: SizeInt;
99.   // TickCount: Int64;
100. begin
101.   // TickCount := GetTickCount64;
102.   CurContent := FMemo.Text; // Only get FMemo.Text one times.
103.   if FInEdit and StrDiff(CurContent, BytePos, SelStart, InsStr, DelStr) then
104.     AddStep(BytePos, SelStart, InsStr, DelStr);
105.   FPrevContent := CurContent;
106.   // writeln(GetTickCount64 - TickCount);
107.  
108.   if Assigned(FOldOnChange) then
109.     FOldOnChange(Sender);
110. end;
111.  
112. function THistory.StrDiff(const ACurContent: string;
113.   out ABytePos, ASelStart: SizeInt;
114.   out AInsStr, ADelStr: string): Boolean;
115. var
116.   CurStart, CurPos, CurEnd, PrevPos: PChar;
117.   CurLen, PrevLen, DiffLen: SizeInt;
118.   CharLen: Integer;
119. begin
120.   CurStart := PChar(ACurContent);
121.   CurPos := CurStart;
122.   PrevPos := PChar(FPrevContent);
123.  
124.   CurLen := Length(ACurContent);   // Use Length(string) DO NOT use Length(PChar)
125.   PrevLen := Length(FPrevContent);
126.   DiffLen := CurLen - PrevLen;
127.  
128.   if DiffLen < 0 then
129.     CurEnd := CurPos + CurLen - 1
130.   else if DiffLen > 0 then
131.     CurEnd := CurPos + PrevLen - 1
132.   else begin
133.     Result := False;
134.     Exit;
135.   end;
136.  
137.   while (CurPos <= CurEnd) do begin
138.     if CurPos^ <> PrevPos^ then Break;
139.     Inc(CurPos);
140.     Inc(PrevPos);
141.   end;
142.  
143.   Utf8TryFindCodepointStart(CurStart, CurPos, CharLen);
144.   ABytePos := CurPos - CurStart + 1;
145.  
146.   if DiffLen > 0 then begin
147.     AInsStr := Copy(ACurContent, ABytePos, DiffLen);
148.     ADelStr := '';
149.   end else begin
150.     AInsStr := '';
151.     ADelStr := Copy(FPrevContent, ABytePos, -DiffLen);
152.   end;
153.   ASelStart := FMemo.SelStart;
154.  
155.   Result := True;
156. end;
157.  
158. constructor THistory.Create(AMemo: TMemo);
159. begin
160.   inherited Create;
161.   FSteps := TList.Create;
162.   FMemo := AMemo;
163.   FOldOnChange := FMemo.OnChange;
164.   FMemo.OnChange := @MemoOnChange;
165.   FPrevContent := FMemo.Text;
166.   FIndex := -1;
167.   FInEdit := True;
168. end;
169.  
170. destructor THistory.Destroy;
171. begin
172.   FInEdit := False;
173.   FMemo.OnChange := FOldOnChange;
174.   FMemo := nil;
175.   FPrevContent := '';
176.   DelStep(0);
177.   FSteps.Free;
178.   inherited Destroy;
179. end;
180.  
181. function THistory.CanUndo: Boolean;
182. begin
183.   Result := FIndex >= 0;
184. end;
185.  
186. function THistory.CanRedo: Boolean;
187. begin
188.   Result := FIndex < FSteps.Count - 1;
189. end;
190.  
191. procedure THistory.Undo;
192. var
193.   NewSelStart: SizeInt;
194. begin
195.   if FIndex < 0 then Exit;
196.   FInEdit := False;
197.  
198.   // FPrevContent == FMemo.Text
199.   with CurStep^ do begin
200.     if InsStr <> '' then begin
201.       Delete(FPrevContent, BytePos, Length(InsStr));
202.       NewSelStart := SelStart - UTF8LengthFast(InsStr);
203.     end;
204.     if DelStr <>'' then begin
205.       Insert(DelStr, FPrevContent, BytePos);
206.       NewSelStart := SelStart + UTF8LengthFast(DelStr);
207.     end;
208.   end;
209.   FMemo.Text := FPrevContent;
210.   FMemo.SelStart := NewSelStart;
211.   Dec(FIndex);
212.  
213.   FInEdit := True;
214. end;
215.  
216. procedure THistory.Redo;
217. var
218.   NewSelStart: SizeInt;
219. begin
220.   if FIndex >= FSteps.Count - 1 then Exit;
221.   FInEdit := False;
222.  
223.   Inc(FIndex);
224.   // FPrevContent == FMemo.Text
225.   with CurStep^ do begin
226.     if DelStr <> '' then begin
227.       Delete(FPrevContent, BytePos, Length(DelStr));
228.       NewSelStart := SelStart;
229.     end;
230.     if InsStr <> '' then begin
231.       Insert(InsStr, FPrevContent, BytePos);
232.       NewSelStart := SelStart;
233.     end;
234.   end;
235.   FMemo.Text := FPrevContent;
236.   FMemo.SelStart := NewSelStart;
237.  
238.   FInEdit := True;
239. end;
240.  
241. function UTF8PosToBytePos(const AStr: string; const ASize: SizeInt; APos: SizeInt): SizeInt;
242. begin
243.   if APos < 1 then Result := -1 else Result := 0;
244.  
245.   while (APos > 1) and (Result < ASize) do begin
246.     case AStr[Result] of
247.       // #0..#127: Inc(Result);
248.       #192..#223: Inc(Result, 2);
249.       #224..#239: Inc(Result, 3);
250.       #240..#247: Inc(Result, 4);
251.       else Inc(Result);
252.     end;
253.     Dec(APos);
254.   end;
255.  
256.   Inc(Result)
257. end;
258.  
259. procedure THistory.Paste;
260. var
261.   BytePos: SizeInt;
262.   ClipBoardText: string;
263. begin
264.   FInEdit := False;
265.  
266.   ClipBoardText := ClipBoard.AsText;
267.   if ClipBoardText <> '' then begin
268.     // FPrevContent == FMemo.Text
269.     BytePos := UTF8PosToBytePos(FPrevContent, Length(FPrevContent), FMemo.SelStart + 1);
270.     AddStep(BytePos, FMemo.SelStart, ClipBoardText, FMemo.SelText);
271.     FMemo.SelText := ClipBoardText;
272.   end;
273.  
274.   FInEdit := True;
275. end;
276.  
277. end.

[tomitomy]

Fix the OnChange bug (https://bugs.freepascal.org/view.php?id=32669).

uhistory.pas:

Code: Pascal  [Select]

1. unit uhistory;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, StdCtrls, lazUTF8, Clipbrd;
9.  
10. type
11.  
12.   PStep = ^TStep;
13.  
14.   // 单步历史记录数据
15.   // one step of history data
16.   TStep = record
17.     BytePos  : SizeInt;
18.     SelStart : SizeInt; // used to restore the cursor position（用于恢复光标位置）
19.     InsStr   : string;
20.     DelStr   : string;
21.   end;
22.  
23.   { THistory }
24.  
25.   THistory = class
26.   private
27.     FMemo        : TMemo;
28.     FSteps       : TList;         // history records data（历史记录数据）
29.     FIndex       : Integer;       // history index, based 0（历史记录索引，从 0 开始）
30.     FOldOnChange : TNotifyEvent;
31.     FInEdit      : Boolean;
32.  
33.     // OnChange 事件之前的 FMemo 内容
34.     // the content of FMemo before OnChange event
35.     FPrevContent : string;
36.     FSize        : SizeInt;       // all steps size（所有历史步骤的总大小）
37.  
38.     FixOnChangeBug : Boolean;
39.  
40.     function    GetStep(AIndex: Integer): PStep; inline;
41.     function    CurStep: PStep; inline;
42.  
43.     procedure   AddStep(ABytePos, ASelStart: SizeInt; AInsStr, ADelStr: string);
44.     procedure   DelStep(AIndex: Integer);
45.  
46.     procedure   MemoOnChange(Sender: TObject);
47.  
48.     function    StrDiff(const ACurContent: string;
49.                         out ABytePos, ASelStart: SizeInt;
50.                         out AInsStr, ADelStr: string): Boolean;
51.   public
52.     constructor Create(AMemo: TMemo);
53.     destructor  Destroy; override;
54.  
55.     function    CanUndo: Boolean; inline;
56.     function    CanRedo: Boolean; inline;
57.     procedure   Undo;
58.     procedure   Redo;
59.  
60.     // 你应该使用 Paste 函数粘贴文本，而不是 FMemo.PasteFromClipboard 函数，
61.     // 否则你的粘贴操作可能需要撤销两次才能恢复到粘贴之前的状态。
62.     // you should use Paste function to paste text instead of FMemo.PasteFromClipboard function,
63.     // otherwise your paste operation may need to perform twice Undo to restore to the state before paste.
64.     procedure   PasteText;
65.  
66.     // 你应该使用 DeleteText 函数删除文本，而不是 FMemo.Text := '' 方法，
67.     // 否则你的删除操作可能不会触发 OnChange 事件。
68.     // you should use the DeleteText function to delete text instead of the FMemo.Text := '' method,
69.     // otherwise your delete operation may not trigger the OnChange event.
70.     procedure   DeleteText;
71.                            
72.     procedure   Reset; inline;
73.     property    Size: SizeInt read FSize;
74.   end;
75.  
76. implementation
77.  
78. { THistory }
79.  
80. function THistory.GetStep(AIndex: Integer): PStep; inline;
81. begin
82.   Result := PStep(FSteps[AIndex]);
83. end;
84.  
85. function THistory.CurStep: PStep; inline;
86. begin
87.   Result := GetStep(FIndex);
88. end;
89.  
90. procedure THistory.AddStep(ABytePos, ASelStart: SizeInt; AInsStr, ADelStr: string);
91. begin
92.   DelStep(FIndex + 1);
93.  
94.   FSteps.Add(new(PStep));
95.   Inc(FIndex);
96.   Inc(FSize, Sizeof(TStep) + Length(AInsStr) + Length(ADelStr));
97.   with CurStep^ do begin
98.     BytePos  := ABytePos;
99.     SelStart := ASelStart;
100.     InsStr   := AInsStr;
101.     DelStr   := ADelStr;
102.   end;
103. end;
104.  
105. procedure THistory.DelStep(AIndex: Integer);
106. var
107.   i: Integer;
108.   Step: PStep;
109. begin
110.   for i := FSteps.Count - 1 downto AIndex do begin
111.     Step := GetStep(i);
112.     Dec(FSize, Sizeof(TStep) + Length(Step^.InsStr) + Length(Step^.DelStr));
113.     Step^.InsStr := '';
114.     Step^.DelStr := '';
115.     dispose(Step);
116.     FSteps.Delete(i);
117.   end;
118.   FIndex := AIndex - 1;
119. end;
120.  
121. constructor THistory.Create(AMemo: TMemo);
122. begin
123.   inherited Create;
124.   FSteps := TList.Create;
125.  
126.   FMemo := AMemo;
127.   FOldOnChange := FMemo.OnChange;
128.   FMemo.OnChange := @MemoOnChange;
129.  
130.   FPrevContent := FMemo.Text;
131.   FIndex := -1;
132.  
133.   FInEdit := True;
134. end;
135.  
136. destructor THistory.Destroy;
137. begin
138.   FMemo.OnChange := FOldOnChange;
139.   FMemo := nil;
140.  
141.   DelStep(0);
142.   FSteps.Free;
143.   inherited Destroy;
144. end;
145.  
146. procedure THistory.MemoOnChange(Sender: TObject);
147. var
148.   CurContent, InsStr, DelStr: string;
149.   BytePos, SelStart: SizeInt;
150. begin
151.   if FInEdit then begin
152.     CurContent := FMemo.Text;
153.     if StrDiff(CurContent, BytePos, SelStart, InsStr, DelStr) then
154.       AddStep(BytePos, SelStart, InsStr, DelStr);
155.     FPrevContent := CurContent;
156.   end;
157.  
158.   FixOnChangeBug := False;
159.  
160.   if Assigned(FOldOnChange) then
161.     FOldOnChange(Sender);
162. end;
163.  
164. function THistory.StrDiff(const ACurContent: string;
165.   out ABytePos, ASelStart: SizeInt;
166.   out AInsStr, ADelStr: string): Boolean;
167. var
168.   CurStart, CurPos, CurEnd, PrevPos: PChar;
169.   CurLen, PrevLen, DiffLen: SizeInt;
170.   CharLen: Integer;
171. begin
172.   CurStart := PChar(ACurContent);
173.   CurPos := CurStart;
174.   PrevPos := PChar(FPrevContent);
175.  
176.   CurLen := Length(ACurContent);   // Use Length(string) DO NOT use Length(PChar)
177.   PrevLen := Length(FPrevContent);
178.   DiffLen := CurLen - PrevLen;
179.  
180.   if DiffLen < 0 then
181.     CurEnd := CurPos + CurLen - 1
182.   else if DiffLen > 0 then
183.     CurEnd := CurPos + PrevLen - 1
184.   else begin
185.     Result := False;
186.     Exit;
187.   end;
188.  
189.   while (CurPos <= CurEnd) do begin
190.     if CurPos^ <> PrevPos^ then Break;
191.     Inc(CurPos);
192.     Inc(PrevPos);
193.   end;
194.  
195.   Utf8TryFindCodepointStart(CurStart, CurPos, CharLen);
196.   ABytePos := CurPos - CurStart + 1;
197.  
198.   if DiffLen > 0 then begin
199.     AInsStr := Copy(ACurContent, ABytePos, DiffLen);
200.     ADelStr := '';
201.   end else begin
202.     AInsStr := '';
203.     ADelStr := Copy(FPrevContent, ABytePos, -DiffLen);
204.   end;
205.   ASelStart := FMemo.SelStart;
206.  
207.   Result := True;
208. end;
209.  
210. function THistory.CanUndo: Boolean; inline;
211. begin
212.   Result := FIndex >= 0;
213. end;
214.  
215. function THistory.CanRedo: Boolean; inline;
216. begin
217.   Result := FIndex < FSteps.Count - 1;
218. end;
219.  
220. procedure THistory.Undo;
221. var
222.   NewSelStart: SizeInt;
223. begin
224.   if FIndex < 0 then Exit;
225.   FInEdit := False;
226.  
227.   FixOnChangeBug := True;
228.  
229.   // FPrevContent == FMemo.Text
230.   with CurStep^ do begin
231.     if InsStr <> '' then begin
232.       Delete(FPrevContent, BytePos, Length(InsStr));
233.       NewSelStart := SelStart - UTF8LengthFast(InsStr);
234.     end;
235.     if DelStr <>'' then begin
236.       Insert(DelStr, FPrevContent, BytePos);
237.       NewSelStart := SelStart + UTF8LengthFast(DelStr);
238.     end;
239.   end;
240.   FMemo.Lines.Text := FPrevContent;
241.   FMemo.SelStart := NewSelStart;
242.   Dec(FIndex);
243.  
244.   if FixOnChangeBug then MemoOnChange(FMemo);
245.  
246.   FInEdit := True;
247. end;
248.  
249. procedure THistory.Redo;
250. var
251.   NewSelStart: SizeInt;
252. begin
253.   if FIndex >= FSteps.Count - 1 then Exit;
254.   FInEdit := False;
255.  
256.   FixOnChangeBug := True;
257.  
258.   Inc(FIndex);
259.   // FPrevContent == FMemo.Text
260.   with CurStep^ do begin
261.     if DelStr <> '' then begin
262.       Delete(FPrevContent, BytePos, Length(DelStr));
263.       NewSelStart := SelStart;
264.     end;
265.     if InsStr <> '' then begin
266.       Insert(InsStr, FPrevContent, BytePos);
267.       NewSelStart := SelStart;
268.     end;
269.   end;
270.   FMemo.Lines.Text := FPrevContent;
271.   FMemo.SelStart := NewSelStart;
272.  
273.   if FixOnChangeBug then MemoOnChange(FMemo);
274.  
275.   FInEdit := True;
276. end;
277.  
278. function UTF8PosToBytePos(const AStr: string; const ASize: SizeInt; APos: SizeInt): SizeInt;
279. begin
280.   if APos < 1 then Result := -1 else Result := 0;
281.  
282.   while (APos > 1) and (Result < ASize) do begin
283.     case AStr[Result] of
284.       // #0..#127: Inc(Result);
285.       #192..#223: Inc(Result, 2);
286.       #224..#239: Inc(Result, 3);
287.       #240..#247: Inc(Result, 4);
288.       else Inc(Result);
289.     end;
290.     Dec(APos);
291.   end;
292.  
293.   Inc(Result)
294. end;
295.  
296. procedure THistory.PasteText;
297. var
298.   BytePos: SizeInt;
299.   ClipBoardText: string;
300. begin
301.   FInEdit := False;
302.  
303.   ClipBoardText := ClipBoard.AsText;
304.   if ClipBoardText <> '' then begin
305.     FixOnChangeBug := True;
306.  
307.     // FPrevContent == FMemo.Text
308.     BytePos := UTF8PosToBytePos(FPrevContent, Length(FPrevContent), FMemo.SelStart + 1);
309.     AddStep(BytePos, FMemo.SelStart, ClipBoardText, FMemo.SelText);
310.     FMemo.SelText := ClipBoardText;
311.     FPrevContent := FMemo.Text;
312.  
313.     if FixOnChangeBug then MemoOnChange(FMemo);
314.   end;
315.  
316.   FInEdit := True;
317. end;
318.  
319. procedure THistory.DeleteText;
320. var
321.   BytePos: SizeInt;
322. begin
323.   FInEdit := False;
324.  
325.   if FMemo.SelLength > 0 then begin
326.     FixOnChangeBug := True;
327.  
328.     // FPrevContent == FMemo.Text
329.     BytePos := UTF8PosToBytePos(FPrevContent, Length(FPrevContent), FMemo.SelStart + 1);
330.     AddStep(BytePos, FMemo.SelStart, '', FMemo.SelText);
331.     FMemo.SelText := '';
332.     FPrevContent := FMemo.Text;
333.  
334.     if FixOnChangeBug then MemoOnChange(FMemo);
335.   end;
336.  
337.   FInEdit := True;
338. end;
339.  
340. procedure THistory.Reset; inline;
341. begin
342.   DelStep(0);
343.   FPrevContent := FMemo.Text;
344. end;
345.  
346. end.