Unit1.pas

   1 unit Unit1;
   2
   3 interface
   4
   5 uses
   6   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
   7   System.Classes, Vcl.Graphics,
   8   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls, Vcl.ToolWin,
   9   Vcl.ImgList, JSON, Vcl.Menus, Vcl.StdActns, System.Actions, Vcl.ActnList;
  10
  11 type
  12   TIndxChar = (chMul, chPlus, chYen, chDollar, chSharp, chAnd, chPercent);
  13
  14   TForm1 = class(TForm)
  15     Memo1: TMemo;
  16     ToolBar1: TToolBar;
  17     ToolButton1: TToolButton;
  18     ToolButton2: TToolButton;
  19     ImageList1: TImageList;
  20     TreeView1: TTreeView;
  21     ToolButton3: TToolButton;
  22     StatusBar1: TStatusBar;
  23     ToolButton4: TToolButton;
  24     ToolButton5: TToolButton;
  25     Memo2: TMemo;
  26     ActionList1: TActionList;
  27     PopupMenu1: TPopupMenu;
  28     EditSelectAll1: TEditSelectAll;
  29     EditCut1: TEditCut;
  30     EditCopy1: TEditCopy;
  31     C1: TMenuItem;
  32     T1: TMenuItem;
  33     P1: TMenuItem;
  34     A1: TMenuItem;
  35     U1: TMenuItem;
  36     MainMenu1: TMainMenu;
  37     Action1: TAction;
  38     Action2: TAction;
  39     TabControl1: TTabControl;
  40     Memo3: TMemo;
  41     Memo4: TMemo;
  42     ToolButton6: TToolButton;
  43     ToolButton7: TToolButton;
  44     FileExit1: TFileExit;
  45     N1: TMenuItem;
  46     N2: TMenuItem;
  47     N4: TMenuItem;
  48     N5: TMenuItem;
  49     X1: TMenuItem;
  50     C2: TMenuItem;
  51     T2: TMenuItem;
  52     P2: TMenuItem;
  53     A2: TMenuItem;
  54     U2: TMenuItem;
  55     N3: TMenuItem;
  56     N6: TMenuItem;
  57     ToolButton8: TToolButton;
  58     ToolButton9: TToolButton;
  59     ToolButton10: TToolButton;
  60     Memo5: TMemo;
  61     Action3: TAction;
  62     Action4: TAction;
  63     Action5: TAction;
  64     ReDo1: TMenuItem;
  65     ReDo2: TMenuItem;
  66     ToolButton11: TToolButton;
  67     procedure ToolButton2Click(Sender: TObject);
  68     procedure ToolButton5Click(Sender: TObject);
  69     procedure TabControl1Change(Sender: TObject);
  70     procedure FormCreate(Sender: TObject);
  71     procedure Memo1Change(Sender: TObject);
  72     procedure Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
  73     procedure Memo1KeyPress(Sender: TObject; var Key: Char);
  74     procedure FormDestroy(Sender: TObject);
  75     procedure Action3Execute(Sender: TObject);
  76     procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  77     procedure Action4Execute(Sender: TObject);
  78     procedure Action5Execute(Sender: TObject);
  79   private
  80     { Private \90é\8c¾ }
  81     procedure loop(item: TTreeNode; JSON: TJSONObject);
  82     procedure arrloop(item: TTreeNode; arr: TJSONArray);
  83     function returnChar(c: TIndxChar): Char;
  84     procedure inputsub(Key: Char);
  85   public
  86     { Public \90é\8c¾ }
  87   end;
  88
  89 var
  90   Form1: TForm1;
  91
  92 implementation
  93
  94 {$R *.dfm}
  95
  96 uses Clipbrd, Undo;
  97
  98 var
  99   id: TIndxChar;
 100   delstr: string;
 101   delpos: integer;
 102   charmodi: Boolean;
 103   Undo: TUndoClass;
 104
 105 procedure TForm1.Action3Execute(Sender: TObject);
 106 begin
 107   Undo.Execute;
 108   ToolButton11.Enabled := Undo.CanRedo;
 109 end;
 110
 111 procedure TForm1.Action4Execute(Sender: TObject);
 112 var
 113   s: string;
 114 begin
 115   s := Clipboard.AsText;
 116   Memo1.SelText := s;
 117   Memo1.SelStart := Memo1.SelStart - Length(s);
 118   Memo1.SelLength := Length(s);
 119   Undo.Pasted(Memo1.SelText, Memo1.SelStart);
 120   ToolButton8.Enabled := Undo.CanUndo;
 121 end;
 122
 123 procedure TForm1.Action5Execute(Sender: TObject);
 124 begin
 125   Undo.ReDo;
 126   ToolButton11.Enabled := Undo.CanRedo;
 127 end;
 128
 129 procedure TForm1.arrloop(item: TTreeNode; arr: TJSONArray);
 130 var
 131   s: string;
 132   val: TJSONValue;
 133   i: integer;
 134   c: Char;
 135 begin
 136   c := returnChar(id);
 137   if id = High(id) then
 138     id := Low(id)
 139   else
 140     id := Succ(id);
 141   for i := 0 to arr.count - 1 do
 142   begin
 143     val := arr.Items[i];
 144     if val is TJSONObject then
 145       loop(item, val as TJSONObject)
 146     else if val is TJSONArray then
 147       arrloop(item, val as TJSONArray)
 148     else
 149     begin
 150       s := c + '_' + arr.Items[i].ToString;
 151       TreeView1.Items.AddChild(item, s);
 152     end;
 153   end;
 154 end;
 155
 156 procedure TForm1.FormCreate(Sender: TObject);
 157 begin
 158   TabControl1Change(nil);
 159   Undo := TUndoClass.Create(Self);
 160   Undo.Memo := Memo1;
 161 end;
 162
 163 procedure TForm1.FormDestroy(Sender: TObject);
 164 begin
 165   Undo.Free;
 166 end;
 167
 168 procedure TForm1.inputsub(Key: Char);
 169 begin
 170   delstr := Memo1.SelText;
 171   delpos := Memo1.SelStart;
 172   charmodi := false;
 173   if delstr <> '' then
 174     Undo.Deleted(delstr, Memo1.SelStart, false);
 175   if Key = Char(VK_RETURN) then
 176     Undo.Returned(delpos)
 177   else
 178     Undo.Inputted(Key, delpos);
 179   Undo.UpCount;
 180 end;
 181
 182 procedure TForm1.loop(item: TTreeNode; JSON: TJSONObject);
 183 var
 184   i: integer;
 185   pair: TJSONPair;
 186   s: string;
 187   val: TJSONValue;
 188   c: Char;
 189 begin
 190   c := returnChar(id);
 191   if id = High(id) then
 192     id := Low(id)
 193   else
 194     id := Succ(id);
 195   for i := 0 to JSON.count - 1 do
 196   begin
 197     pair := JSON.Pairs[i];
 198     if pair = nil then
 199     begin
 200       TreeView1.Items.AddChild(item, 'error');
 201       Showmessage('\93à\95\94\83G\83\89\81[\82É\82æ\82è\92\86\92f\82µ\82Ü\82µ\82½');
 202       TabControl1.TabIndex := 2;
 203       TabControl1Change(nil);
 204       TabControl1.Show;
 205       Exit;
 206     end
 207     else
 208       val := pair.JsonValue;
 209     if val is TJSONObject then
 210     begin
 211       s := c + pair.JsonString.ToString + ':';
 212       JSON := pair.JsonValue as TJSONObject;
 213       loop(TreeView1.Items.AddChild(item, s), JSON);
 214     end
 215     else if val is TJSONArray then
 216     begin
 217       s := c + pair.JsonString.ToString + ':';
 218       arrloop(TreeView1.Items.AddChild(item, s), pair.JsonValue as TJSONArray);
 219     end
 220     else
 221     begin
 222       s := c + pair.JsonString.ToString + ':' + pair.JsonValue.ToString;
 223       TreeView1.Items.AddChild(item, s);
 224     end;
 225   end;
 226 end;
 227
 228 procedure TForm1.Memo1Change(Sender: TObject);
 229 begin
 230   ToolButton8.Enabled := Undo.CanUndo;
 231   if Memo1.Text = '' then
 232   begin
 233     TreeView1.Items.Clear;
 234     TreeView1.Items.Add(nil, 'JSON items');
 235   end;
 236 end;
 237
 238 procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
 239   Shift: TShiftState);
 240 begin
 241   if Memo1.Text <> '' then
 242     case Key of
 243       VK_DELETE:
 244       begin
 245         if Memo1.CaretPos.X = Length(Memo1.Lines[Memo1.CaretPos.Y]) then
 246         begin
 247           Undo.DelReturn(Memo1.SelStart,true);
 248           Undo.ResetDel;
 249           Undo.ResetBack;
 250           charmodi := true;
 251           Exit;
 252         end
 253         else if Memo1.SelLength = 0 then
 254           delstr := Memo1.Text[Memo1.SelStart + 1]
 255         else
 256           delstr := Memo1.SelText;
 257         Undo.ResetBack;
 258         Undo.Deleted(delstr, Memo1.SelStart, true);
 259         Undo.UpDelCnt;
 260       end;
 261     end;
 262   charmodi := true;
 263 end;
 264
 265 procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
 266 begin
 267   case Ord(Key) of
 268     VK_BACK:
 269       if Memo1.SelStart > 0 then
 270       begin
 271         if Memo1.CaretPos.X = 0 then
 272         begin
 273           Undo.DelReturn(Memo1.SelStart,false);
 274           Undo.ResetDel;
 275           Undo.ResetBack;
 276           charmodi := true;
 277           Exit;
 278         end
 279         else if Memo1.SelLength = 0 then
 280           delstr := Memo1.Text[Memo1.SelStart]
 281         else
 282           delstr := Memo1.SelText;
 283         Undo.ResetDel;
 284         Undo.Deleted(delstr, Memo1.SelStart-1, false);
 285         Undo.UpBackCnt;
 286       end;
 287     VK_DELETE:
 288       ;
 289   else
 290     Undo.ResetDel;
 291     Undo.ResetBack;
 292     inputsub(Key);
 293   end;
 294 end;
 295
 296 procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
 297 begin
 298   if charmodi = true then
 299     Undo.ResetCnt;
 300   StatusBar1.Panels[1].Text := charmodi.ToString;
 301 end;
 302
 303 function TForm1.returnChar(c: TIndxChar): Char;
 304 begin
 305   result := ' ';
 306   case c of
 307     chMul:
 308       result := '*';
 309     chPlus:
 310       result := '+';
 311     chYen:
 312       result := '\';
 313     chDollar:
 314       result := '$';
 315     chSharp:
 316       result := '#';
 317     chAnd:
 318       result := '&';
 319     chPercent:
 320       result := '%';
 321   end;
 322 end;
 323
 324 procedure TForm1.TabControl1Change(Sender: TObject);
 325 begin
 326   case TabControl1.TabIndex of
 327     0:
 328       Memo2.Text := Memo3.Text;
 329     1:
 330       Memo2.Text := Memo4.Text;
 331     2:
 332       Memo2.Text := Memo5.Text;
 333   end;
 334 end;
 335
 336 procedure TForm1.ToolButton2Click(Sender: TObject);
 337 var
 338   i: integer;
 339   j: TJSONObject;
 340 begin
 341   id := Low(id);
 342   TreeView1.Items.Clear;
 343   if Memo1.Text = '' then
 344     Memo1.Text := Clipboard.AsText;
 345   j := TJSONObject.ParseJSONValue(Memo1.Text) as TJSONObject;
 346   if j <> nil then
 347     loop(nil, j);
 348   for i := 0 to TreeView1.Items.count - 1 do
 349     TreeView1.Items[i].Expanded := true;
 350   if TreeView1.Items.count = 0 then
 351     StatusBar1.Panels[0].Text := 'error'
 352   else
 353   begin
 354     Clipboard.AsText := j.ToString;
 355     StatusBar1.Panels[0].Text := '';
 356   end;
 357 end;
 358
 359 procedure TForm1.ToolButton5Click(Sender: TObject);
 360 begin
 361   TabControl1.Visible := not TabControl1.Visible;
 362 end;
 363
 364 end.