galeJSON/JSONTreeView.pas

unit JSONTreeView;

interface

uses
  System.JSON, System.Generics.Collections, System.Math, System.SysUtils,
  System.Types, System.Classes, System.UITypes,
  FMX.Types, FMX.Graphics, FMX.Controls, FMX.StdCtrls, FMX.TreeView, FMX.Objects,
  FMX.Forms, FMX.Menus;

type
  // 自定义的树视图项类，用于处理JSON数据
  TJSONTreeViewItem = class(TTreeViewItem)
  private
    FJsonData: TJSONAncestor; // 存储JSON数据
    FMouseDowned: Boolean; // 鼠标是否按下
    FMouseDownPos: TPointF; // 鼠标按下位置
  private
    // 设置JSON数据
    procedure SetJsonData(const AValue: TJSONAncestor);
    // 获取JSON值
    function GetJsonValue: TJSONValue;
    // 设置JSON值
    procedure SetJsonValue(const AValue: TJSONValue);
    // 获取键名
    function GetKey: string;
    // 获取值
    function GetValue: string;
    // 获取最后一个路径
    function GetLastPath: string;
    // 获取完整路径
    function GetPath: string;
  protected
    // 重载绘制函数
    procedure Paint; override;
  public
    property JsonData: TJSONAncestor read FJsonData write SetJsonData; // JSON数据属性
    property JsonValue: TJSONValue read GetJsonValue write SetJsonValue; // JSON值属性
    property Key: string read GetKey; // 键名属性
    property LastPath: string read GetLastPath; // 最后一个路径属性
    property Path: string read GetPath; // 完整路径属性
    property Value: string read GetValue; // 值属性
  public
    // 鼠标按下事件处理
    procedure TreeViewItemMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    // 鼠标移动事件处理
    procedure TreeViewItemMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
    // 鼠标释放事件处理
    procedure TreeViewItemMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
  public
    // 构造函数
    constructor Create(AOwner: TComponent); override;
    // 获取第一个子项
    function First: TJSONTreeViewItem;
    // 获取最后一个子项
    function Last: TJSONTreeViewItem;
    // 获取层级
    function Level: integer;
    // 是否有子项
    function HasSubItem: Boolean;
    // 是否有选中的子项
    function HasSUbItemIsSelected: Boolean;
    // 获取父项
    function MyParentItem: TJSONTreeViewItem;
    // 移除子项
    procedure RemoveItem(const AItem: TJSONTreeViewItem; AReTextSubItem: Boolean = False);
    // 从父项中提取
    function ExtractFromParent(AParentReTextSubItem: Boolean = False): TJSONTreeViewItem;
    // 添加子项
    procedure AddItem(const AItem: TJSONTreeViewItem; AItemReText: Boolean = False);
    // 插入子项
    procedure InsertItem(const AIndex: integer; const AItem: TJSONTreeViewItem;
      AReTextSubItem: Boolean = False);
    // 移动子项
    procedure MoveItem(const ACurIndex, ANewIndex: integer; AReTextSubItem: Boolean = False);
    // 清除子条目
    procedure ClearItem;
    // 重新设置文本
    procedure ReText;
    // 重新设置所有子项的文本
    procedure ReTextSubItem;
  end;

// 设置树视图项，递归地将JSON数据添加到树视图中
procedure SetTreeItem(const AParentItem: TStyledControl; const AJData: TJSONAncestor; APopupMenu: TPopupMenu = nil);
procedure SetTreeItems(const AParentItem: TStyledControl; const AJData: TJSONAncestor; APopupMenu: TPopupMenu = nil);

implementation

uses pub, jsonhelper, Logger;

////////////////////////////////////////////////////////////////////////////////
// 为树形控件的项目设置JSON数据和PopupMenu
////////////////////////////////////////////////////////////////////////////////
procedure SetTreeItem(const AParentItem: TStyledControl; const AJData: TJSONAncestor; APopupMenu: TPopupMenu);
var
  tvItem: TJSONTreeViewItem;
begin
  tvItem := TJSONTreeViewItem.Create(nil);
  AParentItem.AddObject(tvItem);
  tvItem.PopupMenu := APopupMenu;
  tvItem.JsonData := AJData;
  for var i := 0 to tvItem.JsonValue.ItemCount - 1 do
  begin
    SetTreeItem(tvItem, tvItem.JsonValue.Items[i]);
  end;
end;

procedure SetTreeItems(const AParentItem: TStyledControl; const AJData: TJSONAncestor; APopupMenu: TPopupMenu = nil);
begin
  if AJData is TJSONObject then
  begin
    for var i := 0 to TJSONObject(AJData).Count - 1 do
    begin
      SetTreeItem(AParentItem, TJSONObject(AJData).Pairs[i]);
    end;
  end
  else if AJData is TJSONArray then
  begin
    for var i := 0 to TJSONArray(AJData).Count - 1 do
    begin
      SetTreeItem(AParentItem, TJSONArray(AJData)[i]);
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// TJSONTreeViewItem类的构造函数
////////////////////////////////////////////////////////////////////////////////
constructor TJSONTreeViewItem.Create(AOwner: TComponent);
begin
  inherited;
  FJsonData := nil;
  OnMouseDown := TreeViewItemMouseDown;
  OnMouseMove := TreeViewItemMouseMove;
  OnMouseUp := TreeViewItemMouseUp;
end;

////////////////////////////////////////////////////////////////////////////////
// 获取JSONTreeViewItem的第一个子项
////////////////////////////////////////////////////////////////////////////////
function TJSONTreeViewItem.First: TJSONTreeViewItem;
begin
  if Count > 0 then
    Result := TJSONTreeViewItem(Items[0])
  else
    Result := nil;
end;

////////////////////////////////////////////////////////////////////////////////
// 获取JSONTreeViewItem的最后一个子项
////////////////////////////////////////////////////////////////////////////////
function TJSONTreeViewItem.Last: TJSONTreeViewItem;
begin
  if Count > 0 then
    Result := TJSONTreeViewItem(Items[Count - 1])
  else
    Result := nil;
end;

////////////////////////////////////////////////////////////////////////////////
// 获取JSONTreeViewItem的层级深度
////////////////////////////////////////////////////////////////////////////////
function TJSONTreeViewItem.Level: integer;
var
  LCurItem: TJSONTreeViewItem;
begin
  Result := 0;
  LCurItem := self;
  while LCurItem.ParentItem <> nil do
  begin
    Inc(Result);
    LCurItem := LCurItem.MyParentItem;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// 判断JSONTreeViewItem是否有子项
////////////////////////////////////////////////////////////////////////////////
function TJSONTreeViewItem.HasSubItem: Boolean;
begin
  Result := Count > 0;
end;

////////////////////////////////////////////////////////////////////////////////
// 判断JSONTreeViewItem是否有被选中的子项
////////////////////////////////////////////////////////////////////////////////
function TJSONTreeViewItem.HasSUbItemIsSelected: Boolean;
begin
  Result := False;
  for var i := 0 to Count - 1 do
  begin
    if Items[i].IsSelected then
      Exit(True);
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// 获取当前项的父项
////////////////////////////////////////////////////////////////////////////////
function TJSONTreeViewItem.MyParentItem: TJSONTreeViewItem;
begin
  Result := TJSONTreeViewItem(ParentItem);
end;

////////////////////////////////////////////////////////////////////////////////
// 从当前项中移除子项
////////////////////////////////////////////////////////////////////////////////
procedure TJSONTreeViewItem.RemoveItem(const AItem: TJSONTreeViewItem; AReTextSubItem: Boolean = False);
begin
  if JsonValue is TJSONObject then
  begin
    TJSONObject(JsonValue).DeletePair(TJSONPair(AItem.FJsonData));
    RemoveObject(AItem);
  end
  else if JsonValue is TJSONArray then
  begin
    TJSONArray(JsonValue).Delete(AItem.JsonValue);
    RemoveObject(AItem);
    if AReTextSubItem then
    begin
      ReTextSubItem;
    end;
  end
  else
  begin
    raise Exception.Create('TJSONTreeViewItem.RemoveItem: must be TJSONObject or TJSONArray');
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// 从父项中提取当前项
////////////////////////////////////////////////////////////////////////////////
function TJSONTreeViewItem.ExtractFromParent(AParentReTextSubItem: Boolean = False): TJSONTreeViewItem;
begin
  Result := TJSONTreeViewItem(ParentItem);
  if Result <> nil then
    Result.RemoveItem(self, AParentReTextSubItem);
end;

////////////////////////////////////////////////////////////////////////////////
// 向当前项中添加子项
////////////////////////////////////////////////////////////////////////////////
procedure TJSONTreeViewItem.AddItem(const AItem: TJSONTreeViewItem; AItemReText: Boolean = False);
var
  LValue: TJSONValue;
begin
  if JsonValue is TJSONObject then
  begin
    if not(AItem.JsonData is TJSONPair) then
    begin
      AItem.JsonData := TJSONPair.Create('untitled', AItem.JsonValue);
    end;
    TJSONObject(JsonValue).AddPair(TJSONPair(AItem.JsonData));
  end
  else if JsonValue is TJSONArray then
  begin
    if AItem.JsonData is TJSONPair then
    begin
      LValue := AItem.JsonValue;
      LValue.Owned := False;
      FreeAndNil(AItem.JsonData);
      LValue.Owned := True;
      AItem.JsonData := LValue;
    end;
    TJSONArray(JsonValue).AddElement(AItem.JsonValue);
  end;
  AddObject(AItem);
  if AItemReText then
  begin
    AItem.ReText;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// 在当前JSON树视图项中插入一个新项
////////////////////////////////////////////////////////////////////////////////
procedure TJSONTreeViewItem.InsertItem(const AIndex: integer; const AItem: TJSONTreeViewItem; AReTextSubItem: Boolean = False);
var
  LValue: TJSONValue;
begin
  if JsonValue is TJSONObject then
  begin
    if not(AItem.JsonData is TJSONPair) then
    begin
      AItem.JsonData := TJSONPair.Create('untitled', AItem.JsonValue);
    end;
    TJSONObject(JsonValue).InsertPair(AIndex, TJSONPair(AItem.JsonData));
    InsertObject(AIndex, AItem);
    AItem.ReText;
  end
  else if JsonValue is TJSONArray then
  begin
    if AItem.JsonData is TJSONPair then
    begin
      LValue := AItem.JsonValue;
      LValue.Owned := False;
      FreeAndNil(AItem.JsonData);
      LValue.Owned := True;
      AItem.JsonData := LValue;
    end;
    TJSONArray(JsonValue).InsertElement(AIndex, AItem.JsonValue);
    InsertObject(AIndex, AItem);
    if AReTextSubItem then
    begin
      ReTextSubItem;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// 移动JSON树视图项的位置
////////////////////////////////////////////////////////////////////////////////
procedure TJSONTreeViewItem.MoveItem(const ACurIndex, ANewIndex: integer; AReTextSubItem: Boolean = False);
var
  LItem: TJSONTreeViewItem;
begin
  if JsonValue is TJSONObject then
  begin
    TJSONObject(JsonValue).Move(ACurIndex, ANewIndex);
    LItem := TJSONTreeViewItem(Items[ACurIndex]);
    RemoveObject(LItem);
    InsertObject(ANewIndex, LItem);
  end
  else
  begin
    TJSONArray(JsonValue).Move(ACurIndex, ANewIndex);
    LItem := TJSONTreeViewItem(Items[ACurIndex]);
    RemoveObject(LItem);
    InsertObject(ANewIndex, LItem);
    if AReTextSubItem then
    begin
      ReTextSubItem;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// 清除子条目
////////////////////////////////////////////////////////////////////////////////
procedure TJSONTreeViewItem.ClearItem;
begin
  for var i := Count - 1 downto 0 do
  begin
    Items[i].Free;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// 处理JSON树视图项的鼠标按下事件
////////////////////////////////////////////////////////////////////////////////
procedure TJSONTreeViewItem.TreeViewItemMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  if (Button = TMouseButton.mbLeft) and (ParentItem <> nil) then
  begin
    FMouseDownPos := Screen.MousePos;
    FMouseDowned := True;
  end
  else
  begin
    FMouseDowned := False;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// 处理JSON树视图项的鼠标移动事件
////////////////////////////////////////////////////////////////////////////////
procedure TJSONTreeViewItem.TreeViewItemMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
begin
  if FMouseDowned then
  begin
    if not(ssLeft in Shift) then
    begin
      FMouseDowned := False;
    end
    else if FMouseDowned and ((Abs(FMouseDownPos.X - Screen.MousePos.X) > 4) or (Abs(FMouseDownPos.Y - Screen.MousePos.Y) > 2)) then
    begin
      BeginAutoDrag;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// 处理鼠标抬起事件
////////////////////////////////////////////////////////////////////////////////
procedure TJSONTreeViewItem.TreeViewItemMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  FMouseDowned := False;
end;

////////////////////////////////////////////////////////////////////////////////
// 绘制树视图项
////////////////////////////////////////////////////////////////////////////////
procedure TJSONTreeViewItem.Paint;
const
  c_add_line = {$IFDEF MACOS}0{$ELSE}1{$ENDIF};
  c_color_default = $FF808080;
  c_color_brother = $FFFF8080;
  c_color_sub = $FF00AA00;
var
  LParentItem, LCurItem: TJSONTreeViewItem;
  LLeft: Single;
begin
  inherited;
  if ParentItem <> nil then
  begin
    LParentItem := MyParentItem;
    Canvas.Stroke.Kind := TBrushKind.Solid;
    Canvas.Stroke.Thickness := 1.0;
    // 根据父项的状态设置绘制颜色
    if LParentItem.IsSelected then
      Canvas.Stroke.Color := c_color_sub
    else if LParentItem.HasSUbItemIsSelected then
      Canvas.Stroke.Color := c_color_brother
    else
      Canvas.Stroke.Color := c_color_default;
    // 绘制连接线
    Canvas.DrawLine(PointF(0, c_add_line), PointF(0, LocalRect.Height / IfThen(self = LParentItem.Last, 2, 1)), 1.0);
    Canvas.DrawLine(PointF(c_add_line, LocalRect.Height / 2), PointF(IfThen(HasSubItem, 7.5, 15), LocalRect.Height / 2), 1.0);
    LLeft := 0;
    LCurItem := LParentItem;
    // 绘制父项及其所有子项的连接线
    while LCurItem.ParentItem <> nil do
    begin
      LLeft := LLeft - 20;
      LParentItem := LCurItem.MyParentItem;
      if (LCurItem <> LParentItem.Last) and LParentItem.IsExpanded then
      begin
        if LParentItem.IsSelected then
          Canvas.Stroke.Color := c_color_sub
        else if LParentItem.HasSUbItemIsSelected then
          Canvas.Stroke.Color := c_color_brother
        else
          Canvas.Stroke.Color := c_color_default;
        Canvas.DrawLine(PointF(LLeft, c_add_line), PointF(LLeft, LocalRect.Bottom), 1.0);
      end;
      LCurItem := LParentItem;
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// 获取JSON值
////////////////////////////////////////////////////////////////////////////////
function TJSONTreeViewItem.GetJsonValue: TJSONValue;
begin
  if FJsonData is TJSONPair then
    Result := TJSONPair(FJsonData).JsonValue
  else
    Result := TJSONValue(FJsonData);
end;

////////////////////////////////////////////////////////////////////////////////
// 设置JSON值
////////////////////////////////////////////////////////////////////////////////
procedure TJSONTreeViewItem.SetJsonValue(const AValue: TJSONValue);
var
  LArr: TJSONArray;
  LIndex: integer;
begin
  if FJsonData is TJSONPair then
  begin
    TJSONPair(FJsonData).JsonValue := AValue;
  end
  else
  begin
    if ParentItem <> nil then
    begin
      LArr := TJSONArray(TJSONTreeViewItem(ParentItem).JsonValue);
      LIndex := LArr.IndexOf(JsonValue);
      LArr.SetValue(LIndex, AValue);
    end;
    FJsonData := AValue;
  end;
  ImageIndex := Ord(AValue.JsonKind);
end;

////////////////////////////////////////////////////////////////////////////////
// 获取JSON键
////////////////////////////////////////////////////////////////////////////////
function TJSONTreeViewItem.GetKey: string;
begin
  if FJsonData is TJSONPair then
  begin
    Result := TJSONPair(FJsonData).JsonString.Value;
  end
  else
  begin
    Result := '';
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// 获取JSON值的字符串表示
////////////////////////////////////////////////////////////////////////////////
function TJSONTreeViewItem.GetValue: string;
begin
  Result := GetJsonValue.Value;
end;

////////////////////////////////////////////////////////////////////////////////
// 获取当前项的最后路径
////////////////////////////////////////////////////////////////////////////////
function TJSONTreeViewItem.GetLastPath: string;
begin
  if ParentItem = nil then
  begin
    Exit('');
  end;

  if FJsonData is TJSONPair then
  begin
    Result := TJSONPair(FJsonData).JsonString.Value;
  end
  else
  begin
    Result := '[' + Index.ToString + ']';
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// 获取当前项的完整路径
////////////////////////////////////////////////////////////////////////////////
function TJSONTreeViewItem.GetPath: string;
var
  tmpStr: string;
  ptItem: TJSONTreeViewItem;
begin
  ptItem := TJSONTreeViewItem(ParentItem);
  if ptItem = nil then
    Exit('');

  tmpStr := GetLastPath;
  while ptItem.ParentItem <> nil do
  begin
    if ptItem.JsonValue is TJSONObject then
    begin
      tmpStr := ptItem.GetLastPath + '.' + tmpStr;
    end
    else
    begin
      tmpStr := ptItem.GetLastPath + tmpStr;
    end;

    ptItem := TJSONTreeViewItem(ptItem.ParentItem);
  end;

  Result := tmpStr;
end;

////////////////////////////////////////////////////////////////////////////////
// 设置JSON数据
////////////////////////////////////////////////////////////////////////////////
procedure TJSONTreeViewItem.SetJsonData(const AValue: TJSONAncestor);
begin
  if FJsonData = AValue then
    Exit;
  FJsonData := AValue;
  ReText;
end;

////////////////////////////////////////////////////////////////////////////////
// 重新设置文本
////////////////////////////////////////////////////////////////////////////////
procedure TJSONTreeViewItem.ReText;
begin
  Text := GetLastPath + ': ' + JsonValue.Value;
  ImageIndex := Ord(JsonValue.JsonKind);
  if JsonValue.ClassType = TJSONString then
  begin
    Text := Text.Replace(#13, '\r').Replace(#10, '\n');
    if Text.Length > 100 then
    begin
      Text := Text.Substring(0, 100) + ' ...';
    end;
  end;
end;

////////////////////////////////////////////////////////////////////////////////
// 重新设置所有子项的文本
////////////////////////////////////////////////////////////////////////////////
procedure TJSONTreeViewItem.ReTextSubItem;
begin
  for var i := 0 to Count - 1 do
  begin
    TJSONTreeViewItem(Items[i]).ReText;
  end;
end;

end.