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     Execute1: TAction;
  38     Hint1: 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     Undo1: TAction;
  61     Past1: TAction;
  62     Redo1: TAction;
  63     R1: TMenuItem;
  64     R2: TMenuItem;
  65     ToolButton11: TToolButton;
  66     procedure ToolButton5Click(Sender: TObject);
  67     procedure TabControl1Change(Sender: TObject);
  68     procedure FormCreate(Sender: TObject);
  69     procedure Memo1Change(Sender: TObject);
  70     procedure Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
  71     procedure Memo1KeyPress(Sender: TObject; var Key: Char);
  72     procedure FormDestroy(Sender: TObject);
  73     procedure Undo1Execute(Sender: TObject);
  74     procedure Memo1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  75     procedure Past1Execute(Sender: TObject);
  76     procedure Redo1Execute(Sender: TObject);
  77     procedure Execute1Execute(Sender: TObject);
  78   private
  79     { Private \90é\8c¾ }
  80     function checkplane: Boolean;
  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.Undo1Execute(Sender: TObject);
 106 begin
 107   Undo.Execute;
 108   ToolButton8.Enabled := Undo.CanUndo;
 109   ToolButton11.Enabled := Undo.CanRedo;
 110 end;
 111
 112 procedure TForm1.Past1Execute(Sender: TObject);
 113 var
 114   s: string;
 115 begin
 116   s := Clipboard.AsText;
 117   Memo1.SelText := s;
 118   Memo1.SelStart := Memo1.SelStart - Length(s);
 119   Memo1.SelLength := Length(s);
 120   Undo.Pasted(Memo1.SelText, Memo1.SelStart);
 121   ToolButton8.Enabled := Undo.CanUndo;
 122 end;
 123
 124 procedure TForm1.Redo1Execute(Sender: TObject);
 125 begin
 126   Undo.ReDo;
 127   ToolButton8.Enabled := Undo.CanUndo;
 128   ToolButton11.Enabled := Undo.CanRedo;
 129 end;
 130
 131 procedure TForm1.arrloop(item: TTreeNode; arr: TJSONArray);
 132 var
 133   s: string;
 134   val: TJSONValue;
 135   i: integer;
 136   c: Char;
 137 begin
 138   c := returnChar(id);
 139   if id = High(id) then
 140     id := Low(id)
 141   else
 142     id := Succ(id);
 143   for i := 0 to arr.count - 1 do
 144   begin
 145     val := arr.Items[i];
 146     if val is TJSONObject then
 147       loop(item, val as TJSONObject)
 148     else if val is TJSONArray then
 149       arrloop(item, val as TJSONArray)
 150     else
 151     begin
 152       s := c + '_' + arr.Items[i].ToString;
 153       TreeView1.Items.AddChild(item, s);
 154     end;
 155   end;
 156 end;
 157
 158 function TForm1.checkplane: Boolean;
 159 var
 160   i: integer;
 161   s: string;
 162   j: integer;
 163 begin
 164   result := true;
 165   if Memo1.Text <> '' then
 166     for i := 0 to Memo1.Lines.count - 1 do
 167     begin
 168       s := Memo1.Lines[i];
 169       for j := 1 to Length(s) do
 170         case s[j] of
 171           Char(VK_SPACE), Char(VK_TAB), '\81@':
 172             continue;
 173         else
 174           result := false;
 175           break;
 176         end;
 177     end;
 178 end;
 179
 180 procedure TForm1.Execute1Execute(Sender: TObject);
 181 var
 182   i: integer;
 183   j: TJSONObject;
 184 begin
 185   id := Low(id);
 186   TreeView1.Items.Clear;
 187   if checkplane = true then
 188   begin
 189     Memo1.Text := '';
 190     Past1Execute(nil);
 191     Memo1.SelLength := 0;
 192   end;
 193   j := TJSONObject.ParseJSONValue(Memo1.Text) as TJSONObject;
 194   if j <> nil then
 195   begin
 196     loop(nil, j);
 197     for i := 0 to TreeView1.Items.count - 1 do
 198       TreeView1.Items[i].Expanded := true;
 199     if TreeView1.Items.count = 0 then
 200       StatusBar1.Panels[0].Text := 'error'
 201     else
 202     begin
 203       Clipboard.AsText := j.ToString;
 204       StatusBar1.Panels[0].Text := '';
 205     end;
 206   end;
 207 end;
 208
 209 procedure TForm1.FormCreate(Sender: TObject);
 210 begin
 211   TabControl1Change(nil);
 212   Undo := TUndoClass.Create(Self);
 213   Undo.Memo := Memo1;
 214 end;
 215
 216 procedure TForm1.FormDestroy(Sender: TObject);
 217 begin
 218   Undo.Free;
 219 end;
 220
 221 procedure TForm1.inputsub(Key: Char);
 222 begin
 223   delstr := Memo1.SelText;
 224   delpos := Memo1.SelStart;
 225   charmodi := false;
 226   if delstr <> '' then
 227     Undo.Deleted(delstr, Memo1.SelStart, false);
 228   if Key = Char(VK_RETURN) then
 229     Undo.Returned(delpos)
 230   else
 231     Undo.Inputted(Key, delpos);
 232   Undo.UpCount;
 233 end;
 234
 235 procedure TForm1.loop(item: TTreeNode; JSON: TJSONObject);
 236 var
 237   i: integer;
 238   pair: TJSONPair;
 239   s: string;
 240   val: TJSONValue;
 241   c: Char;
 242 begin
 243   c := returnChar(id);
 244   if id = High(id) then
 245     id := Low(id)
 246   else
 247     id := Succ(id);
 248   for i := 0 to JSON.count - 1 do
 249   begin
 250     pair := JSON.Pairs[i];
 251     val := pair.JsonValue;
 252     if val is TJSONObject then
 253     begin
 254       s := c + pair.JsonString.ToString + ':';
 255       loop(TreeView1.Items.AddChild(item, s), val as TJSONObject);
 256     end
 257     else if val is TJSONArray then
 258     begin
 259       s := c + pair.JsonString.ToString + ':';
 260       arrloop(TreeView1.Items.AddChild(item, s), pair.JsonValue as TJSONArray);
 261     end
 262     else
 263     begin
 264       s := c + pair.JsonString.ToString + ':' + pair.JsonValue.ToString;
 265       TreeView1.Items.AddChild(item, s);
 266     end;
 267   end;
 268 end;
 269
 270 procedure TForm1.Memo1Change(Sender: TObject);
 271 begin
 272   ToolButton8.Enabled := Undo.CanUndo;
 273   if Memo1.Text = '' then
 274   begin
 275     TreeView1.Items.Clear;
 276     TreeView1.Items.Add(nil, 'JSON items');
 277   end;
 278 end;
 279
 280 procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
 281   Shift: TShiftState);
 282 begin
 283   if Memo1.Text <> '' then
 284     case Key of
 285       VK_DELETE:
 286         begin
 287           if Memo1.CaretPos.X = Length(Memo1.Lines[Memo1.CaretPos.Y]) then
 288           begin
 289             Undo.DelReturn(Memo1.SelStart, true);
 290             Undo.ResetDel;
 291             Undo.ResetBack;
 292             charmodi := true;
 293             Exit;
 294           end
 295           else if Memo1.SelLength = 0 then
 296             delstr := Memo1.Text[Memo1.SelStart + 1]
 297           else
 298             delstr := Memo1.SelText;
 299           Undo.ResetBack;
 300           Undo.Deleted(delstr, Memo1.SelStart, true);
 301           Undo.UpDelCnt;
 302         end;
 303     end;
 304   charmodi := true;
 305 end;
 306
 307 procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
 308 var
 309   i: integer;
 310 begin
 311   if Ord(Key) = VK_BACK then
 312   begin
 313     if Memo1.SelStart > 0 then
 314     begin
 315       if Memo1.CaretPos.X = 0 then
 316       begin
 317         Undo.DelReturn(Memo1.SelStart, false);
 318         Undo.ResetDel;
 319         Undo.ResetBack;
 320         charmodi := true;
 321         Exit;
 322       end
 323       else if Memo1.SelLength = 0 then
 324       begin
 325         delstr := Memo1.Text[Memo1.SelStart];
 326         i := Memo1.SelStart - 1;
 327       end
 328       else
 329       begin
 330         delstr := Memo1.SelText;
 331         i := Memo1.SelStart;
 332       end;
 333       Undo.ResetDel;
 334       Undo.Deleted(delstr, i, false);
 335       Undo.UpBackCnt;
 336     end;
 337   end
 338   else
 339   begin
 340     Undo.ResetDel;
 341     Undo.ResetBack;
 342     inputsub(Key);
 343   end;
 344 end;
 345
 346 procedure TForm1.Memo1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
 347 begin
 348   if charmodi = true then
 349     Undo.ResetCnt;
 350 end;
 351
 352 function TForm1.returnChar(c: TIndxChar): Char;
 353 begin
 354   result := ' ';
 355   case c of
 356     chMul:
 357       result := '*';
 358     chPlus:
 359       result := '+';
 360     chYen:
 361       result := '\';
 362     chDollar:
 363       result := '$';
 364     chSharp:
 365       result := '#';
 366     chAnd:
 367       result := '&';
 368     chPercent:
 369       result := '%';
 370   end;
 371 end;
 372
 373 procedure TForm1.TabControl1Change(Sender: TObject);
 374 begin
 375   case TabControl1.TabIndex of
 376     0:
 377       Memo2.Text := Memo3.Text;
 378     1:
 379       Memo2.Text := Memo4.Text;
 380   end;
 381 end;
 382
 383 procedure TForm1.ToolButton5Click(Sender: TObject);
 384 begin
 385   TabControl1.Visible := not TabControl1.Visible;
 386 end;
 387
 388 end.