Undo DELETE を圧縮して効率化

diff --git a/Undo.pas b/Undo.pas
index e84ab80..e941977 100644 (file)
--- a/Undo.pas
+++ b/Undo.pas
@@ -52,6 +52,8 @@ type
     FReStack: TObjectStack;
     FMemo: TCustomMemo;
     FCnt: integer;
+    FBack: integer;
+    FDel: integer;
     function GetCanUndo: Boolean;
     procedure Clear;
     procedure DelRedoStack;
@@ -67,7 +69,11 @@ type
     procedure ReDo;
     destructor Destroy; override;
     procedure UpCount;
+    procedure UpDelCnt;
+    procedure UpBackCnt;
     procedure ResetCnt;
+    procedure ResetDel;
+    procedure ResetBack;
   published
     property Memo: TCustomMemo read FMemo write SetMemo;
     property CanUndo: Boolean read GetCanUndo;
@@ -99,13 +105,44 @@ procedure TUndoClass.Deleted(const str: string; pos: integer; top: Boolean);
 var
   obj: TUnDelete;
 begin
+  if str = '' then
+    Exit;
   DelRedoStack;
-  obj := TUnDelete.Create;
-  obj.FStr := str;
-  obj.FPos := pos;
-  obj.FTop := top;
-  obj.FMemo := FMemo;
-  FStack.Push(obj);
+  if ((FBack > 0) or (FDel > 0)) and (FStack.Peek is TUnDelete) and
+    (Length(str) = 1) then
+  begin
+    obj := FStack.Peek as TUnDelete;
+    if top = obj.FTop then
+    begin
+      if top = true then
+      begin
+        obj.FStr := obj.FStr + str;
+        obj.FPos := obj.FPos;
+      end
+      else
+      begin
+        obj.FStr := str + obj.FStr;
+        obj.FPos := obj.FPos-1;
+      end;
+    end
+    else
+    begin
+      FBack := 0;
+      FDel := 0;
+      Deleted(str, pos, top);
+    end;
+  end
+  else
+  begin
+    FBack := 0;
+    FDel := 0;
+    obj := TUnDelete.Create;
+    obj.FStr := str;
+    obj.FPos := pos;
+    obj.FTop := top;
+    obj.FMemo := FMemo;
+    FStack.Push(obj);
+  end;
 end;
 
 procedure TUndoClass.DelRedoStack;
@@ -139,7 +176,7 @@ end;
 
 function TUndoClass.GetCanRedo: Boolean;
 begin
-  result:=FReStack.Count > 0;
+  result := FReStack.Count > 0;
 end;
 
 function TUndoClass.GetCanUndo: Boolean;
@@ -194,11 +231,21 @@ begin
   end;
 end;
 
+procedure TUndoClass.ResetBack;
+begin
+  FBack := 0;
+end;
+
 procedure TUndoClass.ResetCnt;
 begin
   FCnt := 0;
 end;
 
+procedure TUndoClass.ResetDel;
+begin
+  FDel := 0;
+end;
+
 procedure TUndoClass.Returned(pos: integer);
 var
   obj: TUnRETURN;
@@ -229,6 +276,13 @@ begin
   List.Free;
 end;
 
+procedure TUndoClass.UpBackCnt;
+begin
+  inc(FBack);
+  if FBack > 5 then
+    FBack := 0;
+end;
+
 procedure TUndoClass.UpCount;
 begin
   inc(FCnt);
@@ -236,6 +290,13 @@ begin
     FCnt := 0;
 end;
 
+procedure TUndoClass.UpDelCnt;
+begin
+  inc(FDel);
+  if FDel > 5 then
+    FDel := 0;
+end;
+
 { TUnDelete }
 
 procedure TUnDelete.Execute;
@@ -253,7 +314,7 @@ begin
   else
   begin
     FMemo.SelLength := Length(FStr);
-    FMemo.SelStart := FPos + 1;
+    FMemo.SelStart := FPos + Length(FStr);
   end;
 end;
 

diff --git a/Unit1.pas b/Unit1.pas
index 7e10dcd..e1a7159 100644 (file)
--- a/Unit1.pas
+++ b/Unit1.pas
@@ -117,7 +117,7 @@ begin
   Memo1.SelStart := Memo1.SelStart - Length(s);
   Memo1.SelLength := Length(s);
   Undo.Pasted(Memo1.SelText, Memo1.SelStart);
-  ToolButton8.Enabled:=Undo.CanUndo;
+  ToolButton8.Enabled := Undo.CanUndo;
 end;
 
 procedure TForm1.Action5Execute(Sender: TObject);
@@ -241,10 +241,15 @@ begin
   if Memo1.Text <> '' then
     case Key of
       VK_DELETE:
+      begin
         if Memo1.SelLength = 0 then
           delstr := Memo1.Text[Memo1.SelStart + 1]
         else
           delstr := Memo1.SelText;
+        Undo.ResetBack;
+        Undo.Deleted(delstr, Memo1.SelStart, true);
+        Undo.UpDelCnt;
+      end;
     end;
   charmodi := true;
 end;
@@ -254,10 +259,15 @@ begin
   case Ord(Key) of
     VK_BACK:
       if Memo1.SelStart > 0 then
+      begin
         if Memo1.SelLength = 0 then
           delstr := Memo1.Text[Memo1.SelStart]
         else
           delstr := Memo1.SelText;
+        Undo.ResetDel;
+        Undo.Deleted(delstr, Memo1.SelStart-1, false);
+        Undo.UpBackCnt;
+      end;
   else
     inputsub(Key);
   end;
@@ -265,12 +275,6 @@ end;
 
 procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
 begin
-  case Key of
-    VK_BACK:
-      Undo.Deleted(delstr, Memo1.SelStart, false);
-    VK_DELETE:
-      Undo.Deleted(delstr, Memo1.SelStart, true);
-  end;
   if charmodi = true then
     Undo.ResetCnt;
   StatusBar1.Panels[1].Text := charmodi.ToString;