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