memo_json_auto.pas 3.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124
  1. unit memo_json_auto;
  2. interface
  3. uses
  4. System.Classes, System.SysUtils, FMX.Types,
  5. FMX.Memo, FMX.Memo.Types, FMX.Text;
  6. type
  7. TMemoJsonAuto = class(TComponent)
  8. private
  9. FMemo: TMemo;
  10. FOldOnKeyDown: TKeyEvent;
  11. FOldOnKeyUp: TKeyEvent;
  12. procedure SetMemo(const AValue: TMemo);
  13. procedure OnKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
  14. procedure OnKeyUp(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
  15. function NextChar: string;
  16. public
  17. property Memo: TMemo read FMemo write SetMemo;
  18. public
  19. constructor Create(AOwner: TComponent); overload; override;
  20. constructor Create(AOwner: TComponent; AMemo: TMemo); reintroduce; overload;
  21. end;
  22. implementation
  23. constructor TMemoJsonAuto.Create(AOwner: TComponent);
  24. begin
  25. inherited;
  26. FMemo := nil;
  27. FOldOnKeyDown := nil;
  28. FOldOnKeyUp := nil;
  29. end;
  30. constructor TMemoJsonAuto.Create(AOwner: TComponent; AMemo: TMemo);
  31. begin
  32. Create(AOwner);
  33. SetMemo(AMemo);
  34. end;
  35. procedure TMemoJsonAuto.SetMemo(const AValue: TMemo);
  36. begin
  37. if FMemo = AValue then
  38. Exit;
  39. FMemo := AValue;
  40. FOldOnKeyDown := FMemo.OnKeyDown;
  41. FOldOnKeyUp := FMemo.OnKeyUp;
  42. FMemo.OnKeyDown := OnKeyDown;
  43. FMemo.OnKeyUp := OnKeyUp;
  44. end;
  45. procedure TMemoJsonAuto.OnKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
  46. begin
  47. if Key = 13 then
  48. begin
  49. if not FMemo.IsUpdating then
  50. FMemo.BeginUpdate;
  51. end;
  52. if Assigned(FOldOnKeyDown) then
  53. FOldOnKeyDown(Sender, Key, KeyChar, Shift);
  54. end;
  55. procedure TMemoJsonAuto.OnKeyUp(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
  56. var
  57. strTmp: string;
  58. sp: string;
  59. begin
  60. if (Key = 13) and (FMemo.CaretPosition.Pos = 0) then
  61. begin
  62. strTmp := FMemo.Lines[FMemo.CaretPosition.line - 1];
  63. if strTmp.StartsWith(' ') then
  64. begin
  65. for var i := 1 to strTmp.Length do
  66. begin
  67. if strTmp[i] <> ' ' then
  68. begin
  69. break;
  70. end;
  71. sp := sp + ' ';
  72. end;
  73. FMemo.InsertAfter(FMemo.CaretPosition, sp, [FMX.Text.TInsertOption.MoveCaret]);
  74. end;
  75. FMemo.EndUpdate;
  76. end
  77. else if KeyChar = '[' then
  78. begin
  79. if FMemo.Lines[FMemo.CaretPosition.line][FMemo.CaretPosition.Pos] = '[' then
  80. begin
  81. if NextChar <> ']' then
  82. begin
  83. FMemo.InsertAfter(FMemo.CaretPosition, ']', []);
  84. end;
  85. end;
  86. end
  87. else if KeyChar = '{' then
  88. begin
  89. if FMemo.Lines[FMemo.CaretPosition.line][FMemo.CaretPosition.Pos] = '{' then
  90. begin
  91. if NextChar <> '}' then
  92. begin
  93. FMemo.InsertAfter(FMemo.CaretPosition, '}', []);
  94. end;
  95. end;
  96. end
  97. else if KeyChar = '"' then
  98. begin
  99. if FMemo.Lines[FMemo.CaretPosition.line][FMemo.CaretPosition.Pos] = '"' then
  100. FMemo.InsertAfter(FMemo.CaretPosition, '"', []);
  101. end;
  102. if Assigned(FOldOnKeyUp) then
  103. begin
  104. FOldOnKeyUp(Sender, Key, KeyChar, Shift);
  105. end;
  106. end;
  107. function TMemoJsonAuto.NextChar: string;
  108. begin
  109. Result := '';
  110. if FMemo.Lines[FMemo.CaretPosition.line].Length > FMemo.CaretPosition.Pos then
  111. Result := FMemo.Lines[FMemo.CaretPosition.line][FMemo.CaretPosition.Pos + 1];
  112. end;
  113. end.