Core/DBDJsonViewForm.pas - master - YakuninAV/Convertors

Core/DBDJsonViewForm.pas
244 строки7 KB
YakuninAV
begin with gitflick
31 июл 2026, 15:21
31 июл 2026, 15:211dc0fc6
unit DBDJsonViewForm;

{$I Synopse.inc}

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.ToolWin,
  VirtualTrees,
  SynEditHighlighter, SynHighlighterJSON, SynEdit,
  SynCommons;

type

  TOnSelectTable = procedure (Sender: TObject; var TblDoc: PDocVariantData) of object;

  TformJSON = class(TForm)
    pgcntJSON: TPageControl;
    tsTree: TTabSheet;
    tsText: TTabSheet;
    Panel1: TPanel;
    SynEdit: TSynEdit;
    SynJSONSyn1: TSynJSONSyn;
    ToolBar1: TToolBar;
    vstJSON: TVirtualStringTree;
    tbApply: TToolButton;
    procedure FormCreate(Sender: TObject);
    procedure vstJSONGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: string);
    procedure vstJSONDblClick(Sender: TObject);
    procedure tbApplyClick(Sender: TObject);
  private
    { Private declarations }
    FDoc: Variant;
    FPDoc: PDocVariantData;
    FisCopy: Boolean;
    FOnSelectTable: TOnSelectTable;
    FKeyNotify: TOnKeyNotify;
    function GetJSON: RawJSON;
    procedure SetJSON(const Value: RawJSON);
    function GetDoc: Variant;
    procedure SetDoc(const Value: Variant);
    procedure BuildNode(const Node: PVirtualNode);
    procedure BuildTree;
    procedure SetPDoc(const Value: PDocVariantData);
  public
    { Public declarations }
    property isCopy: Boolean read FisCopy;
    property JSON: RawJSON read GetJSON write SetJSON;
    property Doc: Variant read GetDoc write SetDoc;
    property PDoc: PDocVariantData read FPDoc write SetPDoc;
    property OnSelectTable: TOnSelectTable read FOnSelectTable write FOnSelectTable;
    function CheckTable(const Doc: PDocVariantData; out Rows, Cols: Integer): Boolean;
    function GetSeletedDoc: PDocVariantData;
    property KeyNotify: TOnKeyNotify read FKeyNotify write FKeyNotify;
  end;

var
  formJSON: TformJSON;

implementation

{$R *.dfm}

type

  PTreeData=^TTreeData;
  TTreeData = packed record
    Data: PDocVariantData;
    Idx: Integer;
  end;

{ TformJSON }

procedure TformJSON.BuildNode(const Node: PVirtualNode);
var i: Integer; var n: PVirtualNode; p,d: PTreeData;
begin
  d:=vstJSON.GetNodeData(Node);
  if (d=nil) and (d^.Data=nil)then Exit;
  for i := 0 to d^.Data^.Count-1 do begin
    n:=vstJSON.AddChild(Node);
    p:=vstJSON.GetNodeData(n);
    p^.Data:=_Safe(d^.Data^.Values[i]);
    p^.Idx:=i;
    if (p^.Data^.Kind=dvArray) or (p^.Data^.Kind=dvObject) then BuildNode(n);
  end;
end;

procedure TformJSON.BuildTree;
var i: Integer; n: PVirtualNode; p: PTreeData;
begin
  vstJSON.Clear;
  vstJSON.NodeDataSize:=SizeOf(TTreeData);
  if (FPDoc^.Kind=dvUndefined) then Exit;
  vstJSON.BeginUpdate;
  try
    for i := 0 to FPDoc^.Count-1 do begin
      n:=vstJSON.AddChild(nil);
      p:=vstJSON.GetNodeData(n);
      p^.Data:=_Safe(FPDoc^.Values[i]);
      p^.Idx:=i;
      if (p^.Data^.Kind=dvArray) or (p^.Data^.Kind=dvObject) then BuildNode(n);
    end;
  finally
    vstJSON.EndUpdate;
  end;
end;

function TformJSON.CheckTable(const Doc: PDocVariantData; out Rows: Integer; out Cols: Integer): Boolean;
var i,j: Integer;
begin
  Cols:=0; Rows:=0;
  Result := (Doc<>nil) and (Doc^.Kind=dvArray); if not Result then Exit;
  Rows:=Doc^.Count;
  Result := Rows>0;
  if Result then
    for i := 0 to Rows-1 do begin
      Result := (Doc^._[i]^.Kind=dvArray);
      if Result then begin
        j := Doc^._[i].Count;
        Result:=j>0;
        if Result and (j>Cols) then Cols:=j;
      end;
      if not Result then Break;
    end;
end;

procedure TformJSON.FormCreate(Sender: TObject);
begin
  TDocVariant.New(FDoc);
end;

function TformJSON.GetDoc: Variant;
begin
  Result:=FDoc;
end;

function TformJSON.GetJSON: RawJSON;
begin
  TDocVariantData(FDoc).ToJSON;
end;

function TformJSON.GetSeletedDoc: PDocVariantData;
var p: PTreeData; n:PVirtualNode;
begin
  n:=vstJSON.GetFirstSelected();
  Result:=nil;
  if n<>nil then begin
    p:=vstJSON.GetNodeData(n);
    if p<>nil then Result:=p^.Data;
  end;
end;

procedure TformJSON.SetDoc(const Value: Variant);
begin
  FisCopy:=True;
  TDocVariantData(FDoc).Clear;
  if _Safe(Value)^.Kind<>dvUndefined then begin
    TDocVariantData(FDoc).InitCopy(Value,JSON_OPTIONS[false]);
    FPDoc:=_Safe(FDoc);
    SynEdit.Lines.Text:=FPDoc^.ToJSON('','',jsonHumanReadable);
    BuildTree;
  end else begin
    FPDoc:=@DocVariantDataFake;
    SynEdit.Clear;
  end;
  tsText.Show;
end;

procedure TformJSON.SetJSON(const Value: RawJSON);
begin
  FisCopy:=True;
  TDocVariantData(FDoc).Clear;
  if TDocVariantData(FDoc).InitJSON(Value,JSON_OPTIONS[false]) then begin
    FPDoc:=_Safe(FDoc);
    SynEdit.Lines.Text:=FPDoc^.ToJSON('','',jsonHumanReadable);
    BuildTree;
  end else begin
    FPDoc:=@DocVariantDataFake;
    SynEdit.Clear;
  end;
  tsText.Show;
end;

procedure TformJSON.SetPDoc(const Value: PDocVariantData);
begin
  FisCopy:=False;
  TDocVariantData(FDoc).Clear;
  FPDoc := Value;
  SynEdit.Lines.Text:=FPDoc^.ToJSON('','',jsonHumanReadable);
  BuildTree;
  tsText.Show;
end;

procedure TformJSON.tbApplyClick(Sender: TObject);
var v: Variant; r: RawUTF8;
begin
  r:=StringToUTF8(SynEdit.Lines.Text);
  TDocVariant.New(v);
  if TDocVariantData(v).InitJSON(r) then begin
    FPDoc^.Clear;
    FPDoc^.InitCopy(v,JSON_OPTIONS[false]);
    BuildTree;
    if Assigned(FKeyNotify) then FKeyNotify(Self,StringToUTF8('mody'));
  end else begin
    SynEdit.Undo;
    if Assigned(FKeyNotify) then FKeyNotify(Self,StringToUTF8('undo'));
  end;
end;

procedure TformJSON.vstJSONDblClick(Sender: TObject);
var p: PDocVariantData; r,c: Integer;
begin
  p:= GetSeletedDoc;
  if Assigned(FOnSelectTable) then FOnSelectTable(Self, p);
end;

procedure TformJSON.vstJSONGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
  var CellText: string);
var p: PDocVariantData; d,t: PTreeData; r:RawUTF8;          //name, Kind, Value
begin
  t:=vstJSON.GetNodeData(Node);
  if (Node.Parent = nil) or (Node.Parent=vstJSON.RootNode) then p:=FPDoc
  else begin
    d:=vstJSON.GetNodeData(Node.Parent); if d=nil then Exit;
    p:=d^.Data;                          if p=nil then Exit;
  end;
  case Column of
    0: begin
      if      p^.Kind=dvObject then CellText:=UTF8ToString(p^.Names[t^.Idx])
      else if p^.Kind=dvArray  then CellText:='['+ IntToStr(t^.Idx) +']'
      else CellText:='';
    end;
    1: begin
      if t^.Data^.Kind=dvArray then CellText:='[]'
      else if t^.Data^.Kind=dvObject then CellText:='{}'
      else CellText:='::'
    end;
    2: if t^.Data^.Kind=dvUndefined then begin r := p^.Values[t^.Idx]; CellText:=UTF8ToString(r); end
                                    else CellText:='...';
  end;
end;

end.