JSONView/DBDJsonViewFrame.pas - master - YakuninAV/Convertors

JSONView/DBDJsonViewFrame.pas
394 строки12 KB
YakuninAV
begin with gitflick
31 июл 2026, 15:21
31 июл 2026, 15:211dc0fc6
unit DBDJsonViewFrame;

{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64 OWNNORMTOUPPER

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.ExtCtrls, Vcl.Grids,
  Vcl.StdCtrls, Vcl.Buttons, Vcl.Menus,
  VirtualTrees,
  SynCommons, SynEditHighlighter, SynHighlighterJSON, SynEdit,
  PIRTypes, {PIRImpDocs,} PIRTableDescriptorFrame;

type

  TTabColors = record
    Data: TColor;
    Name: TColor;
    UnitName: TColor;
    RowID: TColor;
    Bands: TColor;
  end;

type

  TfrmJsonView = class(TFrame)
    pnlTop: TPanel;
    pnlBot: TPanel;
    pgcJson: TPageControl;
    tsTree: TTabSheet;
    tsTab: TTabSheet;
    tsJSON: TTabSheet;
    vstJSON: TVirtualStringTree;
    grdJSON: TDrawGrid;
    btnNew: TSpeedButton;
    tsEdit: TTabSheet;
    lbledtName: TLabeledEdit;
    lbledtValue: TLabeledEdit;
    grpFrame: TGroupBox;
    pmTab: TPopupMenu;
    mnuTop: TMenuItem;
    mnuLeft: TMenuItem;
    mnuRight: TMenuItem;
    mnuBottom: TMenuItem;
    tsTabCfg: TTabSheet;
    clrbxData: TColorBox;
    lblTabData: TLabel;
    clrbxRowName: TColorBox;
    clrbxUnit: TColorBox;
    clrbxRowID: TColorBox;
    clrbxBands: TColorBox;
    lblRowName: TLabel;
    lblUnit: TLabel;
    lblRowID: TLabel;
    lblBands: TLabel;
    SynEditJSON: TSynEdit;
    synjsnsyn1: TSynJSONSyn;
    edtTabID: TEdit;
    edtDescrName: TEdit;
    chkRowID: TCheckBox;
    edtCountR: TEdit;
    edtCountC: TEdit;
    udCountR: TUpDown;
    udCountC: TUpDown;
    ts1: TTabSheet;
    framePIRTabDesctipor1: TframePIRTabDesctipor;
    btnApplyChanges: TBitBtn;
    procedure vstJSONGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
      var CellText: string);
    procedure grdJSONDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
    procedure vstJSONDblClick(Sender: TObject);
    procedure pgcJsonChange(Sender: TObject);
    procedure btnNewClick(Sender: TObject);
    procedure mnuTopClick(Sender: TObject);
    procedure tsTabCfgShow(Sender: TObject);
    procedure btnApplyChangesClick(Sender: TObject);
  private
    FTabFrm: TRect;
    FSelectedNode: PVirtualNode;
    FJSON: RawJSON;
    PDoc: PDocVariantData;
    PTab: PDocVariantData;
    FDoc: Variant;
    FColsCount, FRowsCount: Integer;
    FModified: Boolean;
//    FTableConfig: TPIRTableConfig;
    FTabDescr: TPIRTableDescriptor;
    procedure SetJSON(const Value: RawJSON);
    function GetJSON: RawJSON;
    { Private declarations }
    function AddValue(Parent: PVirtualNode): Boolean;
    procedure BuildNode(const Node: PVirtualNode);
    procedure ShowJSON;
    procedure ShowDescriptor(P: PDocVariantData);
  public
    { Public declarations }
    property JSON: RawJSON read GetJSON write SetJSON;
    property Modified: Boolean read FModified;
    function GetSelectedDoc: PDocVariantData;
    function CheckTable(const Doc: PDocVariantData): Boolean;
    function GetCellText(const Doc: PDocVariantData; const ARow, ACol: Integer): string;
  end;

implementation

uses
  TabColorsDlg, PIRTableDescriptionForm;

{$R *.dfm}

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

{ TfrmJsonView }

function TfrmJsonView.AddValue(Parent: PVirtualNode): Boolean;
var Node: PVirtualNode; pd, d: PTreeData; i: Integer; p: PDocVariantData; UserName: RawUTF8; Value: Variant;
begin
  Result:=False;
  pd:=vstJSON.GetNodeData(Parent);  if pd=nil then Exit;
  if pd^.Data^.Kind=dvObject then begin
    UserName:=StringToUTF8(lbledtName.Text);
    Value:=StringToUTF8(lbledtValue.Text);
    i := pd^.Data^.AddValue(UserName, Value);
    if i>=0 then begin
      p:= _Safe(pd^.Data^.Values[i]);
      Node:=vstJSON.AddChild(Parent); if Node=nil then Exit;
      d:=vstJSON.GetNodeData(Node); if d=nil then Exit;
      d^.Data:=_Safe(pd^.Data^.Values[i]);
      d^.Idx:=i;
      Result:=True;
    end;
  end;
end;

procedure TfrmJsonView.btnApplyChangesClick(Sender: TObject);
var t: TPIRTableDescriptor; n: PVirtualNode; d: PTreeData; p: PDocVariantData;
begin
  if (FSelectedNode<>nil) and (PTab<>nil) then begin
    n:=FSelectedNode^.Parent; if n=nil then Exit;
    d:= vstJSON.GetNodeData(n); if d=nil then Exit;
    p:=d^.Data; if p=nil then Exit;
    ShowDescriptor(p);
  end;

  if p<>nil then begin
    t := TPIRTableDescriptor.Create(p);
    ShowTableDescriptorForm(t);
  end;
end;

procedure TfrmJsonView.btnNewClick(Sender: TObject);
var Node, prnt: PVirtualNode; pd, d: PTreeData; i: Integer; p: PDocVariantData;
begin
  Node:=vstJSON.GetFirstSelected(); if Node=nil then Exit;
  prnt:=Node^.Parent;

  pd:=vstJSON.GetNodeData(prnt);  if pd=nil then Exit;
  if pd^.Data^.Kind=dvObject then begin
    i := pd^.Data^.AddValue('added', 'value');
    if i>=0 then begin
      p:= _Safe(pd^.Data^.Values[i]);
      Node:=vstJSON.AddChild(prnt); if Node=nil then Exit;
      d:=vstJSON.GetNodeData(Node); if d=nil then Exit;
      d^.Data:=_Safe(pd^.Data^.Values[i]);
      d^.Idx:=i;
      FModified:=True;
    end;
  end;
end;

procedure TfrmJsonView.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;

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

function TfrmJsonView.GetCellText(const Doc: PDocVariantData; const ARow, ACol: Integer): string;
var s:string; p: PDocVariantData; v: Variant;
begin
  if Doc=nil then Exit;
  p:=Doc^._[ARow]; if p=nil then Exit;
  if p^.Count>ACol then begin
    v:=p^.Values[ACol];
    if      TDocVariantData(v).Kind=dvArray  then s:='[..]'
    else if TDocVariantData(v).Kind=dvObject then s:='{..}'
    else begin
      if v=null then s:='null'
                else s:=UTF8ToString(v);
    end;
  end;
  Result:=s;
end;

function TfrmJsonView.GetJSON: RawJSON;
begin
  Result := PDoc^.ToJSON('','', jsonHumanReadable);
end;

function TfrmJsonView.GetSelectedDoc: PDocVariantData;
var p: PTreeData;
begin
  FSelectedNode:=vstJSON.GetFirstSelected();
  Result:=nil;
  if FSelectedNode<>nil then begin
    p:=vstJSON.GetNodeData(FSelectedNode);
    if p<>nil then Result:=p^.Data;
  end;
end;

procedure TfrmJsonView.grdJSONDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState);
var s:string; p: PDocVariantData; v: Variant; br: TBrush;
begin
  if PTab=nil then Exit;
  br:=grdJSON.Canvas.Brush;
  if ARow=0 then begin
    grdJSON.Canvas.Brush.Color:=clMenu;
    grdJSON.Canvas.FillRect(Rect);
  end;
  if FTabFrm.Contains(TPoint.Create(ACol,ARow)) then begin
    grdJSON.Canvas.Brush.Color:=clYellow;
    grdJSON.Canvas.FillRect(Rect);
  end;
  grdJSON.Canvas.Brush:=br;
  p:=PTab^._[ARow]; if p=nil then Exit;
  if p^.Count>ACol then begin
    v:=p^.Values[ACol];
    if      TDocVariantData(v).Kind=dvArray  then s:='[..]'
    else if TDocVariantData(v).Kind=dvObject then s:='{..}'
    else begin
      if v=null then s:='null'
                else s:=UTF8ToString(v);
    end;
  end;
  grdJSON.Canvas.TextRect(Rect,s);
end;

procedure TfrmJsonView.mnuTopClick(Sender: TObject);
begin
  FTabFrm.Top:=grdJSON.Selection.Top;
  FTabFrm.Left:=grdJSON.Selection.Left;
  grdJSON.Repaint;
end;

procedure TfrmJsonView.pgcJsonChange(Sender: TObject);
begin
  if pgcJson.ActivePage=tsTab then begin
    grdJSON.ColCount:=FColsCount;
    grdJSON.RowCount:=FRowsCount;
  end;
end;

procedure TfrmJsonView.SetJSON(const Value: RawJSON);
begin
  TDocVariant.New(FDoc);
  if TDocVariantData(FDoc).InitJSON(Value) then PDoc:=_Safe(FDoc)
                                           else PDoc:=@DocVariantDataFake;
  ShowJSON;
  SynEditJSON.Lines.Text:=TDocVariantData(FDoc).ToJSON('','',jsonHumanReadable);
end;

procedure TfrmJsonView.ShowDescriptor(P: PDocVariantData);
begin
  FTabDescr := TPIRTableDescriptor.Create(P);
  edtTabID.Text:=FTabDescr.ID;
  edtDescrName.Text:=FTabDescr.Name;
  chkRowID.Checked:=FTabDescr.RowID;
  edtCountR.Text := FTabDescr.RowCount.ToString;
  edtCountC.Text := FTabDescr.ColCount.ToString;
//                    FTabDescr.Kind;
//                    FTabDescr.PriceKind;
//                    FTabDescr.MeashureOfPrice;
//                    FTabDescr.RC_Data;
//                    FTabDescr.RC_Name;
//                    FTabDescr.RC_Unit;
//                    FTabDescr.RC_Parameters;
//                    FTabDescr.ParamCount;
{
  TDocVariantData(Result).AddValue('prk', Ord(FPriceKind));
  TDocVariantData(Result).AddValue('mpr', Ord(FMeashureOfPrice));
  TDocVariantData(Result).AddValue('dat', FRC_Data.ToDoc);
  TDocVariantData(Result).AddValue('nam', FRC_Name.ToDoc);
  TDocVariantData(Result).AddValue('uni', FRC_Unit.ToDoc);
}
  framePIRTabDesctipor1.TableDescriptor:=FTabDescr;
end;

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

procedure TfrmJsonView.tsTabCfgShow(Sender: TObject);
var n: PVirtualNode; d: PTreeData; p: PDocVariantData;
begin
  if (FSelectedNode<>nil) and (PTab<>nil) then begin
    n:=FSelectedNode^.Parent; if n=nil then Exit;
    d:= vstJSON.GetNodeData(n); if d=nil then Exit;
    p:=d^.Data; if p=nil then Exit;
    ShowDescriptor(p);
  end;
end;

procedure TfrmJsonView.vstJSONDblClick(Sender: TObject);
var p: PDocVariantData;
begin
  p:=GetSelectedDoc; PTab:=nil;
  if (p<>nil) and (p^.Kind=dvArray) then begin
    if CheckTable(p) then begin
      PTab:=p;
      grdJSON.ColCount:=FColsCount;
      grdJSON.RowCount:=FRowsCount;
      FTabFrm.Top:=1; FTabFrm.Left:=1;
      FTabFrm.Bottom:=FRowsCount; FTabFrm.Right:=FColsCount;
      pgcJson.ActivePage:=tsTab;
    end;
  end;
end;

procedure TfrmJsonView.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:=PDoc
  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.