* * *

Author Topic: I implemented the undo/redo functions of TMemo, and I'm happy to share it  (Read 1206 times)

tomitomy

  • Full Member
  • ***
  • Posts: 133
This is a version that does not support drag and drop operations, and it works well in Windows.

There is a version in the reply #1 that supports drag and drop operations, it works well in Windows and GTK2. This version is in order to repair the Drag and Drop BUG that in GTK2. The code that Fix this BUG is very inefficient, I have not thought of a better way, if someone has better idea, please tell me, thanks!

There is also a Demo in the reply #2 that shows the TreeView multi-node Undo and Redo, it works well in Windows and GTK2.

Version 1 (does not support drag and drop operations):
Code: Pascal  [Select]
  1. unit unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ActnList, uhistory;
  9.  
  10. type
  11.  
  12.   { TForm1 }
  13.  
  14.   TForm1 = class(TForm)
  15.     Edit1: TEdit;
  16.     Memo1: TMemo;
  17.     Button1: TButton;
  18.     Button2: TButton;
  19.     ActionList1: TActionList;
  20.     Action1: TAction;
  21.     Action2: TAction;
  22.     procedure Edit1Change(Sender: TObject);
  23.     procedure FormCreate(Sender: TObject);
  24.     procedure Action1Execute(Sender: TObject);
  25.     procedure Action2Execute(Sender: TObject);
  26.     procedure Memo1Change(Sender: TObject);
  27.   private
  28.     EditHistory: TEditHistory;
  29.     MemoHistory: TMemoHistory;
  30.   public
  31.  
  32.   end;
  33.  
  34. var
  35.   Form1: TForm1;
  36.  
  37. implementation
  38.  
  39. {$R *.lfm}
  40.  
  41. { TForm1 }
  42.  
  43. procedure TForm1.FormCreate(Sender: TObject);
  44. begin
  45.   // The default maximum capacity of MemoHistory is 32K
  46.   // The default minimum count of MemoHistory is 10
  47.   EditHistory := TEditHistory.Create(Edit1);
  48.   MemoHistory := TMemoHistory.Create(Memo1);
  49. end;
  50.  
  51. procedure TForm1.Action1Execute(Sender: TObject);
  52. begin              
  53.   if ActiveControl = Edit1 then    
  54.     EditHistory.Undo
  55.   else if ActiveControl = Memo1 then
  56.     MemoHistory.Undo;
  57. end;
  58.  
  59. procedure TForm1.Action2Execute(Sender: TObject);
  60. begin              
  61.   if ActiveControl = Edit1 then  
  62.     EditHistory.Redo
  63.   else if ActiveControl = Memo1 then
  64.     MemoHistory.Redo;
  65. end;
  66.      
  67. procedure TForm1.Edit1Change(Sender: TObject);
  68. begin
  69.   Caption := Format('Index:%d   Count:%d/%d   Size:%d/%d',
  70.     [EditHistory.Index,
  71.     EditHistory.Count, EditHistory.MinCount,
  72.     EditHistory.Size, EditHistory.MaxSize])
  73. end;
  74.  
  75. procedure TForm1.Memo1Change(Sender: TObject);
  76. begin
  77.   Caption := Format('Index:%d   Count:%d/%d   Size:%d/%d',
  78.     [MemoHistory.Index,
  79.     MemoHistory.Count, MemoHistory.MinCount,
  80.     MemoHistory.Size, MemoHistory.MaxSize]);
  81. end;
  82.  
  83. end.

Version 1 (does not support drag and drop operations):
Code: Pascal  [Select]
  1. unit uhistory;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Variants, Controls, StdCtrls, Dialogs, Forms;
  9.  
  10. type
  11.   // One Undo/Redo record
  12.   PHistoryRecord = ^THistroyRecord;
  13.  
  14.   THistroyRecord = record
  15.     PrevSelStart: integer;
  16.     PrevSelLength: integer;
  17.     PrevSelText: string;
  18.  
  19.     SelStart: integer;
  20.     SelLength: integer;
  21.     SelText: string;
  22.   end;
  23.  
  24.   { THistory }
  25.  
  26.   generic THistory <T> = class
  27.   private
  28.     FEnabled: boolean;
  29.     FEdit: T;
  30.     FList: TList;             // List of Undo/Redo records
  31.     FIndex: integer;          // Index of current record
  32.     FSize: integer;           // Current history size
  33.     FMaxSize: integer;        // Maximum size limit for history
  34.     FMinCount: integer;       // Minimum count limit of records
  35.     FEditing: boolean;        // Is it not in the undo/redo state
  36.  
  37.     FPrevText: string;        // The content of the FEdit before OnChange Event
  38.     FPrevSelStart: integer;   // The SelStart of the FEdit before OnChange Event
  39.     FPrevSelLength: integer;  // The SelLength of the FEdit before OnChange Event
  40.  
  41.     FOldKeyDown: TKeyEvent;
  42.     FOldMouseDown: TMouseEvent;
  43.     FOldChange: TNotifyEvent;
  44.  
  45.     // Get the SelStart and SelLength of FEdit before the OnChange event is executed
  46.     procedure KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  47.     procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  48.  
  49.     procedure Change(Sender: TObject);
  50.  
  51.  
  52.     function GetRecordSize(PHR: PHistoryRecord): integer;
  53.     // Check if the undo operation can be executed correctly
  54.     function InvaildRecord(PHR: PHistoryRecord): boolean;
  55.     // Just use the Text, SelStart and PrevText to calculate the Record Information
  56.     procedure CalcRecord(out PHR: PHistoryRecord);
  57.  
  58.     function GetIndex: integer;
  59.     function GetCount: integer;
  60.     procedure SetEnabled(AValue: boolean);
  61.  
  62.     procedure ShowPrevText; // debug
  63.     procedure ShowCurText;  // debug
  64.     procedure ShowHistory;  // Debug
  65.     procedure ShowRecord;   // Debug
  66.   public
  67.     constructor Create(AEdit: TCustomEdit; AMaxSize: integer = 32 * 1024; AMinCount: integer = 10);
  68.     destructor Destroy; override;
  69.  
  70.     function CanUndo: boolean;
  71.     function CanRedo: boolean;
  72.     procedure Undo;
  73.     procedure Redo;
  74.  
  75.     property Index: integer read GetIndex;
  76.     property Size: integer read FSize;
  77.     property MaxSize: integer read FMaxSize;
  78.     property Count: integer read GetCount;
  79.     property MinCount: integer read FMinCount;
  80.     property Enabled: boolean read FEnabled write SetEnabled;
  81.   end;
  82.  
  83.   TEditHistory = specialize THistory<TEdit>;
  84.   TMemoHistory = specialize THistory<TMemo>;
  85.  
  86. implementation
  87.  
  88. uses
  89.   lazUTF8;
  90.  
  91. constructor THistory.Create(AEdit: TCustomEdit; AMaxSize: integer = 32 * 1024; AMinCount: integer = 10);
  92. begin
  93.   inherited Create;
  94.  
  95.   FEdit := T(AEdit);
  96.   FPrevText := FEdit.Text;
  97.   FPrevSelStart := 0;
  98.   FPrevSelLength := 0;
  99.  
  100.   FList := TList.Create;
  101.   FIndex := -1;
  102.   FSize := 0;
  103.   FMaxSize := AMaxSize;
  104.   FMinCount := AMinCount;
  105.   FEditing := True;
  106.  
  107.   FOldChange := FEdit.OnChange;
  108.   FOldKeyDown := FEdit.OnKeyDown;
  109.   FOldMouseDown := FEdit.OnMouseDown;
  110.  
  111.   FEdit.OnChange := @Change;
  112.   FEdit.OnKeyDown := @KeyDown;
  113.   FEdit.OnMouseDown := @MouseDown;
  114.  
  115.   FEnabled := True;
  116. end;
  117.  
  118. destructor THistory.Destroy;
  119. var
  120.   i: integer;
  121. begin
  122.   for i := 0 to FList.Count - 1 do
  123.     dispose(PHistoryRecord(FList[i]));
  124.  
  125.   FList.Free;
  126.  
  127.   Enabled := False;
  128.  
  129.   inherited Destroy;
  130. end;
  131.  
  132. procedure THistory.KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  133. begin
  134.   FPrevSelStart := FEdit.SelStart;
  135.   FPrevSelLength := FEdit.SelLength;
  136.  
  137.   if Assigned(FOldKeyDown) then
  138.     FOldKeyDown(Sender, Key, Shift);
  139. end;
  140.  
  141. procedure THistory.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  142. begin
  143.   FPrevSelStart := FEdit.SelStart;
  144.   FPrevSelLength := FEdit.SelLength;
  145.  
  146.   if Assigned(FOldMouseDown) then
  147.     FOldMouseDown(Sender, Button, Shift, X, Y);
  148. end;
  149.  
  150. procedure THistory.Change(Sender: TObject);
  151. var
  152.   i: integer;
  153.   PHR: PHistoryRecord;
  154.   SelStart: integer;
  155. begin
  156.   // ShowPrevText;  // debug
  157.   // ShowCurText;   // debug
  158.   SelStart := FEdit.SelStart;
  159.  
  160.   if FEditing then
  161.   begin
  162.     // Destroy the records after current record
  163.     for i := FList.Count - 1 downto FIndex + 1 do
  164.     begin
  165.       Dec(FSize, GetRecordSize(PHistoryRecord(FList[i])));
  166.       dispose(PHistoryRecord(FList[i]));
  167.       FList.Delete(i);
  168.     end;
  169.  
  170.     // Add a record
  171.     PHR := new(PHistoryRecord);
  172.     FList.Add(PHR);
  173.     Inc(FIndex);
  174.  
  175.     // Fill in the record
  176.     if SelStart < FPrevSelStart then
  177.     begin
  178.       // Backspace character
  179.       PHR^.PrevSelStart := SelStart;
  180.       PHR^.PrevSelLength := FPrevSelStart - SelStart;
  181.       PHR^.PrevSelText := UTF8Copy(FPrevText, PHR^.PrevSelStart + 1, PHR^.PrevSelLength);
  182.  
  183.       PHR^.SelStart := SelStart;
  184.       PHR^.SelLength := 0;
  185.       PHR^.SelText := '';
  186.     end
  187.     else if SelStart > FPrevSelStart then
  188.     begin
  189.       // Add text (Input or Paste)
  190.       PHR^.PrevSelStart := FPrevSelStart;
  191.       PHR^.PrevSelLength := 0;
  192.       PHR^.PrevSelText := '';
  193.  
  194.       PHR^.SelStart := FPrevSelStart;
  195.       PHR^.SelLength := SelStart - FPrevSelStart;
  196.       PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength);
  197.     end
  198.     else
  199.     begin
  200.       // Delete a character without text selection (Just select it)
  201.       if FPrevSelLength = 0 then
  202.         FPrevSelLength := 1;
  203.       // Delete selected text
  204.       PHR^.PrevSelStart := FPrevSelStart;
  205.       PHR^.PrevSelLength := FPrevSelLength;
  206.       PHR^.PrevSelText := UTF8Copy(FPrevText, FPrevSelStart + 1, FPrevSelLength);
  207.  
  208.       PHR^.SelStart := SelStart;
  209.       PHR^.SelLength := 0;
  210.       PHR^.SelText := '';
  211.     end;
  212.  
  213.     // Safeguard: If the Record is invaild
  214.     if InvaildRecord(PHR) then
  215.     begin
  216.       // The code will run into here if FPrevSelStart and FPrevSelLength
  217.       // are not correctly obtained.
  218.       // In this case, I need to calculate the Record information here.
  219.       CalcRecord(PHR);
  220.       // writeln('***** Invaild Undo Record *****');  // debug
  221.       // ShowMessage('Invaild Undo Record');  // debug
  222.     end;
  223.  
  224.     // Update history size
  225.     Inc(FSize, GetRecordSize(PHR));
  226.     // Limit history size
  227.     while (FMaxSize > 0) and (FSize > FMaxSize) and (FList.Count > FMinCount) do
  228.     begin
  229.       Dec(FSize, GetRecordSize(PHistoryRecord(FList[0])));
  230.       dispose(PHistoryRecord(FList[0]));
  231.       FList.Delete(0);
  232.       Dec(FIndex);
  233.     end;
  234.   end;
  235.  
  236.   // Save the text information for the next OnChange event
  237.   FPrevSelStart := SelStart;
  238.   FPrevSelLength := FEdit.SelLength;
  239.   FPrevText := FEdit.Text;
  240.   // ShowRecord;  // debug
  241.   // writeln('==============================');  // debug
  242.  
  243.   if Assigned(FOldChange) then
  244.     FOldChange(Sender);
  245. end;
  246.  
  247. function THistory.CanUndo: boolean;
  248. begin
  249.   Result := FIndex >= 0;
  250. end;
  251.  
  252. function THistory.CanRedo: boolean;
  253. begin
  254.   Result := FIndex < FList.Count - 1;
  255. end;
  256.  
  257. procedure THistory.Undo;
  258. var
  259.   PHR: PHistoryRecord;
  260. begin
  261.   if FIndex < 0 then Exit;
  262.  
  263.   PHR := PHistoryRecord(FList[FIndex]);
  264.  
  265.   FEditing := False;
  266.   FEdit.SelStart := PHR^.SelStart;
  267.   FEdit.SelLength := PHR^.SelLength;
  268.   FEdit.SelText := PHR^.PrevSelText;
  269.   FEditing := True;
  270.  
  271.   FPrevText := FEdit.Text;  // For the next write operation of FEdit
  272.  
  273.   Dec(FIndex);
  274. end;
  275.  
  276. procedure THistory.Redo;
  277. var
  278.   PHR: PHistoryRecord;
  279. begin
  280.   if FIndex >= FList.Count - 1 then Exit;
  281.  
  282.   Inc(FIndex);
  283.   PHR := PHistoryRecord(FList[FIndex]);
  284.  
  285.   FEditing := False;
  286.   FEdit.SelStart := PHR^.PrevSelStart;
  287.   FEdit.SelLength := PHR^.PrevSelLength;
  288.   FEdit.SelText := PHR^.SelText;
  289.   FEditing := True;
  290. end;
  291.  
  292. function THistory.InvaildRecord(PHR: PHistoryRecord): boolean;
  293. begin
  294.   Result := (Length(FEdit.Text) - PHR^.SelText.Length + PHR^.PrevSelText.Length) <> FPrevText.Length;
  295. end;
  296.  
  297. procedure THistory.CalcRecord(out PHR: PHistoryRecord);
  298. var
  299.   PrevLen, Len: integer;
  300.   Head, Tail: string;
  301. begin
  302.   Len := UTF8Length(FEdit.Text);
  303.   PrevLen := UTF8Length(FPrevText);
  304.  
  305.   if Len > PrevLen then
  306.   begin
  307.     // Add content to FEdit
  308.     Tail := UTF8Copy(FEdit.Text, FEdit.SelStart + 1, MaxInt);
  309.  
  310.     PHR^.PrevSelStart := PrevLen - UTF8Length(Tail);
  311.     PHR^.PrevSelLength := 0;
  312.     PHR^.PrevSelText := '';
  313.  
  314.     PHR^.SelStart := PHR^.PrevSelStart;
  315.     PHR^.SelLength := Len - PrevLen;
  316.     PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength);
  317.   end
  318.   else
  319.   begin
  320.     // Delet content from FEdit
  321.     Head := UTF8Copy(FEdit.Text, 1, FEdit.SelStart);
  322.  
  323.     PHR^.PrevSelStart := UTF8Length(Head);
  324.     PHR^.PrevSelLength := PrevLen - Len;
  325.     PHR^.PrevSelText := UTF8Copy(FPrevText, PHR^.PrevSelStart + 1, PHR^.PrevSelLength);
  326.  
  327.     PHR^.SelStart := PHR^.PrevSelStart;
  328.     PHR^.SelLength := 0;
  329.     PHR^.SelText := '';
  330.   end;
  331. end;
  332.  
  333. function THistory.GetIndex: integer;
  334. begin
  335.   Result := FIndex + 1;
  336. end;
  337.  
  338. function THistory.GetCount: integer;
  339. begin
  340.   Result := FList.Count;
  341. end;
  342.  
  343. procedure THistory.SetEnabled(AValue: boolean);
  344. begin
  345.   if FEnabled = AValue then Exit;
  346.  
  347.   FEnabled := AValue;
  348.  
  349.   if FEnabled then
  350.   begin
  351.     FEdit.OnChange := @Change;
  352.     FEdit.OnKeyDown := @KeyDown;
  353.     FEdit.OnMouseDown := @MouseDown;
  354.   end
  355.   else
  356.   begin
  357.     FEdit.OnChange := FOldChange;
  358.     FEdit.OnKeyDown := FOldKeyDown;
  359.     FEdit.OnMouseDown := FOldMouseDown;
  360.   end;
  361. end;
  362.  
  363. function THistory.GetRecordSize(PHR: PHistoryRecord): integer;
  364. begin
  365.   Result := PHR^.PrevSelText.Length + PHR^.SelText.Length + 4 * Sizeof(integer);
  366. end;
  367.  
  368. // for Debug
  369. procedure THistory.ShowPrevText;
  370. begin
  371.   Writeln(Format('Prev: %d, %d "%s"', [FPrevSelStart, FPrevSelLength, FPrevText]));
  372. end;
  373.  
  374. // for Debug
  375. procedure THistory.ShowCurText;
  376. begin
  377.   Writeln(Format('Curr: %d, %d "%s"', [FEdit.SelStart, FEdit.SelLength, FEdit.Text]));
  378. end;
  379.  
  380. // for Debug
  381. procedure THistory.ShowHistory;
  382. var
  383.   I: integer;
  384. begin
  385.   for i := 0 to FList.Count - 1 do
  386.   begin
  387.     with PHistoryRecord(FList[i])^ do
  388.       writeln(Format('History: %d,%d "%s" / %d,%d "%s"', [PrevSelStart, PrevSelLength,
  389.         PrevSelText, SelStart, SelLength, SelText]));
  390.   end;
  391. end;
  392.  
  393. // for Debug
  394. procedure THistory.ShowRecord;
  395. begin
  396.   with PHistoryRecord(FList[FIndex])^ do
  397.     writeln(Format('History: %d,%d "%s" / %d,%d "%s"', [PrevSelStart, PrevSelLength,
  398.       PrevSelText, SelStart, SelLength, SelText]));
  399. end;
  400.  
  401. end.

Demo is in the attachment.
« Last Edit: November 02, 2017, 07:46:49 am by tomitomy »

tomitomy

  • Full Member
  • ***
  • Posts: 133
Version 2 (support drag and drop operations):
Code: [Select]
unit1.pas is same as the version 1.
Version 2 (support drag and drop operations):
Code: Pascal  [Select]
  1. unit uhistory;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Variants, Controls, StdCtrls, Dialogs, Forms;
  9.  
  10. type
  11.   // One Undo/Redo record
  12.   PHistoryRecord = ^THistroyRecord;
  13.  
  14.   THistroyRecord = record
  15.     PrevSelStart: integer;
  16.     PrevSelLength: integer;
  17.     PrevSelText: string;
  18.  
  19.     SelStart: integer;
  20.     SelLength: integer;
  21.     SelText: string;
  22.   end;
  23.  
  24.   { THistory }
  25.  
  26.   generic THistory <T> = class
  27.   private
  28.     FEnabled: boolean;
  29.     FEdit: T;
  30.     FList: TList;             // List of Undo/Redo records
  31.     FIndex: integer;          // Index of current record
  32.     FSize: integer;           // Current history size
  33.     FMaxSize: integer;        // Maximum size limit for history
  34.     FMinCount: integer;       // Minimum count limit of records
  35.     FEditing: boolean;        // Is it not in the undo/redo state
  36.  
  37.     FPrevText: string;        // The content of the FEdit before OnChange Event
  38.     FPrevSelStart: integer;   // The SelStart of the FEdit before OnChange Event
  39.     FPrevSelLength: integer;  // The SelLength of the FEdit before OnChange Event
  40.  
  41.     FOldKeyDown: TKeyEvent;
  42.     FOldMouseDown: TMouseEvent;
  43.     FOldChange: TNotifyEvent;
  44.  
  45.     // Get the SelStart and SelLength of FEdit before the OnChange event is executed
  46.     procedure KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  47.     procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  48.  
  49.     procedure Change(Sender: TObject);
  50.  
  51.  
  52.     function GetRecordSize(PHR: PHistoryRecord): integer;
  53.     // Check if the undo operation can be executed correctly
  54.     function InvaildRecord(PHR: PHistoryRecord): boolean;
  55.     // Just use the Text, SelStart and PrevText to calculate the Record Information
  56.     procedure CalcRecord(out PHR: PHistoryRecord);
  57.     // Drag text will get wrong SelStart, use this most stupid method to calculate record information
  58.     procedure HardCalcRecord(out PHR: PHistoryRecord);
  59.  
  60.     function GetIndex: integer;
  61.     function GetCount: integer;
  62.     procedure SetEnabled(AValue: boolean);
  63.  
  64.     procedure ShowPrevText; // debug
  65.     procedure ShowCurText;  // debug
  66.     procedure ShowHistory;  // Debug
  67.     procedure ShowRecord;   // Debug
  68.   public
  69.     constructor Create(AEdit: TCustomEdit; AMaxSize: integer = 32 * 1024; AMinCount: integer = 10);
  70.     destructor Destroy; override;
  71.  
  72.     function CanUndo: boolean;
  73.     function CanRedo: boolean;
  74.     procedure Undo;
  75.     procedure Redo;
  76.  
  77.     property Index: integer read GetIndex;
  78.     property Size: integer read FSize;
  79.     property MaxSize: integer read FMaxSize;
  80.     property Count: integer read GetCount;
  81.     property MinCount: integer read FMinCount;
  82.     property Enabled: boolean read FEnabled write SetEnabled;
  83.   end;
  84.  
  85.   TEditHistory = specialize THistory<TEdit>;
  86.   TMemoHistory = specialize THistory<TMemo>;
  87.  
  88. implementation
  89.  
  90. uses
  91.   lazUTF8;
  92.  
  93. constructor THistory.Create(AEdit: TCustomEdit; AMaxSize: integer = 32 * 1024; AMinCount: integer = 10);
  94. begin
  95.   inherited Create;
  96.  
  97.   FEdit := T(AEdit);
  98.   FPrevText := FEdit.Text;
  99.   FPrevSelStart := 0;
  100.   FPrevSelLength := 0;
  101.  
  102.   FList := TList.Create;
  103.   FIndex := -1;
  104.   FSize := 0;
  105.   FMaxSize := AMaxSize;
  106.   FMinCount := AMinCount;
  107.   FEditing := True;
  108.  
  109.   FOldChange := FEdit.OnChange;
  110.   FOldKeyDown := FEdit.OnKeyDown;
  111.   FOldMouseDown := FEdit.OnMouseDown;
  112.  
  113.   FEdit.OnChange := @Change;
  114.   FEdit.OnKeyDown := @KeyDown;
  115.   FEdit.OnMouseDown := @MouseDown;
  116.  
  117.   FEnabled := True;
  118. end;
  119.  
  120. destructor THistory.Destroy;
  121. var
  122.   i: integer;
  123. begin
  124.   for i := 0 to FList.Count - 1 do
  125.     dispose(PHistoryRecord(FList[i]));
  126.  
  127.   FList.Free;
  128.  
  129.   Enabled := False;
  130.  
  131.   inherited Destroy;
  132. end;
  133.  
  134. procedure THistory.KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  135. begin
  136.   FPrevSelStart := FEdit.SelStart;
  137.   FPrevSelLength := FEdit.SelLength;
  138.  
  139.   if Assigned(FOldKeyDown) then
  140.     FOldKeyDown(Sender, Key, Shift);
  141. end;
  142.  
  143. procedure THistory.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  144. begin
  145.   FPrevSelStart := FEdit.SelStart;
  146.   FPrevSelLength := FEdit.SelLength;
  147.  
  148.   if Assigned(FOldMouseDown) then
  149.     FOldMouseDown(Sender, Button, Shift, X, Y);
  150. end;
  151.  
  152. procedure THistory.Change(Sender: TObject);
  153. var
  154.   i: integer;
  155.   PHR: PHistoryRecord;
  156.   SelStart: integer;
  157. begin
  158.   // ShowPrevText;  // debug
  159.   // ShowCurText;   // debug
  160.   SelStart := FEdit.SelStart;
  161.  
  162.   if FEditing then
  163.   begin
  164.     // Destroy the records after current record
  165.     for i := FList.Count - 1 downto FIndex + 1 do
  166.     begin
  167.       Dec(FSize, GetRecordSize(PHistoryRecord(FList[i])));
  168.       dispose(PHistoryRecord(FList[i]));
  169.       FList.Delete(i);
  170.     end;
  171.  
  172.     // Add a record
  173.     PHR := new(PHistoryRecord);
  174.     FList.Add(PHR);
  175.     Inc(FIndex);
  176.  
  177.     // Fill in the record
  178.     if SelStart < FPrevSelStart then
  179.     begin
  180.       // Backspace character
  181.       PHR^.PrevSelStart := SelStart;
  182.       PHR^.PrevSelLength := FPrevSelStart - SelStart;
  183.       PHR^.PrevSelText := UTF8Copy(FPrevText, PHR^.PrevSelStart + 1, PHR^.PrevSelLength);
  184.  
  185.       PHR^.SelStart := SelStart;
  186.       PHR^.SelLength := 0;
  187.       PHR^.SelText := '';
  188.     end
  189.     else if SelStart > FPrevSelStart then
  190.     begin
  191.       if FEdit.SelLength > 0 then  // This case only happens in GTK2
  192.       begin
  193.         {
  194.         // Add text (Paste after selecting some text)
  195.         PHR^.PrevSelStart := FPrevSelStart;
  196.         PHR^.PrevSelLength := 0;
  197.         PHR^.PrevSelText := '';
  198.  
  199.         PHR^.SelStart := FPrevSelStart;
  200.         PHR^.SelLength := SelStart - FPrevSelStart;
  201.         PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength);
  202.         }
  203.  
  204.         // Drag text also makes the code run here (GTK2)
  205.         HardCalcRecord(PHR);
  206.       end
  207.       else
  208.       begin
  209.         // Add text (Input or Paste)
  210.         PHR^.PrevSelStart := FPrevSelStart;
  211.         PHR^.PrevSelLength := 0;
  212.         PHR^.PrevSelText := '';
  213.  
  214.         PHR^.SelStart := FPrevSelStart;
  215.         PHR^.SelLength := SelStart - FPrevSelStart;
  216.         PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength);
  217.       end;
  218.     end
  219.     else
  220.     begin
  221.       // Delete a character without text selection (Just select it)
  222.       if FPrevSelLength = 0 then
  223.         FPrevSelLength := 1;
  224.       // Delete selected text
  225.       PHR^.PrevSelStart := FPrevSelStart;
  226.       PHR^.PrevSelLength := FPrevSelLength;
  227.       PHR^.PrevSelText := UTF8Copy(FPrevText, FPrevSelStart + 1, FPrevSelLength);
  228.  
  229.       PHR^.SelStart := SelStart;
  230.       PHR^.SelLength := 0;
  231.       PHR^.SelText := '';
  232.     end;
  233.  
  234.     // Safeguard: If the Record is invaild
  235.     if InvaildRecord(PHR) then
  236.     begin
  237.       // The code will run into here if FPrevSelStart and FPrevSelLength
  238.       // are not correctly obtained.
  239.       // In this case, I need to calculate the Record information here.
  240.  
  241.       // Drag text will get wrong SelStart (GTK2)
  242.       if PHR^.PrevSelStart = PHR^.SelStart then
  243.         HardCalcRecord(PHR)
  244.       else
  245.         CalcRecord(PHR);
  246.       // writeln('***** Invaild Undo Record *****');  // debug
  247.       // ShowMessage('Invaild Undo Record');  // debug
  248.     end;
  249.  
  250.     // Update history size
  251.     Inc(FSize, GetRecordSize(PHR));
  252.     // Limit history size
  253.     while (FMaxSize > 0) and (FSize > FMaxSize) and (FList.Count > FMinCount) do
  254.     begin
  255.       Dec(FSize, GetRecordSize(PHistoryRecord(FList[0])));
  256.       dispose(PHistoryRecord(FList[0]));
  257.       FList.Delete(0);
  258.       Dec(FIndex);
  259.     end;
  260.   end;
  261.  
  262.   // Save the text information for the next OnChange event
  263.   FPrevSelStart := SelStart;
  264.   FPrevSelLength := FEdit.SelLength;
  265.   FPrevText := FEdit.Text;
  266.   // ShowRecord;  // debug
  267.   // writeln('==============================');  // debug
  268.  
  269.   if Assigned(FOldChange) then
  270.     FOldChange(Sender);
  271. end;
  272.  
  273. function THistory.CanUndo: boolean;
  274. begin
  275.   Result := FIndex >= 0;
  276. end;
  277.  
  278. function THistory.CanRedo: boolean;
  279. begin
  280.   Result := FIndex < FList.Count - 1;
  281. end;
  282.  
  283. procedure THistory.Undo;
  284. var
  285.   PHR: PHistoryRecord;
  286. begin
  287.   if FIndex < 0 then Exit;
  288.  
  289.   PHR := PHistoryRecord(FList[FIndex]);
  290.  
  291.   FEditing := False;
  292.   FEdit.SelStart := PHR^.SelStart;
  293.   FEdit.SelLength := PHR^.SelLength;
  294.   FEdit.SelText := PHR^.PrevSelText;
  295.   FEditing := True;
  296.  
  297.   FPrevText := FEdit.Text;  // For the next write operation of FEdit
  298.  
  299.   Dec(FIndex);
  300. end;
  301.  
  302. procedure THistory.Redo;
  303. var
  304.   PHR: PHistoryRecord;
  305. begin
  306.   if FIndex >= FList.Count - 1 then Exit;
  307.  
  308.   Inc(FIndex);
  309.   PHR := PHistoryRecord(FList[FIndex]);
  310.  
  311.   FEditing := False;
  312.   FEdit.SelStart := PHR^.PrevSelStart;
  313.   FEdit.SelLength := PHR^.PrevSelLength;
  314.   FEdit.SelText := PHR^.SelText;
  315.   FEditing := True;
  316. end;
  317.  
  318. function THistory.InvaildRecord(PHR: PHistoryRecord): boolean;
  319. begin
  320.   Result := (Length(FEdit.Text) - PHR^.SelText.Length + PHR^.PrevSelText.Length) <> FPrevText.Length;
  321. end;
  322.  
  323. procedure THistory.CalcRecord(out PHR: PHistoryRecord);
  324. var
  325.   PrevLen, Len: integer;
  326.   Head, Tail: string;
  327. begin
  328.   Len := UTF8Length(FEdit.Text);
  329.   PrevLen := UTF8Length(FPrevText);
  330.  
  331.   if Len > PrevLen then
  332.   begin
  333.     // Add content to FEdit
  334.     Tail := UTF8Copy(FEdit.Text, FEdit.SelStart + 1, MaxInt);
  335.  
  336.     PHR^.PrevSelStart := PrevLen - UTF8Length(Tail);
  337.     PHR^.PrevSelLength := 0;
  338.     PHR^.PrevSelText := '';
  339.  
  340.     PHR^.SelStart := PHR^.PrevSelStart;
  341.     PHR^.SelLength := Len - PrevLen;
  342.     PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength);
  343.   end
  344.   else
  345.   begin
  346.     // Delet content from FEdit
  347.     Head := UTF8Copy(FEdit.Text, 1, FEdit.SelStart);
  348.  
  349.     PHR^.PrevSelStart := UTF8Length(Head);
  350.     PHR^.PrevSelLength := PrevLen - Len;
  351.     PHR^.PrevSelText := UTF8Copy(FPrevText, PHR^.PrevSelStart + 1, PHR^.PrevSelLength);
  352.  
  353.     PHR^.SelStart := PHR^.PrevSelStart;
  354.     PHR^.SelLength := 0;
  355.     PHR^.SelText := '';
  356.   end;
  357. end;
  358.  
  359. procedure THistory.HardCalcRecord(out PHR: PHistoryRecord);
  360. var
  361.   PrevLen, Len: integer;
  362.   Head: string;
  363.   i: integer;
  364. begin
  365.   Len := UTF8Length(FEdit.Text);
  366.   PrevLen := UTF8Length(FPrevText);
  367.  
  368.   if Len > PrevLen then
  369.   begin
  370.     for i := 1 to FPrevText.Length do
  371.       if FEdit.Text[i] <> FPrevText[i] then break;
  372.  
  373.     if (i = Length(FPrevText)) and (FEdit.Text[i] = FPrevText[i]) then
  374.       Inc(i);
  375.  
  376.     Head := Copy(FEdit.Text, 1, i - 1);
  377.  
  378.     PHR^.PrevSelStart := UTF8Length(Head);
  379.     PHR^.PrevSelLength := 0;
  380.     PHR^.PrevSelText := '';
  381.  
  382.     PHR^.SelStart := PHR^.PrevSelStart;
  383.     PHR^.SelLength := Len - PrevLen;
  384.     PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength);
  385.   end
  386.   else
  387.   begin
  388.     for i := 1 to Length(FEdit.Text) do
  389.       if FEdit.Text[i] <> FPrevText[i] then break;
  390.  
  391.     if (i = Length(FEdit.Text)) and (FEdit.Text[i] = FPrevText[i]) then
  392.       Inc(i);
  393.  
  394.     Head := Copy(FEdit.Text, 1, i - 1);
  395.  
  396.     PHR^.PrevSelStart := UTF8Length(Head);
  397.     PHR^.PrevSelLength := PrevLen - Len;
  398.     PHR^.PrevSelText := UTF8Copy(FPrevText, PHR^.PrevSelStart + 1, PHR^.PrevSelLength);
  399.  
  400.     PHR^.SelStart := PHR^.PrevSelStart;
  401.     PHR^.SelLength := 0;
  402.     PHR^.SelText := '';
  403.   end;
  404. end;
  405.  
  406. function THistory.GetIndex: integer;
  407. begin
  408.   Result := FIndex + 1;
  409. end;
  410.  
  411. function THistory.GetCount: integer;
  412. begin
  413.   Result := FList.Count;
  414. end;
  415.  
  416. procedure THistory.SetEnabled(AValue: boolean);
  417. begin
  418.   if FEnabled = AValue then Exit;
  419.  
  420.   FEnabled := AValue;
  421.  
  422.   if FEnabled then
  423.   begin
  424.     FEdit.OnChange := @Change;
  425.     FEdit.OnKeyDown := @KeyDown;
  426.     FEdit.OnMouseDown := @MouseDown;
  427.   end
  428.   else
  429.   begin
  430.     FEdit.OnChange := FOldChange;
  431.     FEdit.OnKeyDown := FOldKeyDown;
  432.     FEdit.OnMouseDown := FOldMouseDown;
  433.   end;
  434. end;
  435.  
  436. function THistory.GetRecordSize(PHR: PHistoryRecord): integer;
  437. begin
  438.   Result := PHR^.PrevSelText.Length + PHR^.SelText.Length + 4 * Sizeof(integer);
  439. end;
  440.  
  441. // for Debug
  442. procedure THistory.ShowPrevText;
  443. begin
  444.   Writeln(Format('Prev: %d, %d "%s"', [FPrevSelStart, FPrevSelLength, FPrevText]));
  445. end;
  446.  
  447. // for Debug
  448. procedure THistory.ShowCurText;
  449. begin
  450.   Writeln(Format('Curr: %d, %d "%s"', [FEdit.SelStart, FEdit.SelLength, FEdit.Text]));
  451. end;
  452.  
  453. // for Debug
  454. procedure THistory.ShowHistory;
  455. var
  456.   I: integer;
  457. begin
  458.   for i := 0 to FList.Count - 1 do
  459.   begin
  460.     with PHistoryRecord(FList[i])^ do
  461.       writeln(Format('History: %d,%d "%s" / %d,%d "%s"', [PrevSelStart, PrevSelLength,
  462.         PrevSelText, SelStart, SelLength, SelText]));
  463.   end;
  464. end;
  465.  
  466. // for Debug
  467. procedure THistory.ShowRecord;
  468. begin
  469.   with PHistoryRecord(FList[FIndex])^ do
  470.     writeln(Format('History: %d,%d "%s" / %d,%d "%s"', [PrevSelStart, PrevSelLength,
  471.       PrevSelText, SelStart, SelLength, SelText]));
  472. end;
  473.  
  474. end.

Demo is in the attachment.
« Last Edit: November 02, 2017, 07:45:56 am by tomitomy »

tomitomy

  • Full Member
  • ***
  • Posts: 133
TreeView multi-node Undo/Redo demo:
Code: Pascal  [Select]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls,
  9.   ExtCtrls, StdCtrls, ActnList, uhistory;
  10.  
  11. type
  12.  
  13.   PNodeData = ^TNodeData;
  14.  
  15.   TNodeData = record
  16.     History: TMemoHistory;
  17.   end;
  18.  
  19.   { TForm1 }
  20.  
  21.   TForm1 = class(TForm)
  22.     actnUndo: TAction;
  23.     actnRedo: TAction;
  24.     ActionList1: TActionList;
  25.                              
  26.     TreeView1: TTreeView;    
  27.     Splitter1: TSplitter;
  28.     Memo1: TMemo;
  29.  
  30.     ToolBar1: TToolBar;
  31.     ToolButton1: TToolButton;
  32.     ToolButton2: TToolButton;
  33.                                              
  34.     procedure FormCreate(Sender: TObject);
  35.     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
  36.  
  37.     procedure actnRedoExecute(Sender: TObject);
  38.     procedure actnRedoUpdate(Sender: TObject);
  39.  
  40.     procedure actnUndoExecute(Sender: TObject);
  41.     procedure actnUndoUpdate(Sender: TObject);
  42.  
  43.     procedure TreeView1SelectionChanged(Sender: TObject);
  44.   private
  45.     FLoading: Boolean;
  46.   public
  47.  
  48.   end;
  49.  
  50. var
  51.   Form1: TForm1;
  52.   MemoHistory: TMemoHistory;
  53.  
  54. implementation
  55.  
  56. {$R *.lfm}
  57.  
  58. { TForm1 }
  59.  
  60. procedure TForm1.FormCreate(Sender: TObject);
  61. var
  62.   i: integer;
  63.   Node: TTreeNode;
  64. begin
  65.   FLoading := True;
  66.  
  67.   for i := 1 to 5 do begin
  68.     Node := TreeView1.Items.Add(nil, 'History ' + IntToStr(i));
  69.     Node.Data := new(PNodeData);
  70.     PNodeData(Node.Data)^.History := TMemoHistory.Create(Memo1);
  71.     PNodeData(Node.Data)^.History.Enabled := False;
  72.   end;
  73.  
  74.   FLoading := False;
  75.  
  76.   if TreeView1.Items.Count > 0 then
  77.     TreeView1.Items[0].Selected := True;
  78. end;
  79.  
  80. procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);
  81. var
  82.   Node: TTreeNode;
  83. begin
  84.   for Node in TreeView1.Items do begin
  85.     PNodeData(Node.Data)^.History.Free;
  86.     dispose(PNodeData(Node.Data));
  87.   end;
  88. end;
  89.  
  90.  
  91.  
  92. procedure TForm1.actnUndoExecute(Sender: TObject);
  93. begin
  94.   if MemoHistory <> nil then MemoHistory.Undo;
  95. end;
  96.  
  97. procedure TForm1.actnUndoUpdate(Sender: TObject);
  98. begin
  99.   actnUndo.Enabled := (MemoHistory <> nil) and (MemoHistory.CanUndo);
  100. end;
  101.  
  102.  
  103.  
  104. procedure TForm1.actnRedoExecute(Sender: TObject);
  105. begin
  106.   if MemoHistory <> nil then MemoHistory.Redo;
  107. end;
  108.  
  109. procedure TForm1.actnRedoUpdate(Sender: TObject);
  110. begin
  111.   actnRedo.Enabled := (MemoHistory <> nil) and (MemoHistory.CanRedo);
  112. end;
  113.      
  114.  
  115.  
  116. procedure TForm1.TreeView1SelectionChanged(Sender: TObject);
  117. var
  118.   Node: TTreeNode;
  119. begin
  120.   Node := TreeView1.Selected;
  121.   if FLoading or (Node = nil) then Exit;
  122.  
  123.   FLoading := True;
  124.  
  125.   if (MemoHistory <> nil) then
  126.     MemoHistory.Enabled := False;
  127.   MemoHistory := PNodeData(Node.Data)^.History;
  128.   Memo1.Text := MemoHistory.PrevText;
  129.   MemoHistory.Enabled := True;
  130.  
  131.   FLoading := False;
  132. end;
  133.  
  134. end.

TreeView multi-node Undo/Redo demo:
Code: Pascal  [Select]
  1. unit uhistory;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Variants, Controls, StdCtrls, Dialogs, Forms;
  9.  
  10. type
  11.   // One Undo/Redo record
  12.   PHistoryRecord = ^THistroyRecord;
  13.  
  14.   THistroyRecord = record
  15.     PrevSelStart: integer;
  16.     PrevSelLength: integer;
  17.     PrevSelText: string;
  18.  
  19.     SelStart: integer;
  20.     SelLength: integer;
  21.     SelText: string;
  22.   end;
  23.  
  24.   { THistory }
  25.  
  26.   generic THistory <T> = class
  27.   private
  28.     FEnabled: boolean;
  29.     FEdit: T;
  30.     FList: TList;             // List of Undo/Redo records
  31.     FIndex: integer;          // Index of current record
  32.     FSize: integer;           // Current history size
  33.     FMaxSize: integer;        // Maximum size limit for history
  34.     FMinCount: integer;       // Minimum count limit of records
  35.     FEditing: boolean;        // Is it not in the undo/redo state
  36.  
  37.     FPrevText: string;        // The content of the FEdit before OnChange Event
  38.     FPrevSelStart: integer;   // The SelStart of the FEdit before OnChange Event
  39.     FPrevSelLength: integer;  // The SelLength of the FEdit before OnChange Event
  40.  
  41.     FOldKeyDown: TKeyEvent;
  42.     FOldMouseDown: TMouseEvent;
  43.     FOldChange: TNotifyEvent;
  44.  
  45.     // Get the SelStart and SelLength of FEdit before the OnChange event is executed
  46.     procedure KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  47.     procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  48.  
  49.     procedure Change(Sender: TObject);
  50.  
  51.  
  52.     function GetRecordSize(PHR: PHistoryRecord): integer;
  53.     // Check if the undo operation can be executed correctly
  54.     function InvaildRecord(PHR: PHistoryRecord): boolean;
  55.     // Just use the Text, SelStart and PrevText to calculate the Record Information
  56.     procedure CalcRecord(out PHR: PHistoryRecord);
  57.     // Drag text will get wrong SelStart, use this most stupid method to calculate record information
  58.     procedure HardCalcRecord(out PHR: PHistoryRecord);
  59.  
  60.     function GetIndex: integer;
  61.     function GetCount: integer;
  62.     procedure SetEnabled(AValue: boolean);
  63.  
  64.     procedure ShowPrevText; // debug
  65.     procedure ShowCurText;  // debug
  66.     procedure ShowHistory;  // Debug
  67.     procedure ShowRecord;   // Debug
  68.   public
  69.     constructor Create(AEdit: TCustomEdit; AMaxSize: integer = 32 * 1024; AMinCount: integer = 10);
  70.     destructor Destroy; override;
  71.  
  72.     function CanUndo: boolean;
  73.     function CanRedo: boolean;
  74.     procedure Undo;
  75.     procedure Redo;
  76.  
  77.     property Index: integer read GetIndex;
  78.     property Size: integer read FSize;
  79.     property MaxSize: integer read FMaxSize;
  80.     property Count: integer read GetCount;
  81.     property MinCount: integer read FMinCount;
  82.     property Enabled: boolean read FEnabled write SetEnabled;
  83.     property PrevText: string read FPrevText;
  84.   end;
  85.  
  86.   TEditHistory = specialize THistory<TEdit>;
  87.   TMemoHistory = specialize THistory<TMemo>;
  88.  
  89. implementation
  90.  
  91. uses
  92.   lazUTF8;
  93.  
  94. constructor THistory.Create(AEdit: TCustomEdit; AMaxSize: integer = 32 * 1024; AMinCount: integer = 10);
  95. begin
  96.   inherited Create;
  97.  
  98.   FEdit := T(AEdit);
  99.   FPrevText := FEdit.Text;
  100.   FPrevSelStart := 0;
  101.   FPrevSelLength := 0;
  102.  
  103.   FList := TList.Create;
  104.   FIndex := -1;
  105.   FSize := 0;
  106.   FMaxSize := AMaxSize;
  107.   FMinCount := AMinCount;
  108.   FEditing := True;
  109.  
  110.   FOldChange := FEdit.OnChange;
  111.   FOldKeyDown := FEdit.OnKeyDown;
  112.   FOldMouseDown := FEdit.OnMouseDown;
  113.  
  114.   FEdit.OnChange := @Change;
  115.   FEdit.OnKeyDown := @KeyDown;
  116.   FEdit.OnMouseDown := @MouseDown;
  117.  
  118.   FEnabled := True;
  119. end;
  120.  
  121. destructor THistory.Destroy;
  122. var
  123.   i: integer;
  124. begin
  125.   for i := 0 to FList.Count - 1 do
  126.     dispose(PHistoryRecord(FList[i]));
  127.  
  128.   FList.Free;
  129.  
  130.   Enabled := False;
  131.  
  132.   inherited Destroy;
  133. end;
  134.  
  135. procedure THistory.KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  136. begin
  137.   FPrevSelStart := FEdit.SelStart;
  138.   FPrevSelLength := FEdit.SelLength;
  139.  
  140.   if Assigned(FOldKeyDown) then
  141.     FOldKeyDown(Sender, Key, Shift);
  142. end;
  143.  
  144. procedure THistory.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  145. begin
  146.   FPrevSelStart := FEdit.SelStart;
  147.   FPrevSelLength := FEdit.SelLength;
  148.  
  149.   if Assigned(FOldMouseDown) then
  150.     FOldMouseDown(Sender, Button, Shift, X, Y);
  151. end;
  152.  
  153. procedure THistory.Change(Sender: TObject);
  154. var
  155.   i: integer;
  156.   PHR: PHistoryRecord;
  157.   SelStart: integer;
  158. begin
  159.   // ShowPrevText;  // debug
  160.   // ShowCurText;   // debug
  161.   SelStart := FEdit.SelStart;
  162.  
  163.   if FEditing then
  164.   begin
  165.     // Destroy the records after current record
  166.     for i := FList.Count - 1 downto FIndex + 1 do
  167.     begin
  168.       Dec(FSize, GetRecordSize(PHistoryRecord(FList[i])));
  169.       dispose(PHistoryRecord(FList[i]));
  170.       FList.Delete(i);
  171.     end;
  172.  
  173.     // Add a record
  174.     PHR := new(PHistoryRecord);
  175.     FList.Add(PHR);
  176.     Inc(FIndex);
  177.  
  178.     // Fill in the record
  179.     if SelStart < FPrevSelStart then
  180.     begin
  181.       // Backspace character
  182.       PHR^.PrevSelStart := SelStart;
  183.       PHR^.PrevSelLength := FPrevSelStart - SelStart;
  184.       PHR^.PrevSelText := UTF8Copy(FPrevText, PHR^.PrevSelStart + 1, PHR^.PrevSelLength);
  185.  
  186.       PHR^.SelStart := SelStart;
  187.       PHR^.SelLength := 0;
  188.       PHR^.SelText := '';
  189.     end
  190.     else if SelStart > FPrevSelStart then
  191.     begin
  192.       if FEdit.SelLength > 0 then  // This case only happens in GTK2
  193.       begin
  194.         {
  195.         // Add text (Paste after selecting some text)
  196.         PHR^.PrevSelStart := FPrevSelStart;
  197.         PHR^.PrevSelLength := 0;
  198.         PHR^.PrevSelText := '';
  199.  
  200.         PHR^.SelStart := FPrevSelStart;
  201.         PHR^.SelLength := SelStart - FPrevSelStart;
  202.         PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength);
  203.         }
  204.  
  205.         // Drag text also makes the code run here (GTK2)
  206.         HardCalcRecord(PHR);
  207.       end
  208.       else
  209.       begin
  210.         // Add text (Input or Paste)
  211.         PHR^.PrevSelStart := FPrevSelStart;
  212.         PHR^.PrevSelLength := 0;
  213.         PHR^.PrevSelText := '';
  214.  
  215.         PHR^.SelStart := FPrevSelStart;
  216.         PHR^.SelLength := SelStart - FPrevSelStart;
  217.         PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength);
  218.       end;
  219.     end
  220.     else
  221.     begin
  222.       // Delete a character without text selection (Just select it)
  223.       if FPrevSelLength = 0 then
  224.         FPrevSelLength := 1;
  225.       // Delete selected text
  226.       PHR^.PrevSelStart := FPrevSelStart;
  227.       PHR^.PrevSelLength := FPrevSelLength;
  228.       PHR^.PrevSelText := UTF8Copy(FPrevText, FPrevSelStart + 1, FPrevSelLength);
  229.  
  230.       PHR^.SelStart := SelStart;
  231.       PHR^.SelLength := 0;
  232.       PHR^.SelText := '';
  233.     end;
  234.  
  235.     // Safeguard: If the Record is invaild
  236.     if InvaildRecord(PHR) then
  237.     begin
  238.       // The code will run into here if FPrevSelStart and FPrevSelLength
  239.       // are not correctly obtained.
  240.       // In this case, I need to calculate the Record information here.
  241.  
  242.       // Drag text will get wrong SelStart (GTK2)
  243.       if PHR^.PrevSelStart = PHR^.SelStart then
  244.         HardCalcRecord(PHR)
  245.       else
  246.         CalcRecord(PHR);
  247.       // writeln('***** Invaild Undo Record *****');  // debug
  248.       // ShowMessage('Invaild Undo Record');  // debug
  249.     end;
  250.  
  251.     // Update history size
  252.     Inc(FSize, GetRecordSize(PHR));
  253.     // Limit history size
  254.     while (FMaxSize > 0) and (FSize > FMaxSize) and (FList.Count > FMinCount) do
  255.     begin
  256.       Dec(FSize, GetRecordSize(PHistoryRecord(FList[0])));
  257.       dispose(PHistoryRecord(FList[0]));
  258.       FList.Delete(0);
  259.       Dec(FIndex);
  260.     end;
  261.   end;
  262.  
  263.   // Save the text information for the next OnChange event
  264.   FPrevSelStart := SelStart;
  265.   FPrevSelLength := FEdit.SelLength;
  266.   FPrevText := FEdit.Text;
  267.   // ShowRecord;  // debug
  268.   // writeln('==============================');  // debug
  269.  
  270.   if Assigned(FOldChange) then
  271.     FOldChange(Sender);
  272. end;
  273.  
  274. function THistory.CanUndo: boolean;
  275. begin
  276.   Result := FIndex >= 0;
  277. end;
  278.  
  279. function THistory.CanRedo: boolean;
  280. begin
  281.   Result := FIndex < FList.Count - 1;
  282. end;
  283.  
  284. procedure THistory.Undo;
  285. var
  286.   PHR: PHistoryRecord;
  287. begin
  288.   if FIndex < 0 then Exit;
  289.  
  290.   PHR := PHistoryRecord(FList[FIndex]);
  291.  
  292.   FEditing := False;
  293.   FEdit.SelStart := PHR^.SelStart;
  294.   FEdit.SelLength := PHR^.SelLength;
  295.   FEdit.SelText := PHR^.PrevSelText;
  296.   FEditing := True;
  297.  
  298.   FPrevText := FEdit.Text;  // For the next write operation of FEdit
  299.  
  300.   Dec(FIndex);
  301. end;
  302.  
  303. procedure THistory.Redo;
  304. var
  305.   PHR: PHistoryRecord;
  306. begin
  307.   if FIndex >= FList.Count - 1 then Exit;
  308.  
  309.   Inc(FIndex);
  310.   PHR := PHistoryRecord(FList[FIndex]);
  311.  
  312.   FEditing := False;
  313.   FEdit.SelStart := PHR^.PrevSelStart;
  314.   FEdit.SelLength := PHR^.PrevSelLength;
  315.   FEdit.SelText := PHR^.SelText;
  316.   FEditing := True;
  317. end;
  318.  
  319. function THistory.InvaildRecord(PHR: PHistoryRecord): boolean;
  320. begin
  321.   Result := (Length(FEdit.Text) - PHR^.SelText.Length + PHR^.PrevSelText.Length) <> FPrevText.Length;
  322. end;
  323.  
  324. procedure THistory.CalcRecord(out PHR: PHistoryRecord);
  325. var
  326.   PrevLen, Len: integer;
  327.   Head, Tail: string;
  328. begin
  329.   Len := UTF8Length(FEdit.Text);
  330.   PrevLen := UTF8Length(FPrevText);
  331.  
  332.   if Len > PrevLen then
  333.   begin
  334.     // Add content to FEdit
  335.     Tail := UTF8Copy(FEdit.Text, FEdit.SelStart + 1, MaxInt);
  336.  
  337.     PHR^.PrevSelStart := PrevLen - UTF8Length(Tail);
  338.     PHR^.PrevSelLength := 0;
  339.     PHR^.PrevSelText := '';
  340.  
  341.     PHR^.SelStart := PHR^.PrevSelStart;
  342.     PHR^.SelLength := Len - PrevLen;
  343.     PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength);
  344.   end
  345.   else
  346.   begin
  347.     // Delet content from FEdit
  348.     Head := UTF8Copy(FEdit.Text, 1, FEdit.SelStart);
  349.  
  350.     PHR^.PrevSelStart := UTF8Length(Head);
  351.     PHR^.PrevSelLength := PrevLen - Len;
  352.     PHR^.PrevSelText := UTF8Copy(FPrevText, PHR^.PrevSelStart + 1, PHR^.PrevSelLength);
  353.  
  354.     PHR^.SelStart := PHR^.PrevSelStart;
  355.     PHR^.SelLength := 0;
  356.     PHR^.SelText := '';
  357.   end;
  358. end;
  359.  
  360. procedure THistory.HardCalcRecord(out PHR: PHistoryRecord);
  361. var
  362.   PrevLen, Len: integer;
  363.   Head: string;
  364.   i: integer;
  365. begin
  366.   Len := UTF8Length(FEdit.Text);
  367.   PrevLen := UTF8Length(FPrevText);
  368.  
  369.   if Len > PrevLen then
  370.   begin
  371.     for i := 1 to FPrevText.Length do
  372.       if FEdit.Text[i] <> FPrevText[i] then break;
  373.  
  374.     if (i = Length(FPrevText)) and (FEdit.Text[i] = FPrevText[i]) then
  375.       Inc(i);
  376.  
  377.     Head := Copy(FEdit.Text, 1, i - 1);
  378.  
  379.     PHR^.PrevSelStart := UTF8Length(Head);
  380.     PHR^.PrevSelLength := 0;
  381.     PHR^.PrevSelText := '';
  382.  
  383.     PHR^.SelStart := PHR^.PrevSelStart;
  384.     PHR^.SelLength := Len - PrevLen;
  385.     PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength);
  386.   end
  387.   else
  388.   begin
  389.     for i := 1 to Length(FEdit.Text) do
  390.       if FEdit.Text[i] <> FPrevText[i] then break;
  391.  
  392.     if (i = Length(FEdit.Text)) and (FEdit.Text[i] = FPrevText[i]) then
  393.       Inc(i);
  394.  
  395.     Head := Copy(FEdit.Text, 1, i - 1);
  396.  
  397.     PHR^.PrevSelStart := UTF8Length(Head);
  398.     PHR^.PrevSelLength := PrevLen - Len;
  399.     PHR^.PrevSelText := UTF8Copy(FPrevText, PHR^.PrevSelStart + 1, PHR^.PrevSelLength);
  400.  
  401.     PHR^.SelStart := PHR^.PrevSelStart;
  402.     PHR^.SelLength := 0;
  403.     PHR^.SelText := '';
  404.   end;
  405. end;
  406.  
  407. function THistory.GetIndex: integer;
  408. begin
  409.   Result := FIndex + 1;
  410. end;
  411.  
  412. function THistory.GetCount: integer;
  413. begin
  414.   Result := FList.Count;
  415. end;
  416.  
  417. procedure THistory.SetEnabled(AValue: boolean);
  418. begin
  419.   if FEnabled = AValue then Exit;
  420.  
  421.   FEnabled := AValue;
  422.  
  423.   if FEnabled then
  424.   begin
  425.     FEdit.OnChange := @Change;
  426.     FEdit.OnKeyDown := @KeyDown;
  427.     FEdit.OnMouseDown := @MouseDown;
  428.   end
  429.   else
  430.   begin
  431.     FEdit.OnChange := FOldChange;
  432.     FEdit.OnKeyDown := FOldKeyDown;
  433.     FEdit.OnMouseDown := FOldMouseDown;
  434.   end;
  435. end;
  436.  
  437. function THistory.GetRecordSize(PHR: PHistoryRecord): integer;
  438. begin
  439.   Result := PHR^.PrevSelText.Length + PHR^.SelText.Length + 4 * Sizeof(integer);
  440. end;
  441.  
  442. // for Debug
  443. procedure THistory.ShowPrevText;
  444. begin
  445.   Writeln(Format('Prev: %d, %d "%s"', [FPrevSelStart, FPrevSelLength, FPrevText]));
  446. end;
  447.  
  448. // for Debug
  449. procedure THistory.ShowCurText;
  450. begin
  451.   Writeln(Format('Curr: %d, %d "%s"', [FEdit.SelStart, FEdit.SelLength, FEdit.Text]));
  452. end;
  453.  
  454. // for Debug
  455. procedure THistory.ShowHistory;
  456. var
  457.   I: integer;
  458. begin
  459.   for i := 0 to FList.Count - 1 do
  460.   begin
  461.     with PHistoryRecord(FList[i])^ do
  462.       writeln(Format('History: %d,%d "%s" / %d,%d "%s"', [PrevSelStart, PrevSelLength,
  463.         PrevSelText, SelStart, SelLength, SelText]));
  464.   end;
  465. end;
  466.  
  467. // for Debug
  468. procedure THistory.ShowRecord;
  469. begin
  470.   with PHistoryRecord(FList[FIndex])^ do
  471.     writeln(Format('History: %d,%d "%s" / %d,%d "%s"', [PrevSelStart, PrevSelLength,
  472.       PrevSelText, SelStart, SelLength, SelText]));
  473. end;
  474.  
  475. end.

Demo is in the attachment.
« Last Edit: November 02, 2017, 12:41:55 pm by tomitomy »

Ñuño_Martínez

  • Hero Member
  • *****
  • Posts: 651
    • Burdjia
I thought Undo/Redo was implemented in the component itself as SynEdit does.

Thanks.

tomitomy

  • Full Member
  • ***
  • Posts: 133
I thought Undo/Redo was implemented in the component itself as SynEdit does.

Thanks.

Thank you for your reply, Ñuño_Martínez, but SynEdit couldn't input Chinese character, so I couldn't use it.

tomitomy

  • Full Member
  • ***
  • Posts: 133
Re: I implemented the undo/redo functions of TMemo, and I'm happy to share it
« Reply #5 on: November 02, 2017, 08:03:41 am »
I updated the code, which used Generic to support both TMemo and TEdit, and I also added a TreeView multi-node-history Demo.

This is the first time I use the Generic, if there is a wrong place, please help me to point it out, thanks.

Ñuño_Martínez

  • Hero Member
  • *****
  • Posts: 651
    • Burdjia
Re: I implemented the undo/redo functions of TMemo, and I'm happy to share it
« Reply #6 on: November 04, 2017, 11:18:42 am »
I thought Undo/Redo was implemented in the component itself as SynEdit does.

Thanks.

Thank you for your reply, Ñuño_Martínez, but SynEdit couldn't input Chinese character, so I couldn't use it.
I didn't know that. You're doing a great job, sir.

tomitomy

  • Full Member
  • ***
  • Posts: 133
Re: I implemented the undo/redo functions of TMemo, and I'm happy to share it
« Reply #7 on: November 04, 2017, 12:31:00 pm »
Thank you Ñuño_Martínez, I just need this feature, so I implemented it. It's not perfect, but it basically meet my needs. :)

tomitomy

  • Full Member
  • ***
  • Posts: 133
Re: I implemented the undo/redo functions of TMemo, and I'm happy to share it
« Reply #8 on: November 14, 2017, 05:00:02 pm »
This version(In the attachment) should be the best version at the moment, with support for drag and drop, support for TEdit and Tmemo.

Because of my poor English, I used Chinese comments in the code to describe my ideas more accurately.

If you need to use my code, I suggest you download this version, it is better than all previous versions, and the code is clearer, and solved the problem of "undo twice".

I tested on both Windows and GTK2 and worked fine.


tomitomy

  • Full Member
  • ***
  • Posts: 133
Re: I implemented the undo/redo functions of TMemo, and I'm happy to share it
« Reply #9 on: November 14, 2017, 05:03:00 pm »
Your file is too large. The maximum attachment size allowed is 250 KB. :D

Connect to the previous post.

tomitomy

  • Full Member
  • ***
  • Posts: 133
Re: I implemented the undo/redo functions of TMemo, and I'm happy to share it
« Reply #10 on: November 18, 2017, 02:31:33 am »
Now you can drag the text from other controls to TMemo or TEdit, and all the drag and drop problems are solved.


 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus