Undoだけ実装 ペースト未対応 Redo削除

diff --git a/Undo.pas b/Undo.pas
new file mode 100644 (file)
index 0000000..f0b8805
--- /dev/null
+++ b/Undo.pas
@@ -0,0 +1,139 @@
+unit Undo;
+
+interface
+
+uses System.Contnrs, System.Classes, Vcl.StdCtrls;
+
+type
+  TUndoMethod = procedure(const str: string; pos: integer) of Object;
+
+  TUndoItem = class
+  public
+    str: string;
+    pos: integer;
+    top: Boolean;
+    meth: TUndoMethod;
+  end;
+
+  TUndoClass = class(TComponent)
+  private
+    FStack: TObjectStack;
+    FMemo: TCustomMemo;
+    procedure UnDelete(const str: string; pos: integer);
+    procedure UnInput(const str: string; pos: integer);
+    procedure UnPaste(const str: string; pos: integer);
+    function GetCanUndo: Boolean;
+  protected
+    FTop: Boolean;
+  public
+    constructor Create(AOwner: TComponent); override;
+    procedure Deleted(const str: string; pos: integer; top: Boolean);
+    procedure Inputted(const str: string; pos: integer);
+    procedure Pasted(const str: string; pos: integer);
+    procedure Execute;
+    destructor Destroy; override;
+  published
+    property Memo: TCustomMemo read FMemo write FMemo;
+    property CanUndo: Boolean read GetCanUndo;
+  end;
+
+implementation
+
+{ TUndoClass }
+
+constructor TUndoClass.Create(AOwner: TComponent);
+begin
+  inherited;
+  FStack := TObjectStack.Create;
+end;
+
+procedure TUndoClass.Deleted(const str: string; pos: integer; top: Boolean);
+var
+  obj: TUndoItem;
+begin
+  obj := TUndoItem.Create;
+  obj.str := str;
+  obj.pos := pos;
+  obj.top := top;
+  obj.meth := UnDelete;
+  FStack.Push(obj);
+end;
+
+destructor TUndoClass.Destroy;
+var
+  i: integer;
+begin
+  for i := 0 to FStack.Count - 1 do
+    FStack.Pop;
+  FStack.Free;
+  inherited;
+end;
+
+procedure TUndoClass.Execute;
+var
+  obj: TUndoItem;
+begin
+  if FStack.Count > 0 then
+  begin
+    obj := FStack.Pop as TUndoItem;
+    FTop := obj.top;
+    obj.meth(obj.str, obj.pos);
+  end;
+end;
+
+function TUndoClass.GetCanUndo: Boolean;
+begin
+  result := FStack.Count > 0;
+end;
+
+procedure TUndoClass.Inputted(const str: string; pos: integer);
+var
+  obj: TUndoItem;
+begin
+  obj := TUndoItem.Create;
+  obj.str := str;
+  obj.pos := pos;
+  obj.meth := UnInput;
+  FStack.Push(obj);
+end;
+
+procedure TUndoClass.Pasted(const str: string; pos: integer);
+var
+  obj: TUndoItem;
+begin
+  obj := TUndoItem.Create;
+  obj.str := str;
+  obj.pos := pos;
+  obj.meth := UnPaste;
+  FStack.Push(obj);
+end;
+
+procedure TUndoClass.UnDelete(const str: string; pos: integer);
+begin
+  Memo.SelStart := pos;
+  Memo.SelText := str;
+  Memo.SelStart := pos;
+  if Length(str) > 1 then
+    Memo.SelLength := Length(str);
+  if FTop = true then
+  begin
+    Memo.SelStart := pos;
+    Memo.SelLength := Length(str);
+  end;
+end;
+
+procedure TUndoClass.UnInput(const str: string; pos: integer);
+begin
+  Memo.SelStart := pos;
+  Memo.SelLength := 1;
+  Memo.SelText := '';
+end;
+
+procedure TUndoClass.UnPaste(const str: string; pos: integer);
+begin
+  Memo.SelStart := pos;
+  Memo.SelLength := Length(str);
+  Memo.SelText := '';
+end;
+
+end.

diff --git a/Unit1.dfm b/Unit1.dfm
index 64579c6..65c1c10 100644 (file)
--- a/Unit1.dfm
+++ b/Unit1.dfm
@@ -14,6 +14,7 @@ object Form1: TForm1
   OldCreateOrder = False
   ShowHint = True
   OnCreate = FormCreate
+  OnDestroy = FormDestroy
   PixelsPerInch = 96
   TextHeight = 28
   object Memo1: TMemo
@@ -25,6 +26,9 @@ object Form1: TForm1
     PopupMenu = PopupMenu1
     TabOrder = 0
     OnChange = Memo1Change
+    OnKeyDown = Memo1KeyDown
+    OnKeyPress = Memo1KeyPress
+    OnKeyUp = Memo1KeyUp
   end
   object ToolBar1: TToolBar
     Left = 0
@@ -65,20 +69,20 @@ object Form1: TForm1
       ImageIndex = 3
       Style = tbsSeparator
     end
-    object ToolButton10: TToolButton
+    object ToolButton8: TToolButton
       Left = 56
       Top = 0
+      Action = Action3
+      ImageIndex = 2
+    end
+    object ToolButton10: TToolButton
+      Left = 79
+      Top = 0
       Width = 8
       Caption = 'ToolButton10'
       ImageIndex = 4
       Style = tbsSeparator
     end
-    object ToolButton8: TToolButton
-      Left = 64
-      Top = 0
-      Action = EditUndo1
-      ImageIndex = 2
-    end
     object ToolButton4: TToolButton
       Left = 87
       Top = 0
@@ -204,7 +208,7 @@ object Form1: TForm1
     Left = 200
     Top = 88
     Bitmap = {
-      494C010104000800580010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
+      494C0101040008005C0010001000FFFFFFFFFF10FFFFFFFFFFFFFFFF424D3600
       0000000000003600000028000000400000002000000001002000000000000020
       0000000000000000000000000000000000000000000000000000000000000000
       0000000000000000000000000000000000000000000000000000000000000000
@@ -505,13 +509,6 @@ object Form1: TForm1
       Hint = #12377#12409#12390#36984#25246'|'#12489#12461#12517#12513#12531#12488#20840#20307#12434#36984#25246#12375#12414#12377
       ShortCut = 16449
     end
-    object EditUndo1: TEditUndo
-      Category = #32232#38598
-      Caption = #20803#12395#25147#12377'(&U)'
-      Hint = #20803#12395#25147#12377'|'#30452#21069#12398#25805#20316#12434#20803#12395#25147#12375#12414#12377
-      ImageIndex = 3
-      ShortCut = 16474
-    end
     object Action1: TAction
       Caption = #23455#34892
       OnExecute = ToolButton2Click
@@ -526,6 +523,11 @@ object Form1: TForm1
       Hint = #32066#20102'|'#12450#12503#12522#12465#12540#12471#12519#12531#12434#32066#20102#12375#12414#12377
       ImageIndex = 43
     end
+    object Action3: TAction
+      Category = #32232#38598
+      Caption = 'Undo'
+      OnExecute = Action3Execute
+    end
   end
   object PopupMenu1: TPopupMenu
     Left = 368
@@ -543,7 +545,7 @@ object Form1: TForm1
       Action = EditSelectAll1
     end
     object U1: TMenuItem
-      Action = EditUndo1
+      Action = Action3
     end
   end
   object MainMenu1: TMainMenu
@@ -576,7 +578,10 @@ object Form1: TForm1
         Action = EditSelectAll1
       end
       object U2: TMenuItem
-        Action = EditUndo1
+        Caption = #20803#12395#25147#12377'(&U)'
+        Hint = #20803#12395#25147#12377'|'#30452#21069#12398#25805#20316#12434#20803#12395#25147#12375#12414#12377
+        ImageIndex = 3
+        ShortCut = 16474
       end
     end
     object N3: TMenuItem

diff --git a/Unit1.pas b/Unit1.pas
index a719fd0..d705644 100644 (file)
--- a/Unit1.pas
+++ b/Unit1.pas
@@ -27,7 +27,6 @@ type
     PopupMenu1: TPopupMenu;
     EditPaste1: TEditPaste;
     EditSelectAll1: TEditSelectAll;
-    EditUndo1: TEditUndo;
     EditCut1: TEditCut;
     EditCopy1: TEditCopy;
     C1: TMenuItem;
@@ -60,14 +59,19 @@ type
     ToolButton9: TToolButton;
     ToolButton10: TToolButton;
     Memo5: TMemo;
+    Action3: TAction;
     procedure ToolButton2Click(Sender: TObject);
     procedure ToolButton5Click(Sender: TObject);
     procedure TabControl1Change(Sender: TObject);
     procedure FormCreate(Sender: TObject);
     procedure Memo1Change(Sender: TObject);
+    procedure Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+    procedure Memo1KeyPress(Sender: TObject; var Key: Char);
+    procedure FormDestroy(Sender: TObject);
+    procedure Action3Execute(Sender: TObject);
+    procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
   private
     { Private \90é\8c¾ }
-    id: TIndxChar;
     procedure loop(item: TTreeNode; JSON: TJSONObject);
     procedure arrloop(item: TTreeNode; arr: TJSONArray);
     function returnChar(c: TIndxChar): Char;
@@ -82,7 +86,18 @@ implementation
 
 {$R *.dfm}
 
-uses Clipbrd;
+uses Clipbrd, Undo;
+
+var
+  id: TIndxChar;
+  delstr: string;
+  delpos: integer;
+  Undo: TUndoClass;
+
+procedure TForm1.Action3Execute(Sender: TObject);
+begin
+  Undo.Execute;
+end;
 
 procedure TForm1.arrloop(item: TTreeNode; arr: TJSONArray);
 var
@@ -114,6 +129,13 @@ end;
 procedure TForm1.FormCreate(Sender: TObject);
 begin
   TabControl1Change(nil);
+  Undo := TUndoClass.Create(Self);
+  Undo.Memo := Memo1;
+end;
+
+procedure TForm1.FormDestroy(Sender: TObject);
+begin
+  Undo.Free;
 end;
 
 procedure TForm1.loop(item: TTreeNode; JSON: TJSONObject);
@@ -164,6 +186,7 @@ end;
 
 procedure TForm1.Memo1Change(Sender: TObject);
 begin
+  ToolButton8.Enabled := Undo.CanUndo;
   if Memo1.Text = '' then
   begin
     TreeView1.Items.Clear;
@@ -171,6 +194,53 @@ begin
   end;
 end;
 
+procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
+  Shift: TShiftState);
+begin
+  if Memo1.Text <> '' then
+    case Key of
+      VK_DELETE:
+        if Memo1.SelLength = 0 then
+          delstr := Memo1.Text[Memo1.SelStart + 1]
+        else
+          delstr := Memo1.SelText;
+    end;
+end;
+
+procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
+begin
+  case Ord(Key) of
+    VK_BACK:
+      if Memo1.SelStart > 0 then
+        if Memo1.SelLength = 0 then
+          delstr := Memo1.Text[Memo1.SelStart]
+        else
+          delstr := Memo1.SelText;
+  else
+    if Memo1.SelLength > 0 then
+      Undo.Deleted(Memo1.SelText, Memo1.SelStart, false);
+    Undo.Inputted(Key, Memo1.SelStart);
+    delpos := Memo1.SelStart + 1;
+  end;
+end;
+
+procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+var
+  s: string;
+begin
+  case Key of
+    VK_BACK:
+      Undo.Deleted(delstr, Memo1.SelStart, false);
+    VK_DELETE:
+      Undo.Deleted(delstr, Memo1.SelStart, true);
+  end;
+  if Memo1.SelStart > delpos then
+  begin
+    s := Copy(Memo1.Text, delpos, Memo1.SelStart - delpos);
+    Undo.Pasted(s, delpos);
+  end;
+end;
+
 function TForm1.returnChar(c: TIndxChar): Char;
 begin
   result := ' ';

diff --git a/json_checker.dpr b/json_checker.dpr
index 9bc701b..b24b366 100644 (file)
--- a/json_checker.dpr
+++ b/json_checker.dpr
@@ -2,7 +2,8 @@ program json_checker;
 
 uses
   Vcl.Forms,
-  Unit1 in 'Unit1.pas' {Form1};
+  Unit1 in 'Unit1.pas' {Form1},
+  Undo in 'Undo.pas';
 
 {$R *.res}
 

diff --git a/json_checker.dproj b/json_checker.dproj
index 0cbb561..348f24e 100644 (file)
--- a/json_checker.dproj
+++ b/json_checker.dproj
@@ -5,7 +5,7 @@
         <FrameworkType>VCL</FrameworkType>
         <MainSource>json_checker.dpr</MainSource>
         <Base>True</Base>
-        <Config Condition="'$(Config)'==''">Release</Config>
+        <Config Condition="'$(Config)'==''">Debug</Config>
         <Platform Condition="'$(Platform)'==''">Win64</Platform>
         <TargetedPlatforms>3</TargetedPlatforms>
         <AppType>Application</AppType>
@@ -92,6 +92,7 @@
             <Form>Form1</Form>
             <FormType>dfm</FormType>
         </DCCReference>
+        <DCCReference Include="Undo.pas"/>
         <BuildConfiguration Include="Release">
             <Key>Cfg_2</Key>
             <CfgParent>Base</CfgParent>
@@ -120,6 +121,24 @@
                         <Overwrite>true</Overwrite>
                     </Platform>
                 </DeployFile>
+                <DeployFile LocalName="Win64\Debug\json_checker.exe" Configuration="Debug" Class="ProjectOutput">
+                    <Platform Name="Win64">
+                        <RemoteName>json_checker.exe</RemoteName>
+                        <Overwrite>true</Overwrite>
+                    </Platform>
+                </DeployFile>
+                <DeployFile LocalName="Win64\Debug\json_checker.rsm" Configuration="Debug" Class="DebugSymbols">
+                    <Platform Name="Win64">
+                        <RemoteName>json_checker.rsm</RemoteName>
+                        <Overwrite>true</Overwrite>
+                    </Platform>
+                </DeployFile>
+                <DeployFile LocalName="Win64\Release\json_checker.exe" Configuration="Release" Class="ProjectOutput">
+                    <Platform Name="Win64">
+                        <RemoteName>json_checker.exe</RemoteName>
+                        <Overwrite>true</Overwrite>
+                    </Platform>
+                </DeployFile>
                 <DeployClass Required="true" Name="DependencyPackage">
                     <Platform Name="iOSDevice">
                         <Operation>1</Operation>