Forum > LCL
I implemented the undo/redo functions of TMemo, and I'm happy to share it
tomitomy:
Please visit the new version through the link bollow(support undo by word):
https://forum.lazarus.freepascal.org/index.php/topic,54069.0.html
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 [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, ActnList, uhistory; type { TForm1 } TForm1 = class(TForm) Edit1: TEdit; Memo1: TMemo; Button1: TButton; Button2: TButton; ActionList1: TActionList; Action1: TAction; Action2: TAction; procedure Edit1Change(Sender: TObject); procedure FormCreate(Sender: TObject); procedure Action1Execute(Sender: TObject); procedure Action2Execute(Sender: TObject); procedure Memo1Change(Sender: TObject); private EditHistory: TEditHistory; MemoHistory: TMemoHistory; public end; var Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin // The default maximum capacity of MemoHistory is 32K // The default minimum count of MemoHistory is 10 EditHistory := TEditHistory.Create(Edit1); MemoHistory := TMemoHistory.Create(Memo1);end; procedure TForm1.Action1Execute(Sender: TObject);begin if ActiveControl = Edit1 then EditHistory.Undo else if ActiveControl = Memo1 then MemoHistory.Undo;end; procedure TForm1.Action2Execute(Sender: TObject);begin if ActiveControl = Edit1 then EditHistory.Redo else if ActiveControl = Memo1 then MemoHistory.Redo;end; procedure TForm1.Edit1Change(Sender: TObject);begin Caption := Format('Index:%d Count:%d/%d Size:%d/%d', [EditHistory.Index, EditHistory.Count, EditHistory.MinCount, EditHistory.Size, EditHistory.MaxSize])end; procedure TForm1.Memo1Change(Sender: TObject);begin Caption := Format('Index:%d Count:%d/%d Size:%d/%d', [MemoHistory.Index, MemoHistory.Count, MemoHistory.MinCount, MemoHistory.Size, MemoHistory.MaxSize]);end; end.
Version 1 (does not support drag and drop operations):
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit uhistory; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Variants, Controls, StdCtrls, Dialogs, Forms; type // One Undo/Redo record PHistoryRecord = ^THistroyRecord; THistroyRecord = record PrevSelStart: integer; PrevSelLength: integer; PrevSelText: string; SelStart: integer; SelLength: integer; SelText: string; end; { THistory } generic THistory <T> = class private FEnabled: boolean; FEdit: T; FList: TList; // List of Undo/Redo records FIndex: integer; // Index of current record FSize: integer; // Current history size FMaxSize: integer; // Maximum size limit for history FMinCount: integer; // Minimum count limit of records FEditing: boolean; // Is it not in the undo/redo state FPrevText: string; // The content of the FEdit before OnChange Event FPrevSelStart: integer; // The SelStart of the FEdit before OnChange Event FPrevSelLength: integer; // The SelLength of the FEdit before OnChange Event FOldKeyDown: TKeyEvent; FOldMouseDown: TMouseEvent; FOldChange: TNotifyEvent; // Get the SelStart and SelLength of FEdit before the OnChange event is executed procedure KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Change(Sender: TObject); function GetRecordSize(PHR: PHistoryRecord): integer; // Check if the undo operation can be executed correctly function InvaildRecord(PHR: PHistoryRecord): boolean; // Just use the Text, SelStart and PrevText to calculate the Record Information procedure CalcRecord(out PHR: PHistoryRecord); function GetIndex: integer; function GetCount: integer;
tomitomy:
Version 2 (support drag and drop operations):
--- Code: ---unit1.pas is same as the version 1.
--- End code ---
Version 2 (support drag and drop operations):
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit uhistory; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Variants, Controls, StdCtrls, Dialogs, Forms; type // One Undo/Redo record PHistoryRecord = ^THistroyRecord; THistroyRecord = record PrevSelStart: integer; PrevSelLength: integer; PrevSelText: string; SelStart: integer; SelLength: integer; SelText: string; end; { THistory } generic THistory <T> = class private FEnabled: boolean; FEdit: T; FList: TList; // List of Undo/Redo records FIndex: integer; // Index of current record FSize: integer; // Current history size FMaxSize: integer; // Maximum size limit for history FMinCount: integer; // Minimum count limit of records FEditing: boolean; // Is it not in the undo/redo state FPrevText: string; // The content of the FEdit before OnChange Event FPrevSelStart: integer; // The SelStart of the FEdit before OnChange Event FPrevSelLength: integer; // The SelLength of the FEdit before OnChange Event FOldKeyDown: TKeyEvent; FOldMouseDown: TMouseEvent; FOldChange: TNotifyEvent; // Get the SelStart and SelLength of FEdit before the OnChange event is executed procedure KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Change(Sender: TObject); function GetRecordSize(PHR: PHistoryRecord): integer; // Check if the undo operation can be executed correctly function InvaildRecord(PHR: PHistoryRecord): boolean; // Just use the Text, SelStart and PrevText to calculate the Record Information procedure CalcRecord(out PHR: PHistoryRecord); // Drag text will get wrong SelStart, use this most stupid method to calculate record information procedure HardCalcRecord(out PHR: PHistoryRecord); function GetIndex: integer; function GetCount: integer; procedure SetEnabled(AValue: boolean); procedure ShowPrevText; // debug procedure ShowCurText; // debug procedure ShowHistory; // Debug procedure ShowRecord; // Debug public constructor Create(AEdit: TCustomEdit; AMaxSize: integer = 32 * 1024; AMinCount: integer = 10); destructor Destroy; override; function CanUndo: boolean; function CanRedo: boolean; procedure Undo; procedure Redo; property Index: integer read GetIndex; property Size: integer read FSize; property MaxSize: integer read FMaxSize; property Count: integer read GetCount; property MinCount: integer read FMinCount; property Enabled: boolean read FEnabled write SetEnabled; end; TEditHistory = specialize THistory<TEdit>; TMemoHistory = specialize THistory<TMemo>; implementation uses lazUTF8; constructor THistory.Create(AEdit: TCustomEdit; AMaxSize: integer = 32 * 1024; AMinCount: integer = 10);begin inherited Create; FEdit := T(AEdit); FPrevText := FEdit.Text; FPrevSelStart := 0; FPrevSelLength := 0; FList := TList.Create; FIndex := -1; FSize := 0; FMaxSize := AMaxSize; FMinCount := AMinCount; FEditing := True; FOldChange := FEdit.OnChange; FOldKeyDown := FEdit.OnKeyDown; FOldMouseDown := FEdit.OnMouseDown; FEdit.OnChange := @Change; FEdit.OnKeyDown := @KeyDown; FEdit.OnMouseDown := @MouseDown; FEnabled := True;end; destructor THistory.Destroy;var i: integer;begin for i := 0 to FList.Count - 1 do dispose(PHistoryRecord(FList[i])); FList.Free; Enabled := False; inherited Destroy;end; procedure THistory.KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);begin FPrevSelStart := FEdit.SelStart; FPrevSelLength := FEdit.SelLength; if Assigned(FOldKeyDown) then FOldKeyDown(Sender, Key, Shift);end; procedure THistory.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin FPrevSelStart := FEdit.SelStart; FPrevSelLength := FEdit.SelLength; if Assigned(FOldMouseDown) then FOldMouseDown(Sender, Button, Shift, X, Y);end; procedure THistory.Change(Sender: TObject);var i: integer; PHR: PHistoryRecord; SelStart: integer;begin // ShowPrevText; // debug // ShowCurText; // debug SelStart := FEdit.SelStart; if FEditing then begin // Destroy the records after current record for i := FList.Count - 1 downto FIndex + 1 do begin Dec(FSize, GetRecordSize(PHistoryRecord(FList[i]))); dispose(PHistoryRecord(FList[i])); FList.Delete(i); end; // Add a record PHR := new(PHistoryRecord); FList.Add(PHR); Inc(FIndex); // Fill in the record if SelStart < FPrevSelStart then begin // Backspace character PHR^.PrevSelStart := SelStart; PHR^.PrevSelLength := FPrevSelStart - SelStart; PHR^.PrevSelText := UTF8Copy(FPrevText, PHR^.PrevSelStart + 1, PHR^.PrevSelLength); PHR^.SelStart := SelStart; PHR^.SelLength := 0; PHR^.SelText := ''; end else if SelStart > FPrevSelStart then begin if FEdit.SelLength > 0 then // This case only happens in GTK2 begin { // Add text (Paste after selecting some text) PHR^.PrevSelStart := FPrevSelStart; PHR^.PrevSelLength := 0; PHR^.PrevSelText := ''; PHR^.SelStart := FPrevSelStart; PHR^.SelLength := SelStart - FPrevSelStart; PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength); } // Drag text also makes the code run here (GTK2) HardCalcRecord(PHR); end else begin // Add text (Input or Paste) PHR^.PrevSelStart := FPrevSelStart; PHR^.PrevSelLength := 0; PHR^.PrevSelText := ''; PHR^.SelStart := FPrevSelStart; PHR^.SelLength := SelStart - FPrevSelStart; PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength); end; end else begin // Delete a character without text selection (Just select it) if FPrevSelLength = 0 then FPrevSelLength := 1; // Delete selected text PHR^.PrevSelStart := FPrevSelStart; PHR^.PrevSelLength := FPrevSelLength; PHR^.PrevSelText := UTF8Copy(FPrevText, FPrevSelStart + 1, FPrevSelLength); PHR^.SelStart := SelStart; PHR^.SelLength := 0; PHR^.SelText := ''; end; // Safeguard: If the Record is invaild if InvaildRecord(PHR) then begin // The code will run into here if FPrevSelStart and FPrevSelLength // are not correctly obtained. // In this case, I need to calculate the Record information here. // Drag text will get wrong SelStart (GTK2) if PHR^.PrevSelStart = PHR^.SelStart then HardCalcRecord(PHR) else CalcRecord(PHR); // writeln('***** Invaild Undo Record *****'); // debug // ShowMessage('Invaild Undo Record'); // debug end; // Update history size Inc(FSize, GetRecordSize(PHR)); // Limit history size while (FMaxSize > 0) and (FSize > FMaxSize) and (FList.Count > FMinCount) do begin Dec(FSize, GetRecordSize(PHistoryRecord(FList[0]))); dispose(PHistoryRecord(FList[0])); FList.Delete(0); Dec(FIndex); end; end; // Save the text information for the next OnChange event FPrevSelStart := SelStart; FPrevSelLength := FEdit.SelLength; FPrevText := FEdit.Text; // ShowRecord; // debug // writeln('=============================='); // debug if Assigned(FOldChange) then FOldChange(Sender);end; function THistory.CanUndo: boolean;begin Result := FIndex >= 0;end; function THistory.CanRedo: boolean;begin Result := FIndex < FList.Count - 1;end; procedure THistory.Undo;var PHR: PHistoryRecord;begin if FIndex < 0 then Exit; PHR := PHistoryRecord(FList[FIndex]); FEditing := False; FEdit.SelStart := PHR^.SelStart; FEdit.SelLength := PHR^.SelLength; FEdit.SelText := PHR^.PrevSelText; FEditing := True; FPrevText := FEdit.Text; // For the next write operation of FEdit Dec(FIndex);end; procedure THistory.Redo;var PHR: PHistoryRecord;begin if FIndex >= FList.Count - 1 then Exit; Inc(FIndex); PHR := PHistoryRecord(FList[FIndex]); FEditing := False; FEdit.SelStart := PHR^.PrevSelStart; FEdit.SelLength := PHR^.PrevSelLength; FEdit.SelText := PHR^.SelText; FEditing := True;end; function THistory.InvaildRecord(PHR: PHistoryRecord): boolean;begin Result := (Length(FEdit.Text) - PHR^.SelText.Length + PHR^.PrevSelText.Length) <> FPrevText.Length;end; procedure THistory.CalcRecord(out PHR: PHistoryRecord);var PrevLen, Len: integer; Head, Tail: string;begin Len := UTF8Length(FEdit.Text); PrevLen := UTF8Length(FPrevText); if Len > PrevLen then begin // Add content to FEdit Tail := UTF8Copy(FEdit.Text, FEdit.SelStart + 1, MaxInt); PHR^.PrevSelStart := PrevLen - UTF8Length(Tail); PHR^.PrevSelLength := 0; PHR^.PrevSelText := ''; PHR^.SelStart := PHR^.PrevSelStart; PHR^.SelLength := Len - PrevLen; PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength); end else begin // Delet content from FEdit Head := UTF8Copy(FEdit.Text, 1, FEdit.SelStart); PHR^.PrevSelStart := UTF8Length(Head); PHR^.PrevSelLength := PrevLen - Len; PHR^.PrevSelText := UTF8Copy(FPrevText, PHR^.PrevSelStart + 1, PHR^.PrevSelLength); PHR^.SelStart := PHR^.PrevSelStart; PHR^.SelLength := 0; PHR^.SelText := ''; end;end; procedure THistory.HardCalcRecord(out PHR: PHistoryRecord);var PrevLen, Len: integer; Head: string; i: integer;begin Len := UTF8Length(FEdit.Text); PrevLen := UTF8Length(FPrevText); if Len > PrevLen then begin for i := 1 to FPrevText.Length do if FEdit.Text[i] <> FPrevText[i] then break; if (i = Length(FPrevText)) and (FEdit.Text[i] = FPrevText[i]) then Inc(i); Head := Copy(FEdit.Text, 1, i - 1); PHR^.PrevSelStart := UTF8Length(Head); PHR^.PrevSelLength := 0; PHR^.PrevSelText := ''; PHR^.SelStart := PHR^.PrevSelStart; PHR^.SelLength := Len - PrevLen; PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength); end else begin for i := 1 to Length(FEdit.Text) do if FEdit.Text[i] <> FPrevText[i] then break; if (i = Length(FEdit.Text)) and (FEdit.Text[i] = FPrevText[i]) then Inc(i); Head := Copy(FEdit.Text, 1, i - 1); PHR^.PrevSelStart := UTF8Length(Head); PHR^.PrevSelLength := PrevLen - Len; PHR^.PrevSelText := UTF8Copy(FPrevText, PHR^.PrevSelStart + 1, PHR^.PrevSelLength); PHR^.SelStart := PHR^.PrevSelStart; PHR^.SelLength := 0; PHR^.SelText := ''; end;end; function THistory.GetIndex: integer;begin Result := FIndex + 1;end; function THistory.GetCount: integer;begin Result := FList.Count;end; procedure THistory.SetEnabled(AValue: boolean);begin if FEnabled = AValue then Exit; FEnabled := AValue; if FEnabled then begin FEdit.OnChange := @Change; FEdit.OnKeyDown := @KeyDown; FEdit.OnMouseDown := @MouseDown; end else begin FEdit.OnChange := FOldChange; FEdit.OnKeyDown := FOldKeyDown; FEdit.OnMouseDown := FOldMouseDown; end;end; function THistory.GetRecordSize(PHR: PHistoryRecord): integer;begin Result := PHR^.PrevSelText.Length + PHR^.SelText.Length + 4 * Sizeof(integer);end; // for Debugprocedure THistory.ShowPrevText;begin Writeln(Format('Prev: %d, %d "%s"', [FPrevSelStart, FPrevSelLength, FPrevText]));end; // for Debugprocedure THistory.ShowCurText;begin Writeln(Format('Curr: %d, %d "%s"', [FEdit.SelStart, FEdit.SelLength, FEdit.Text]));end; // for Debugprocedure THistory.ShowHistory;var I: integer;begin for i := 0 to FList.Count - 1 do begin with PHistoryRecord(FList[i])^ do writeln(Format('History: %d,%d "%s" / %d,%d "%s"', [PrevSelStart, PrevSelLength, PrevSelText, SelStart, SelLength, SelText])); end;end; // for Debugprocedure THistory.ShowRecord;begin with PHistoryRecord(FList[FIndex])^ do writeln(Format('History: %d,%d "%s" / %d,%d "%s"', [PrevSelStart, PrevSelLength, PrevSelText, SelStart, SelLength, SelText]));end; end.
Demo is in the attachment.
tomitomy:
TreeView multi-node Undo/Redo demo:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ComCtrls, ExtCtrls, StdCtrls, ActnList, uhistory; type PNodeData = ^TNodeData; TNodeData = record History: TMemoHistory; end; { TForm1 } TForm1 = class(TForm) actnUndo: TAction; actnRedo: TAction; ActionList1: TActionList; TreeView1: TTreeView; Splitter1: TSplitter; Memo1: TMemo; ToolBar1: TToolBar; ToolButton1: TToolButton; ToolButton2: TToolButton; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure actnRedoExecute(Sender: TObject); procedure actnRedoUpdate(Sender: TObject); procedure actnUndoExecute(Sender: TObject); procedure actnUndoUpdate(Sender: TObject); procedure TreeView1SelectionChanged(Sender: TObject); private FLoading: Boolean; public end; var Form1: TForm1; MemoHistory: TMemoHistory; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);var i: integer; Node: TTreeNode;begin FLoading := True; for i := 1 to 5 do begin Node := TreeView1.Items.Add(nil, 'History ' + IntToStr(i)); Node.Data := new(PNodeData); PNodeData(Node.Data)^.History := TMemoHistory.Create(Memo1); PNodeData(Node.Data)^.History.Enabled := False; end; FLoading := False; if TreeView1.Items.Count > 0 then TreeView1.Items[0].Selected := True;end; procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);var Node: TTreeNode;begin for Node in TreeView1.Items do begin PNodeData(Node.Data)^.History.Free; dispose(PNodeData(Node.Data)); end;end; procedure TForm1.actnUndoExecute(Sender: TObject);begin if MemoHistory <> nil then MemoHistory.Undo;end; procedure TForm1.actnUndoUpdate(Sender: TObject);begin actnUndo.Enabled := (MemoHistory <> nil) and (MemoHistory.CanUndo);end; procedure TForm1.actnRedoExecute(Sender: TObject);begin if MemoHistory <> nil then MemoHistory.Redo;end; procedure TForm1.actnRedoUpdate(Sender: TObject);begin actnRedo.Enabled := (MemoHistory <> nil) and (MemoHistory.CanRedo);end; procedure TForm1.TreeView1SelectionChanged(Sender: TObject);var Node: TTreeNode;begin Node := TreeView1.Selected; if FLoading or (Node = nil) then Exit; FLoading := True; if (MemoHistory <> nil) then MemoHistory.Enabled := False; MemoHistory := PNodeData(Node.Data)^.History; Memo1.Text := MemoHistory.PrevText; MemoHistory.Enabled := True; FLoading := False;end; end.
TreeView multi-node Undo/Redo demo:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit uhistory; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Variants, Controls, StdCtrls, Dialogs, Forms; type // One Undo/Redo record PHistoryRecord = ^THistroyRecord; THistroyRecord = record PrevSelStart: integer; PrevSelLength: integer; PrevSelText: string; SelStart: integer; SelLength: integer; SelText: string; end; { THistory } generic THistory <T> = class private FEnabled: boolean; FEdit: T; FList: TList; // List of Undo/Redo records FIndex: integer; // Index of current record FSize: integer; // Current history size FMaxSize: integer; // Maximum size limit for history FMinCount: integer; // Minimum count limit of records FEditing: boolean; // Is it not in the undo/redo state FPrevText: string; // The content of the FEdit before OnChange Event FPrevSelStart: integer; // The SelStart of the FEdit before OnChange Event FPrevSelLength: integer; // The SelLength of the FEdit before OnChange Event FOldKeyDown: TKeyEvent; FOldMouseDown: TMouseEvent; FOldChange: TNotifyEvent; // Get the SelStart and SelLength of FEdit before the OnChange event is executed procedure KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Change(Sender: TObject); function GetRecordSize(PHR: PHistoryRecord): integer; // Check if the undo operation can be executed correctly function InvaildRecord(PHR: PHistoryRecord): boolean; // Just use the Text, SelStart and PrevText to calculate the Record Information procedure CalcRecord(out PHR: PHistoryRecord); // Drag text will get wrong SelStart, use this most stupid method to calculate record information procedure HardCalcRecord(out PHR: PHistoryRecord); function GetIndex: integer; function GetCount: integer; procedure SetEnabled(AValue: boolean); procedure ShowPrevText; // debug procedure ShowCurText; // debug procedure ShowHistory; // Debug procedure ShowRecord; // Debug public constructor Create(AEdit: TCustomEdit; AMaxSize: integer = 32 * 1024; AMinCount: integer = 10); destructor Destroy; override; function CanUndo: boolean; function CanRedo: boolean; procedure Undo; procedure Redo; property Index: integer read GetIndex; property Size: integer read FSize; property MaxSize: integer read FMaxSize; property Count: integer read GetCount; property MinCount: integer read FMinCount; property Enabled: boolean read FEnabled write SetEnabled; property PrevText: string read FPrevText; end; TEditHistory = specialize THistory<TEdit>; TMemoHistory = specialize THistory<TMemo>; implementation uses lazUTF8; constructor THistory.Create(AEdit: TCustomEdit; AMaxSize: integer = 32 * 1024; AMinCount: integer = 10);begin inherited Create; FEdit := T(AEdit); FPrevText := FEdit.Text; FPrevSelStart := 0; FPrevSelLength := 0; FList := TList.Create; FIndex := -1; FSize := 0; FMaxSize := AMaxSize; FMinCount := AMinCount; FEditing := True; FOldChange := FEdit.OnChange; FOldKeyDown := FEdit.OnKeyDown; FOldMouseDown := FEdit.OnMouseDown; FEdit.OnChange := @Change; FEdit.OnKeyDown := @KeyDown; FEdit.OnMouseDown := @MouseDown; FEnabled := True;end; destructor THistory.Destroy;var i: integer;begin for i := 0 to FList.Count - 1 do dispose(PHistoryRecord(FList[i])); FList.Free; Enabled := False; inherited Destroy;end; procedure THistory.KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);begin FPrevSelStart := FEdit.SelStart; FPrevSelLength := FEdit.SelLength; if Assigned(FOldKeyDown) then FOldKeyDown(Sender, Key, Shift);end; procedure THistory.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);begin FPrevSelStart := FEdit.SelStart; FPrevSelLength := FEdit.SelLength; if Assigned(FOldMouseDown) then FOldMouseDown(Sender, Button, Shift, X, Y);end; procedure THistory.Change(Sender: TObject);var i: integer; PHR: PHistoryRecord; SelStart: integer;begin // ShowPrevText; // debug // ShowCurText; // debug SelStart := FEdit.SelStart; if FEditing then begin // Destroy the records after current record for i := FList.Count - 1 downto FIndex + 1 do begin Dec(FSize, GetRecordSize(PHistoryRecord(FList[i]))); dispose(PHistoryRecord(FList[i])); FList.Delete(i); end; // Add a record PHR := new(PHistoryRecord); FList.Add(PHR); Inc(FIndex); // Fill in the record if SelStart < FPrevSelStart then begin // Backspace character PHR^.PrevSelStart := SelStart; PHR^.PrevSelLength := FPrevSelStart - SelStart; PHR^.PrevSelText := UTF8Copy(FPrevText, PHR^.PrevSelStart + 1, PHR^.PrevSelLength); PHR^.SelStart := SelStart; PHR^.SelLength := 0; PHR^.SelText := ''; end else if SelStart > FPrevSelStart then begin if FEdit.SelLength > 0 then // This case only happens in GTK2 begin { // Add text (Paste after selecting some text) PHR^.PrevSelStart := FPrevSelStart; PHR^.PrevSelLength := 0; PHR^.PrevSelText := ''; PHR^.SelStart := FPrevSelStart; PHR^.SelLength := SelStart - FPrevSelStart; PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength); } // Drag text also makes the code run here (GTK2) HardCalcRecord(PHR); end else begin // Add text (Input or Paste) PHR^.PrevSelStart := FPrevSelStart; PHR^.PrevSelLength := 0; PHR^.PrevSelText := ''; PHR^.SelStart := FPrevSelStart; PHR^.SelLength := SelStart - FPrevSelStart; PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength); end; end else begin // Delete a character without text selection (Just select it) if FPrevSelLength = 0 then FPrevSelLength := 1; // Delete selected text PHR^.PrevSelStart := FPrevSelStart; PHR^.PrevSelLength := FPrevSelLength; PHR^.PrevSelText := UTF8Copy(FPrevText, FPrevSelStart + 1, FPrevSelLength); PHR^.SelStart := SelStart; PHR^.SelLength := 0; PHR^.SelText := ''; end; // Safeguard: If the Record is invaild if InvaildRecord(PHR) then begin // The code will run into here if FPrevSelStart and FPrevSelLength // are not correctly obtained. // In this case, I need to calculate the Record information here. // Drag text will get wrong SelStart (GTK2) if PHR^.PrevSelStart = PHR^.SelStart then HardCalcRecord(PHR) else CalcRecord(PHR); // writeln('***** Invaild Undo Record *****'); // debug // ShowMessage('Invaild Undo Record'); // debug end; // Update history size Inc(FSize, GetRecordSize(PHR)); // Limit history size while (FMaxSize > 0) and (FSize > FMaxSize) and (FList.Count > FMinCount) do begin Dec(FSize, GetRecordSize(PHistoryRecord(FList[0]))); dispose(PHistoryRecord(FList[0])); FList.Delete(0); Dec(FIndex); end; end; // Save the text information for the next OnChange event FPrevSelStart := SelStart; FPrevSelLength := FEdit.SelLength; FPrevText := FEdit.Text; // ShowRecord; // debug // writeln('=============================='); // debug if Assigned(FOldChange) then FOldChange(Sender);end; function THistory.CanUndo: boolean;begin Result := FIndex >= 0;end; function THistory.CanRedo: boolean;begin Result := FIndex < FList.Count - 1;end; procedure THistory.Undo;var PHR: PHistoryRecord;begin if FIndex < 0 then Exit; PHR := PHistoryRecord(FList[FIndex]); FEditing := False; FEdit.SelStart := PHR^.SelStart; FEdit.SelLength := PHR^.SelLength; FEdit.SelText := PHR^.PrevSelText; FEditing := True; FPrevText := FEdit.Text; // For the next write operation of FEdit Dec(FIndex);end; procedure THistory.Redo;var PHR: PHistoryRecord;begin if FIndex >= FList.Count - 1 then Exit; Inc(FIndex); PHR := PHistoryRecord(FList[FIndex]); FEditing := False; FEdit.SelStart := PHR^.PrevSelStart; FEdit.SelLength := PHR^.PrevSelLength; FEdit.SelText := PHR^.SelText; FEditing := True;end; function THistory.InvaildRecord(PHR: PHistoryRecord): boolean;begin Result := (Length(FEdit.Text) - PHR^.SelText.Length + PHR^.PrevSelText.Length) <> FPrevText.Length;end; procedure THistory.CalcRecord(out PHR: PHistoryRecord);var PrevLen, Len: integer; Head, Tail: string;begin Len := UTF8Length(FEdit.Text); PrevLen := UTF8Length(FPrevText); if Len > PrevLen then begin // Add content to FEdit Tail := UTF8Copy(FEdit.Text, FEdit.SelStart + 1, MaxInt); PHR^.PrevSelStart := PrevLen - UTF8Length(Tail); PHR^.PrevSelLength := 0; PHR^.PrevSelText := ''; PHR^.SelStart := PHR^.PrevSelStart; PHR^.SelLength := Len - PrevLen; PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength); end else begin // Delet content from FEdit Head := UTF8Copy(FEdit.Text, 1, FEdit.SelStart); PHR^.PrevSelStart := UTF8Length(Head); PHR^.PrevSelLength := PrevLen - Len; PHR^.PrevSelText := UTF8Copy(FPrevText, PHR^.PrevSelStart + 1, PHR^.PrevSelLength); PHR^.SelStart := PHR^.PrevSelStart; PHR^.SelLength := 0; PHR^.SelText := ''; end;end; procedure THistory.HardCalcRecord(out PHR: PHistoryRecord);var PrevLen, Len: integer; Head: string; i: integer;begin Len := UTF8Length(FEdit.Text); PrevLen := UTF8Length(FPrevText); if Len > PrevLen then begin for i := 1 to FPrevText.Length do if FEdit.Text[i] <> FPrevText[i] then break; if (i = Length(FPrevText)) and (FEdit.Text[i] = FPrevText[i]) then Inc(i); Head := Copy(FEdit.Text, 1, i - 1); PHR^.PrevSelStart := UTF8Length(Head); PHR^.PrevSelLength := 0; PHR^.PrevSelText := ''; PHR^.SelStart := PHR^.PrevSelStart; PHR^.SelLength := Len - PrevLen; PHR^.SelText := UTF8Copy(FEdit.Text, PHR^.SelStart + 1, PHR^.SelLength); end else begin for i := 1 to Length(FEdit.Text) do if FEdit.Text[i] <> FPrevText[i] then break; if (i = Length(FEdit.Text)) and (FEdit.Text[i] = FPrevText[i]) then Inc(i); Head := Copy(FEdit.Text, 1, i - 1); PHR^.PrevSelStart := UTF8Length(Head); PHR^.PrevSelLength := PrevLen - Len; PHR^.PrevSelText := UTF8Copy(FPrevText, PHR^.PrevSelStart + 1, PHR^.PrevSelLength); PHR^.SelStart := PHR^.PrevSelStart; PHR^.SelLength := 0; PHR^.SelText := ''; end;end; function THistory.GetIndex: integer;begin Result := FIndex + 1;end; function THistory.GetCount: integer;begin Result := FList.Count;end; procedure THistory.SetEnabled(AValue: boolean);begin if FEnabled = AValue then Exit; FEnabled := AValue; if FEnabled then begin FEdit.OnChange := @Change; FEdit.OnKeyDown := @KeyDown; FEdit.OnMouseDown := @MouseDown; end else begin FEdit.OnChange := FOldChange; FEdit.OnKeyDown := FOldKeyDown; FEdit.OnMouseDown := FOldMouseDown; end;end; function THistory.GetRecordSize(PHR: PHistoryRecord): integer;begin Result := PHR^.PrevSelText.Length + PHR^.SelText.Length + 4 * Sizeof(integer);end; // for Debugprocedure THistory.ShowPrevText;begin Writeln(Format('Prev: %d, %d "%s"', [FPrevSelStart, FPrevSelLength, FPrevText]));end; // for Debugprocedure THistory.ShowCurText;begin Writeln(Format('Curr: %d, %d "%s"', [FEdit.SelStart, FEdit.SelLength, FEdit.Text]));end; // for Debugprocedure THistory.ShowHistory;var I: integer;begin for i := 0 to FList.Count - 1 do begin with PHistoryRecord(FList[i])^ do writeln(Format('History: %d,%d "%s" / %d,%d "%s"', [PrevSelStart, PrevSelLength, PrevSelText, SelStart, SelLength, SelText])); end;end; // for Debugprocedure THistory.ShowRecord;begin with PHistoryRecord(FList[FIndex])^ do writeln(Format('History: %d,%d "%s" / %d,%d "%s"', [PrevSelStart, PrevSelLength, PrevSelText, SelStart, SelLength, SelText]));end; end.
Demo is in the attachment.
Ñuño_Martínez:
I thought Undo/Redo was implemented in the component itself as SynEdit does.
Thanks.
tomitomy:
--- Quote from: Ñuño_Martínez on October 31, 2017, 02:03:26 pm ---I thought Undo/Redo was implemented in the component itself as SynEdit does.
Thanks.
--- End quote ---
Thank you for your reply, Ñuño_Martínez, but SynEdit couldn't input Chinese character, so I couldn't use it.
Navigation
[0] Message Index
[#] Next page