xtool/contrib/mORMot/SQLite3/Samples/ThirdPartyDemos/EMartin/SynJSONTreeview/SynJSONTreeView.pas

/// JSON tree view bases on Synopse JSON parser
// - based on JSON TreeView VCL Component from pawel.glowacki@embarcadero.com
// - this unit is a part of the freeware Synopse mORMot framework,
// licensed under a MPL/GPL/LGPL tri-license; version 1.18
unit SynJSONTreeView;

{
    This file is part of Synopse framework.

    Synopse framework. Copyright (C) 2022 Arnaud Bouchez
      Synopse Informatique - https://synopse.info

  *** BEGIN LICENSE BLOCK *****
  Version: MPL 1.1/GPL 2.0/LGPL 2.1

  The contents of this file are subject to the Mozilla Public License Version
  1.1 (the "License"); you may not use this file except in compliance with
  the License. You may obtain a copy of the License at
  http://www.mozilla.org/MPL

  Software distributed under the License is distributed on an "AS IS" basis,
  WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
  for the specific language governing rights and limitations under the License.

  The Original Code is Synopse mORMot framework.

  The Initial Developer of the Original Code is Arnaud Bouchez.

  Portions created by the Initial Developer are Copyright (C) 2022
  the Initial Developer. All Rights Reserved.

  Contributor(s):
  - Esteban Martin (EMartin)

  Alternatively, the contents of this file may be used under the terms of
  either the GNU General Public License Version 2 or later (the "GPL"), or
  the GNU Lesser General Public License Version 2.1 or later (the "LGPL"),
  in which case the provisions of the GPL or the LGPL are applicable instead
  of those above. If you wish to allow use of your version of this file only
  under the terms of either the GPL or the LGPL, and not to allow others to
  use your version of this file under the terms of the MPL, indicate your
  decision by deleting the provisions above and replace them with the notice
  and other provisions required by the GPL or the LGPL. If you do not delete
  the provisions above, a recipient may use your version of this file under
  the terms of any one of the MPL, the GPL or the LGPL.

  ***** END LICENSE BLOCK *****

  Version 1.18
  - first public release, corresponding to Synopse mORMot Framework 1.18

TODO:
- FPC support (I just use Windows)
- Developed with Delphi 7, not tested with other Delphi versions
}

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

interface

uses
  SysUtils,
  Classes,
  ComCtrls,
  Controls,
  SynCommons,
  SynTable;

type
  ESynJSONTreeView = class(ESynException);
  TSynJSONTreeNode = class;

  /// Tree node types
  // - jtnObject: JSON object, i.e: {"fieldNumber":123,"fieldText":"text","fieldNull":null}
  // - jtnObjectContent: conten of jtnObject, i.e: "fieldNumber":123
  // - jtnArray: JSON array, i.e: [123,"text",{"fieldNumber":123,"fieldText":"text","fieldNull":null},null]
  // - jtnArrayContent: content of jtnArray, i.e: 123 or {"fieldNumber":123,"fieldText":"text","fieldNull":null}
  TSynJSONTreeNodeType = (jtnObject, jtnObjectContent, jtnArray, jtnArrayContent);

  /// Event type for fire event when editing
  TSynJSONTreeViewCustomInputEvent = procedure(Sender: TObject; Node: TSynJSONTreeNode;
                                               var Prompt: RawUTF8; var Value: Variant;
                                               var Handled: Boolean) of object;
  /// Node extension for handling JSON value in the treeview
  TSynJSONTreeNode = class(TTreeNode)
  protected
    fName: RawUTF8;
    fJSONType: TSynJSONTreeNodeType;
    fValue: Variant;
  public
    /// Clone the node
    function Clone: TSynJSONTreeNode;
    /// JSON type in the node
    property JSONType: TSynJSONTreeNodeType read fJSONType write fJSONType;
    /// Name of the JSON value
    property Name: RawUTF8 read FName write fName;
    /// JSON value
    property Value: Variant read fValue write fValue;
  end;

  /// Allowed edition states of treeview
  // - estEdit: allow edit a node
  // - estDelete: allow delete a node
  // - estInsert: allow insert a node
  TSynJSONTreeViewEditionStateType = (estEdit , estDelete, estInsert);
  TSynJSONTreeViewEditionStateSet = set of TSynJSONTreeViewEditionStateType;

  /// TSynJSONTreeView is a treeview supporting mORMOn JSON document (TDocVariantData), the allowed tasks are:
  // - edit a node
  // - delete a node
  // - add a node
  // - save to file
  // - load from file
  // - generate JSON to string variable
  // - implement a custom input for edit/insert node
  TSynJSONTreeView = class(TTreeView)
  private
    fAllowedEditionStates: TSynJSONTreeViewEditionStateSet;
  protected
    fFirsttime: Boolean;
    fJSONDocument: Variant;
    fJSONText: RawUTF8;
    fKey: Integer;
    fOnDblClickBak: TNotifyEvent;
    fOnEditingBak: TTVEditingEvent;
    fOnKeyDownBak: TKeyEvent;
    fOnCustomInput: TSynJSONTreeViewCustomInputEvent;
    fVisibleChildrenCounts: boolean;
    fVisibleByteSizes: boolean;
    /// Add child node from JSON value
    // - aNode: node from which add the child
    // - aJSON: JSON value single or object/array
    // - aNameOrIndex: if it is numeric, then is the index into the object/array, otherwise the name of the container node
    function AddChildFromJSON(const aNode: TSynJSONTreeNode; const aJSON: Variant; const aNameOrIndex: Variant): TSynJSONTreeNode;
    procedure BackupEvents;
    procedure DeleteNode(Node: TSynJSONTreeNode; const aAsk: Boolean = True);
    procedure DoOnCreateNodeClass(Sender: TCustomTreeView; var NodeClass: TTreeNodeClass);
    procedure DoOnDblClick(Sender: TObject);
    procedure DoOnEditing(Sender: TObject; Node: TTreeNode; var AllowEdit: Boolean);
    procedure DoOnKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure EditNode(Node: TSynJSONTreeNode);
    procedure InsertNode(Node: TSynJSONTreeNode; const aJSON: Variant);
    function IsActive: Boolean;
    function IsSimpleJsonValue(v: Variant): boolean;{$ifdef HASINLINE}inline;{$endif}
    procedure ProcessArray(const aCurrNode: TSynJSONTreeNode; const aValue: Variant; const aNameOrIndex: Variant);
    procedure ProcessElement(currNode: TSynJSONTreeNode; arr: Variant; aIndex: integer);
    function ProcessJSONText: boolean;
    procedure ProcessObject(const aCurrNode: TSynJSONTreeNode; const aValue: Variant; const aNameOrIndex: Variant);
    function ProcessPair(currNode: TSynJSONTreeNode; obj: Variant; aIndex: integer): TSynJSONTreeNode;
    /// Assign and process the JSON text
    // - if Value is null then clear the JSON text and the treeview content
    procedure SetJSONText(const Value: RawUTF8);
    /// Assign mORMot JSON Document
    // - if Value is not equal to the previous value then load the JSON into the treeview
    procedure SetSynJSONDocument(const Value: Variant);
    /// Show how many children has a container node
    procedure SetVisibleChildrenCounts(const Value: boolean);
    /// Show byte size of a container node
    procedure SetVisibleByteSizes(const Value: boolean);
    /// Update info of a container node
    procedure UpdateNodeInfo(aNode: TSynJSONTreeNode);
    /// Get the original value from variant value
    function VariantToRaw(const aVarData: Variant): Variant;
    /// Assign source variant to dest variant but considering the dest data type
    procedure VariantToVariant(aSource: Variant; var aDest: Variant);
    /// Convert variant to UTF8 but checking the boolean type and convert it to true/false string
    function VarToUTF8(const aVarData: Variant): RawUTF8;
  public
    constructor Create(AOwner: TComponent); override;

    /// Remove items and JSON text
    procedure ClearAll;
    /// Load from file
    procedure LoadFromFile(const aFileName: TFileName);
    /// Load the JSONText in the treeview, clear if empty
    procedure LoadJSON;
    /// Save to file
    procedure SaveToFile(const aFileName: TFileName);
    /// Generate JSON from the treeview
    function ToJSON: RawUTF8;

    /// JSON DocVariantData
    property JSONDocument: Variant read FJSONDocument write SeTSynJSONDocument;
  published
    /// Allowed state editions
    property AllowedEditionStates: TSynJSONTreeViewEditionStateSet read fAllowedEditionStates write fAllowedEditionStates;
    /// Content the JSON text, when assigned parse the the JSON and load in the treeview
    property JSONText: RawUTF8 read fJSONText write SetJSONText;
    /// Display info over how many children has each node
    property VisibleChildrenCounts: boolean read FVisibleChildrenCounts write SetVisibleChildrenCounts;
    /// Display info over the size of node
    property VisibleByteSizes: boolean read FVisibleByteSizes write SetVisibleByteSizes;
    /// Event fired when editing for custom input
    property OnCustomInput: TSynJSONTreeViewCustomInputEvent read fOnCustomInput write fOnCustomInput;
  end;

implementation

uses
  Windows,
  Variants,
  mORMotUILogin;

resourcestring
  SInvalidJSONValue = 'Invalid JSON value';
  SInvalidJSON = 'Invalid JSON: %';
  SEnterValue = 'Enter Value';
  SInsertNewItem = 'Insert new item';
  SInsertNewItemPrompt = 'Enter JSON:\n\n object: <name>:<value>\n array: [<index>]:<value>\n\n ' +
                         'In array the brackets are required.';
  SRemoveChildren = 'This node has children, are you sure to remove them';
  SDeleteNode = 'Delete node\n\n% ?';

{ TSynJSONTreeView }

procedure TSynJSONTreeView.ClearAll;
begin
  SetJSONText('');
  Items.Clear;
end;

constructor TSynJSONTreeView.Create(AOwner: TComponent);
begin
  inherited;
  OnCreateNodeClass := DoOnCreateNodeClass;
  fAllowedEditionStates := [estEdit, estDelete, estInsert];
  fFirstTime := True;
  FVisibleChildrenCounts := true;
  FVisibleByteSizes := false;
end;

procedure TSynJSONTreeView.LoadJson;
var
  v: Variant;
begin
  BackupEvents;
  Items.Clear;

  if IsActive then
  begin
    v := fJSONDocument;
    Items.Clear;

    if (v._Kind = dvObject) then
      ProcessObject(nil, v, Unassigned)
    else if (v._Kind = dvArray) then
      ProcessArray(nil, v, Unassigned)
    else
      raise ESynJSONTreeView.Create(SInvalidJSONValue);

    FullExpand;
  end;
end;

function TSynJSONTreeView.ProcessPair(currNode: TSynJSONTreeNode; obj: Variant; aIndex: integer): TSynJSONTreeNode;
var
  p: Variant;
begin
  Result := nil;

  p := obj._(aIndex);

  if IsSimpleJsonValue(p) then
  begin
    AddChildFromJSON(currNode, obj, aIndex);
    Exit;
  end;

  if (p._Kind = dvObject) then
    ProcessObject(currNode, _CopyFast(p), obj.Name(aIndex))
  else if (p._Kind = dvArray) then
    ProcessArray(currNode, _CopyFast(p), obj.Name(aIndex))
  else
    raise ESynJSONTreeView.Create(SInvalidJSONValue);
end;

procedure TSynJSONTreeView.ProcessElement(currNode: TSynJSONTreeNode; arr: Variant; aIndex: integer);
var
  v: Variant;
begin
  v := arr._(aIndex);

  if IsSimpleJsonValue(v) then
  begin
    AddChildFromJSON(currNode, arr, aIndex);
    Exit;
  end;

  if (v._Kind = dvObject) then
    ProcessObject(currNode, _CopyFast(v), IntToStr(aIndex))
  else if (v._Kind = dvArray) then
    ProcessArray(currNode, _CopyFast(v), aIndex)
  else
    raise ESynJSONTreeView.Create(SInvalidJSONValue);
end;

procedure TSynJSONTreeView.SetSynJSONDocument(const Value: Variant);
begin
  if fJSONDocument <> Value then
  begin
    fJSONDocument := Value;
    ClearAll;
    if IsActive then
      LoadJson;
  end;
end;

procedure TSynJSONTreeView.SetVisibleByteSizes(const Value: boolean);
begin
  if FVisibleByteSizes <> Value then
  begin
    FVisibleByteSizes := Value;
    LoadJson;
  end;
end;

procedure TSynJSONTreeView.SetVisibleChildrenCounts(const Value: boolean);
begin
  if FVisibleChildrenCounts <> Value then
  begin
    FVisibleChildrenCounts := Value;
    LoadJson;
  end;
end;

function TSynJSONTreeView.VarToUTF8(const aVarData: Variant): RawUTF8;
begin
  if (TVarData(aVarData).VType = varBoolean) then
  begin
    if TVarData(aVarData).VBoolean then
      Result := 'true'
    else
      Result := 'false';
  end else
    Result := VariantToUTF8(aVarData);
end;

function TSynJSONTreeView.ToJSON: RawUTF8;
var
  lW: TTextWriter;

  procedure ProcessNode(aNode: TSynJSONTreeNode);

    procedure CheckLastComma(aW: TTextWriter);
    begin
      if (aW.TextLength > 0) and (not (aW.LastChar in [',','[','{'])) then
        aW.Add(',');
    end;

  var
    lNode: TSynJSONTreeNode;
  begin
    lNode := aNode;
    repeat
      if Assigned(lNode) then begin
        case lNode.JSONType of
          jtnObject:
          begin
            CheckLastComma(lW);
            // numeric name is excluded
            if (lNode.Name <> '') and (StrToIntDef(lNode.Name, MaxInt) = MaxInt) then
              lW.AddFieldName(lNode.Name);
            lW.Add('{');
          end;
          jtnArray:
          begin
            CheckLastComma(lW);
            if (lNode.Name <> '') then
              lW.AddFieldName(lNode.Name);
            lW.Add('[');
          end;
          jtnObjectContent:
          begin
            CheckLastComma(lW);
            lW.AddFieldName(lNode.Name);
            lW.AddVariant(lNode.Value);
            lW.Add(',');
          end;
          jtnArrayContent:
          begin
            CheckLastComma(lW);
            lW.AddVariant(lNode.Value);
            lW.Add(',');
          end;
        end;
      end;
      if lNode.HasChildren then begin
        ProcessNode(TSynJSONTreeNode(lNode.GetFirstChild));
        lW.CancelLastComma;
        case lNode.JSONType of
          jtnObject: lW.Add('}');
          jtnArray: lW.Add(']');
        end;
      end;
      lNode := TSynJSONTreeNode(lNode.GetNextSibling);
    until not Assigned(lNode);
  end;

begin
  lW := TTextWriter.CreateOwnedStream;
  try
    ProcessNode(TSynJSONTreeNode(Items.GetFirstNode));
    lW.CancelLastComma;
    lW.SetText(Result);
  finally
    lW.Free;
  end;
end;

procedure TSynJSONTreeView.DoOnCreateNodeClass(Sender: TCustomTreeView; var NodeClass: TTreeNodeClass);
begin
  NodeClass := TSynJSONTreeNode;
end;

function TSynJSONTreeView.VariantToRaw(const aVarData: Variant): Variant;
var
  lVar: TSQLVar;
  lTmp: RawByteString;
begin
  if VarIs(aVarData, [varBoolean]) then
  begin
    Result := aVarData;
    Exit;
  end;
  VariantToSQLVar(aVarData, lTmp, lVar);
  with lVar do
    case VType of
      ftNull: Result := null;
      ftCurrency: Result := VInt64;
      ftUTF8:
        if Assigned(VText) then
          Result := RawUTF8(PUTF8Char(VText))
        else
          Result := '';
      ftInt64: Result := VInt64;
      ftDouble: Result := VDouble;
  end;
end;

procedure TSynJSONTreeView.DoOnDblClick(Sender: TObject);
begin
  if ReadOnly or (Selected.Count > 0) or (not (estEdit in fAllowedEditionStates)) then
    Exit;

  EditNode(TSynJSONTreeNode(Selected));
  if Assigned(fOnDblClickBak) then
    fOnDblClickBak(Sender);
end;

function TSynJSONTreeView.IsActive: Boolean;
begin
  Result := (fJSONDocument <> Unassigned) and (not VarIsEmptyOrNull(fJSONDocument)) and (fJSONDocument._Kind <> dvUndefined);
end;

function TSynJSONTreeView.IsSimpleJsonValue(v: Variant): boolean;
begin
  Result := VarIsEmptyOrNull(v) or VarIsNumeric(v) or VarIsStr(v) or VarIsStr(v);
end;

procedure TSynJSONTreeView.SetJSONText(const Value: RawUTF8);
begin
  if fJSONText <> Value then
  begin
    fJSONText := Value;
    if fJSONText <> '' then
      ProcessJSONText
    else
    begin
      TDocVariantData(fJSONDocument).Clear;
      fJSONDocument := Unassigned;
    end;
  end;
end;

function TSynJSONTreeView.ProcessJSONText: boolean;
begin
  if IsActive then
    fJSONDocument.Clear;
  TDocVariantData(fJSONDocument).InitJSON(fJSONText);
  if (TDocVariantData(fJSONDocument).Kind = dvUndefined) then
    raise ESynJSONTreeView.CreateUTF8(SInvalidJSON, [fJSONText]);
  Result := IsActive;
end;

procedure TSynJSONTreeView.BackupEvents;
begin
  if not fFirstTime then
    Exit;

  if not Assigned(fOnDblClickBak) and Assigned(OnDblClick) then
    fOnDblClickBak := OnDblClick;
  OnDblClick := DoOnDblClick;

  if not Assigned(fOnEditingBak) and Assigned(OnEditing) then
    fOnEditingBak := OnEditing;
  OnEditing := DoOnEditing;

  if not Assigned(fOnKeyDownBak) and Assigned(OnKeyDown) then
    fOnKeyDownBak := OnKeyDown;
  OnKeyDown := DoOnKeyDown;

  fFirstTime := False;
end;

procedure TSynJSONTreeView.DoOnKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if ReadOnly or (not (Key in [VK_DELETE, VK_INSERT, VK_RETURN])) or
     ((Key = VK_DELETE) and (not (estDelete in fAllowedEditionStates))) or
     ((Key = VK_RETURN) and (not (estEdit in fAllowedEditionStates))) or
     ((Key = VK_INSERT) and (not (estInsert in fAllowedEditionStates))) then
    Exit;

  case Key of
    VK_DELETE: DeleteNode(TSynJSONTreeNode(Selected));
    VK_INSERT: InsertNode(TSynJSONTreeNode(Selected), Unassigned);
    VK_RETURN: EditNode(TSynJSONTreeNode(Selected));
  end;

  if Assigned(fOnKeyDownBak) then
    fOnKeyDownBak(Sender, Key, Shift);
end;

procedure TSynJSONTreeView.UpdateNodeInfo(aNode: TSynJSONTreeNode);

  procedure UpdateNodeText(aNode: TSynJSONTreeNode; const aText: RawUTF8);
  begin
    if not VarIsNull(aNode.Value) then
      aNode.Text := aText
    else
      aNode.Text := aNode.Name + ': null';
  end;

begin
  case aNode.JSONType of
    jtnObject: begin
      if (not Assigned(aNode.Parent)) or (TSynJSONTreeNode(aNode.Parent).JSONType <> jtnArray) then
        UpdateNodeText(aNode, aNode.Name + ' {}')
      else
        UpdateNodeText(aNode, FormatUTF8('[%] {}', [aNode.Name]));
    end;
    jtnArray:
      if not VarIsNull(aNode.Value) then
        UpdateNodeText(aNode, aNode.Name + ' []');
  end;

  case aNode.JSONType of
    jtnObject, jtnArray: begin
      if VisibleChildrenCounts then
        if not VarIsNull(aNode.Value) then
          UpdateNodeText(aNode, aNode.Text + ' (' + IntToStr(aNode.Value._Count) + ')')
        else
          UpdateNodeText(aNode, '');

      if VisibleByteSizes then
        if not VarIsNull(aNode.Value) then
          UpdateNodeText(aNode, aNode.Text + ' (size: ' + IntToStr(Length(aNode.Value._JSON)) + ' bytes)')
        else
          UpdateNodeText(aNode, '');
    end;
    jtnObjectContent, jtnArrayContent: begin
      UpdateNodeText(aNode, '');
    end;
  end;
end;

procedure TSynJSONTreeView.DeleteNode(Node: TSynJSONTreeNode; const aAsk: Boolean);

  procedure RecalculateChildNames(aNode: TSynJSONTreeNode);
  var
    lNode: TSynJSONTreeNode;
    I: Integer;
  begin
    lNode := TSynJSONTreeNode(aNode.GetFirstChild);
    if not Assigned(lNode) then
      Exit;
    I := 0;
    case lNode.JSONType of
      jtnObject: begin
        repeat
          if Assigned(lNode) then begin
            if (StrToIntDef(lNode.Name, MaxInt) <> MaxInt) then
              lNode.Name := IntToStr(I);
            UpdateNodeInfo(lNode);
            Inc(I);
          end;
          lNode := TSynJSONTreeNode(lNode.getNextSibling);
        until not Assigned(lNode);
      end;
      jtnArrayContent: begin
        repeat
          if Assigned(lNode) then begin
            lNode.Name := IntToStr(I);
            lNode.Text := UTF8ToString(FormatUTF8('[%]: %', [lNode.Name, lNode.Value]));
            Inc(I);
          end;
          lNode := TSynJSONTreeNode(lNode.getNextSibling);
        until not Assigned(lNode);
      end;
    end;
  end;

  procedure UpdateEmptyParent(aParent: TSynJSONTreeNode);
  begin
    if (aParent.Count = 0) then begin
      aParent.Value := NULL;
      case TSynJSONTreeNode(aParent.Parent).JSONType of
        jtnObject: aParent.JSONType := jtnObjectContent;
        jtnArray: aParent.JSONType := jtnArrayContent;
      end;
    end;
  end;

var
  lParent, lDeletedNode: TSynJSONTreeNode;
begin
  if aAsk then
    if (YesNo(UTF8ToString(FormatUTF8(SDeleteNode, [Node.Text])), '', False) <> mrYes) then
      Exit;
  lDeletedNode := Node.Clone;
  lParent := TSynJSONTreeNode(Node.Parent);
  Items.BeginUpdate;
  try
    Node.Delete;
    Node := lDeletedNode;
    // if node name is empty it means that the JSON object is empty
    if (Node.Name = '') then begin
      ClearAll;
      Exit;
    end;
    case Node.JSONType of
      jtnArray, jtnObject: begin
        if (StrToIntDef(Node.Name, MaxInt) <> MaxInt) then
          TDocVariantData(lParent.Value).Delete(StrToInt(Node.Name))
        else
          TDocVariantData(lParent.Value).Delete(Node.Name);
        if (lParent.Count = 0) then
          UpdateEmptyParent(lParent)
        else
          RecalculateChildNames(lParent);
        UpdateNodeInfo(lParent);
      end;
      jtnArrayContent: begin
        TDocVariantData(lParent.Value).Delete(StrToInt(Node.Name));
        if (lParent.Count = 0) then
          UpdateEmptyParent(lParent)
        else
          RecalculateChildNames(lParent);
        UpdateNodeInfo(lParent);
      end;
      jtnObjectContent: begin
        TDocVariantData(lParent.Value).Delete(Node.Name);
        if (lParent.Count = 0) then
          UpdateEmptyParent(lParent);
        UpdateNodeInfo(lParent);
      end;
    end;
  finally
    Items.EndUpdate;
  end;
end;

procedure TSynJSONTreeView.InsertNode(Node: TSynJSONTreeNode; const aJSON: Variant);
var
  lJSON: Variant;
  lPrompt: RawUTF8;
  lValue: Variant;
  I: Integer;
  lCount: Integer;
  lHandled: Boolean;
begin
  if (aJSON = Unassigned) then begin
    lPrompt := SInsertNewItemPrompt;

    if Assigned(fOnCustomInput) then
      fOnCustomInput(Self, Node, lPrompt, lValue, lHandled);

    if not lHandled then
      lValue := InputBox(SInsertNewItem, lPrompt, '');


    if (lValue = '') then
      Exit;

    if (lValue[1] <> '[') then
      if (lValue[1] <> '{') then
        lValue := '{' + lValue + '}';
    TDocVariantData(lJSON).InitJSON(lValue);
    if (TDocVariantData(lJSON).Kind = dvUndefined) then
      raise ESynJSONTreeView.CreateUTF8(SInvalidJSON, [lValue]);
  end else
    lJSON := aJSON;
  // always will be an object the inserted node
  lCount := lJSON._Count;
  TDocVariantData(TSynJSONTreeNode(Node).Value).AddOrUpdateObject(lJSON);
  for I := 0 to lCount-1 do begin
    lValue := lJSON._(I);
    if IsSimpleJsonValue(lValue) then begin
      AddChildFromJSON(Node, lJSON, I);
    end else
      ProcessObject(Node, _CopyFast(lValue), lJSON.Name(I));
  end;
  UpdateNodeInfo(Node);
end;

function TSynJSONTreeView.AddChildFromJSON(const aNode: TSynJSONTreeNode; const aJSON: Variant; const aNameOrIndex: Variant): TSynJSONTreeNode;
var
  lValue: Variant;
begin
  Result := TSynJSONTreeNode(Items.AddChild(aNode, ''));
  if not VarIsEmpty(aNameOrIndex) and (VariantToIntegerDef(aNameOrIndex, -1) <> -1) then
    lValue := VariantToRaw(aJSON._(aNameOrIndex))
  else
    lValue := aJSON;

  if (TDocVariantData(lValue).Kind <> dvUndefined) then
    Result.Value := _CopyFast(lValue)
  else
    Result.Value := lValue;

  case TDocVariantData(aJSON).Kind of
    dvObject:
      if not VarIsEmpty(aNameOrIndex) then begin
        // is name or index is numeric, the text property is assigned showing the name and value, otherwise is a
        // container node
        if (VariantToIntegerDef(aNameOrIndex, -1) <> -1) then begin
          Result.Name := aJSON.Name(aNameOrIndex);
          Result.JSONType := jtnObjectContent;
          Result.Text := Result.Name + ': ' + VarToUTF8(lValue);
        end else begin
          Result.Name := aNameOrIndex;
          Result.JSONType := jtnObject;
        end;
      end;
    dvArray:
      if not VarIsEmpty(aNameOrIndex) then begin
        // is name or index is numeric, the text property is assigned showing the name and value, otherwise is a
        // container node
        if (VariantToIntegerDef(aNameOrIndex, -1) <> -1) then begin
          Result.Name := aNameOrIndex;
          Result.JSONType := jtnArrayContent;
          Result.Text := IntToStr(aNameOrIndex) + ': ' + VarToUTF8(lValue);
        end else begin
          Result.Name := aNameOrIndex;
          Result.JSONType := jtnArray;
        end;
      end;
  end;
end;

procedure TSynJSONTreeView.ProcessObject(const aCurrNode: TSynJSONTreeNode; const aValue: Variant; const aNameOrIndex: Variant);
var
  lCount: Integer;
  I: Integer;
  lCurrNode: TSynJSONTreeNode;
begin
  lCurrNode := AddChildFromJSON(aCurrNode, aValue, aNameOrIndex);
  UpdateNodeInfo(lCurrNode);
  lCount := aValue._Count;
  for I := 0 to lCount - 1 do
    ProcessPair(lCurrNode, _CopyFast(aValue), I);
end;

procedure TSynJSONTreeView.ProcessArray(const aCurrNode: TSynJSONTreeNode; const aValue: Variant; const aNameOrIndex: Variant);
var
  lCount: Integer;
  I: Integer;
  lCurrNode: TSynJSONTreeNode;
begin
  lCurrNode := AddChildFromJSON(aCurrNode, aValue, aNameOrIndex);
  UpdateNodeInfo(lCurrNode);
  lCount := aValue._Count;
  for I := 0 to lCount - 1 do
    ProcessElement(lCurrNode, aValue, I);
end;

procedure TSynJSONTreeView.EditNode(Node: TSynJSONTreeNode);
var
  lPrompt: RawUTF8;
  lJSON, lValue, lDestValue: Variant;
  lHandled: Boolean;
begin
  lPrompt := UTF8ToString(TSynJSONTreeNode(Selected).Name);
  if (Selected.Text[1] = '[') then
    lPrompt := FormatUTF8('[%]', [lPrompt]);
  lValue := '';
  if not VarIsNull(TSynJSONTreeNode(Selected).Value) then
    lValue := TSynJSONTreeNode(Selected).Value;
  if Assigned(fOnCustomInput) then
    fOnCustomInput(Self, Node, lPrompt, lValue, lHandled);
  if not lHandled then
    lValue := InputBox(SEnterValue, lPrompt, lValue);

  // if not modification, exit
  if (lValue = TSynJSONTreeNode(Selected).Value) then
    Exit;

  // remove children if input data was null
  if (TDocVariantData(lValue).Kind = dvUndefined) and
     ((lValue = '') or IdemPChar(pointer(VariantToUTF8(lValue)), 'NULL')) and
     Selected.HasChildren then begin
    if (YesNo(SRemoveChildren, '', False) = mrYes) then begin
      Selected.DeleteChildren;
      TSynJSONTreeNode(Selected).Value := NULL;
      UpdateNodeInfo(TSynJSONTreeNode(Selected));
      Exit;
    end;
  end;

  TDocVariantData(lJSON).InitJSON(lValue);
  case TDocVariantData(lJSON).Kind of
    dvUndefined: begin
      Selected.Text := FormatUTF8('%: %', [lPrompt, lValue]);
      lDestValue := TSynJSONTreeNode(Selected).Value;
      VariantToVariant(lValue, lDestValue);
      TSynJSONTreeNode(Selected).Value := lDestValue;
      if Assigned(Selected.Parent) then begin
        case TSynJSONTreeNode(Selected.Parent).JSONType of
          jtnObject: TSynJSONTreeNode(Selected).JSONType := jtnObjectContent;
          jtnArray: begin
            TSynJSONTreeNode(Selected).JSONType := jtnArrayContent;
            TDocVariantData(TSynJSONTreeNode(Selected.Parent).Value).Values[StrToInt(TSynJSONTreeNode(Selected).Name)] :=
              TSynJSONTreeNode(Selected).Value;
          end;
        end;
      end;
    end;
  else
    case TDocVariantData(lJSON).Kind of
      dvObject: TSynJSONTreeNode(Selected).JSONType := jtnObject;
      dvArray: TSynJSONTreeNode(Selected).JSONType := jtnArray;
    end;
    Node.Value := _CopyFast(lJSON);
    if Node.HasChildren then
      Node.DeleteChildren;
    InsertNode(Node, lJSON);
    UpdateNodeInfo(Node);
  end;
end;

procedure TSynJSONTreeView.LoadFromFile(const aFileName: TFileName);
begin
  if (aFileName = '') then
    Exit;
  SetJSONText(StringFromFile(aFileName));
  LoadJSON;
end;

procedure TSynJSONTreeView.SaveToFile(const aFileName: TFileName);
var
  lJSON: RawUTF8;
begin
  if (aFileName = '') then
    Exit;
  lJSON := ToJSON;
  FileFromString(lJSON, aFileName);
end;

procedure TSynJSONTreeView.DoOnEditing(Sender: TObject; Node: TTreeNode; var AllowEdit: Boolean);
begin
  AllowEdit := (estEdit in fAllowedEditionStates);
  if AllowEdit and Assigned(fOnEditingBak) then
    fOnEditingBak(Sender, Node, AllowEdit);
end;

procedure TSynJSONTreeView.VariantToVariant(aSource: Variant; var aDest: Variant);
var
  lVar: TSQLVar;
  lTmp: RawByteString;
begin
  VariantToSQLVar(aDest, lTmp, lVar);
  with lVar do
    case VType of
      ftNull: aDest := aSource;
      ftCurrency:  aDest := aSource.VInt64;
      ftUTF8: aDest := VariantToUTF8(aSource);
      ftInt64: begin
        if (aSource <> '') then
          if (UpperCaseU(aSource) <> 'TRUE') and  (UpperCaseU(aSource) <> 'FALSE') then begin
            aDest := StrToInt64Def(aSource, MaxInt);
            if (aDest = MaxInt) then
              raise ESynJSONTreeView.CreateUTF8('Invalid input data type: %', [aSource]);
          end else
            if (UpperCaseU(aSource) = 'TRUE') then
              aDest := True
            else
              aDest := False;
      end;
      ftDouble: aDest := aSource.VDouble;
    end;
end;

{ TSynJSONTreeNode }

function TSynJSONTreeNode.Clone: TSynJSONTreeNode;
begin
  Result := TSynJSONTreeNode.Create(nil);
  Result.Name := fName;
  Result.JSONType := fJSONType;
  Result.Value := fValue;
end;

end.