BSOne.SFC/Tocsg.Lib/VCL/Tocsg.VTUtil.pas

{*******************************************************}
{                                                       }
{       Tocsg.VTUtil                                    }
{                                                       }
{       Copyright (C) 2022 kku                          }
{                                                       }
{*******************************************************}

unit Tocsg.VTUtil;

interface

uses
  WinAPi.Windows, VirtualTrees, VirtualTrees.Types, System.Classes, System.SysUtils;

type
  TTgVirtualStringTreeHelper = class helper for TBaseVirtualTree
  public
    procedure SortEx(pBeginNode: PVirtualNode; nColumn: TColumnIndex; Direction: TSortDirection; nSortCount: Integer = -1);
  end;

function VT_CountTotalNode(vt: TVirtualStringTree): DWORD;
function VT_CountVisibleNode(vt: TVirtualStringTree): DWORD;
function VT_CountVisibleChildNode(pNode: PVirtualNode): DWORD;
function VT_CountVisibleCheckedNode(vt: TVirtualStringTree): DWORD;
procedure VT_ReverseSelected(vt: TVirtualStringTree);
procedure VT_CheckAll(var vt: TVirtualStringTree);
procedure VT_UnCheckAll(var vt: TVirtualStringTree);
procedure VT_ForceCheckNode(pNode: PVirtualNode);
procedure VT_ForceUnCheckNode(pNode: PVirtualNode);
procedure VT_ReverseCheckAll(vt: TVirtualStringTree);
procedure VT_SetEnalbedNode(vt: TVirtualStringTree; pNode: PVirtualNode; bVal: Boolean);
function VT_HasDisableNode(vt: TVirtualStringTree; pNode: PVirtualNode): Boolean;
procedure VT_ExpandAll(vt: TVirtualStringTree; bFlag: Boolean);
procedure VT_ExpandNodeAll(vt: TVirtualStringTree; pNode: PVirtualNode; bFlag: Boolean);
function VT_CopyToClipboardSelectedInfo(vt: TVirtualStringTree; nStartColumnIdx: Integer = 1): Integer;

function VT_AddChild(vt: TVirtualStringTree; pParent: PVirtualNode = nil): PVirtualNode; inline;
function VT_AddChildDataN(vt: TVirtualStringTree; out pAddNode: PVirtualNode; pParent: PVirtualNode = nil): Pointer; overload; inline;
function VT_AddChildData(vt: TVirtualStringTree; pParent: PVirtualNode = nil): Pointer; inline; overload;

function VT_HasChildNode(vt: TVirtualStringTree; pParent, pFindNode: PVirtualNode): Boolean;

function VT_Get1SelNodeData(vt: TVirtualStringTree): Pointer;
procedure VT_SortAll(vt: TVirtualStringTree; nColumn: Integer; aDirection: TSortDirection);
procedure VT_SortNodeChilds(vt: TVirtualStringTree; pNode: PVirtualNode; nColumn: Integer; aDirection: TSortDirection);
function VT_FindNodeFromPath(vt: TVirtualStringTree; sPath: String; sDelimiter: String = '\'; nColumn: Integer = 0): PVirtualNode;
procedure VT_SetCheckTypeAllNode(vt: TVirtualStringTree; aCheckType: TCheckType);
procedure VT_SetFocuceNode(vt: TVirtualStringTree; pNode: PVirtualNode);
procedure VT_Clear(aVT: TVirtualStringTree);

implementation

uses
  Vcl.Clipbrd, Tocsg.Safe, Tocsg.Strings;

// pBeginNode 부터 nSortCount 수만큼 정렬을 시도한다.
// 기본 골격은 TBaseVirtualTree >> procedure Sort(Node: PVirtualNode; Column: TColumnIndex; Direction: TSortDirection; DoInit: Boolean = True); virtual;
procedure TTgVirtualStringTreeHelper.SortEx(pBeginNode: PVirtualNode; nColumn: TColumnIndex; Direction: TSortDirection; nSortCount: Integer = -1);

  function MergeAscending(A, B: PVirtualNode): PVirtualNode;
  var
    Dummy: TVirtualNode;
    CompareResult: Integer;
  begin
    // This avoids checking for Result = nil in the loops.
    Result := @Dummy;
    while Assigned(A) and Assigned(B) do
    begin
      if OperationCanceled then
        CompareResult := 0
      else
        CompareResult := DoCompare(A, B, nColumn);

      if CompareResult <= 0 then
      begin
        Result.NextSibling := A;
        Result := A;
        A := A.NextSibling;
      end
      else
      begin
        Result.NextSibling := B;
        Result := B;
        B := B.NextSibling;
      end;
    end;

    // Just append the list which is not nil (or set end of result list to nil if both lists are nil).
    if Assigned(A) then
      Result.NextSibling := A
    else
      Result.NextSibling := B;
    // return start of the new merged list
    Result := Dummy.NextSibling;
  end;

  //---------------------------------------------------------------------------

  function MergeDescending(A, B: PVirtualNode): PVirtualNode;
  var
    Dummy: TVirtualNode;
    CompareResult: Integer;

  begin
    // this avoids checking for Result = nil in the loops
    Result := @Dummy;
    while Assigned(A) and Assigned(B) do
    begin
      if OperationCanceled then
        CompareResult := 0
      else
        CompareResult := DoCompare(A, B, nColumn);

      if CompareResult >= 0 then
      begin
        Result.NextSibling := A;
        Result := A;
        A := A.NextSibling;
      end
      else
      begin
        Result.NextSibling := B;
        Result := B;
        B := B.NextSibling;
      end;
    end;

    // Just append the list which is not nil (or set end of result list to nil if both lists are nil).
    if Assigned(A) then
      Result.NextSibling := A
    else
      Result.NextSibling := B;
    // Return start of the newly merged list.
    Result := Dummy.NextSibling;
  end;

  //---------------------------------------------------------------------------

  function MergeSortAscending(var Node: PVirtualNode; N: Cardinal): PVirtualNode;
  var
    A, B: PVirtualNode;

  begin
    if N > 1 then
    begin
      A := MergeSortAscending(Node, N div 2);
      B := MergeSortAscending(Node, (N + 1) div 2);
      Result := MergeAscending(A, B);
    end
    else
    begin
      Result := Node;
      Node := Node.NextSibling;
      Result.NextSibling := nil;
    end;
  end;

  //---------------------------------------------------------------------------

  function MergeSortDescending(var Node: PVirtualNode; N: Cardinal): PVirtualNode;

  // Sorts the list of nodes given by Node (which must not be nil).

  var
    A, B: PVirtualNode;

  begin
    if N > 1 then
    begin
      A := MergeSortDescending(Node, N div 2);
      B := MergeSortDescending(Node, (N + 1) div 2);
      Result := MergeDescending(A, B);
    end
    else
    begin
      Result := Node;
      Node := Node.NextSibling;
      Result.NextSibling := nil;
    end;
  end;

  //--------------- end local functions ---------------------------------------

var
  Run: PVirtualNode;
  Index: Cardinal;

  i: Integer;
  bBeginFirstChild: Boolean;
  pTempNode,
  pSortCountNextNode,
  pBeginPrevNode: PVirtualNode;
  vtState: TVirtualTreeStates;
begin
  with Self do
  begin
    InterruptValidation;

    if tsEditPending in FStates then
    begin
      StopTimer(EditTimer);
      DoStateChange([], [tsEditPending]);
    end;

    vtState := FStates;
  end;

  if not (tsEditing in vtState) or DoEndEdit then
  begin
    if pBeginNode = nil then
      exit;

    if nSortCount = -1 then
    begin
      nSortCount := 0;
      pTempNode := pBeginNode;
      while pTempNode <> nil do
      begin
        Inc(nSortCount);
        pTempNode := pTempNode.NextSibling;
      end;
      pSortCountNextNode := nil;
    end else begin
      pTempNode := pBeginNode;
      for i := 1 to nSortCount do
      begin
        pTempNode := pTempNode.NextSibling;
        if pTempNode = nil then
        begin
          nSortCount := i;
          break;
        end;
      end;
      pSortCountNextNode := pTempNode;
    end;

    if nSortCount > 1 then
    begin
      bBeginFirstChild := false;
      if pBeginNode.Parent <> nil then
      begin
        if pBeginNode.Parent.FirstChild = pBeginNode then
          bBeginFirstChild := true;
      end;

      pBeginPrevNode := pBeginNode.PrevSibling;
      Index := pBeginNode.Index;

      StartOperation(okSortNode);
      try
        // Sort the linked list, check direction flag only once.
        if Direction = sdAscending then
          pTempNode := MergeSortAscending(pBeginNode, nSortCount)
        else
          pTempNode := MergeSortDescending(pBeginNode, nSortCount);

        if pTempNode.Parent <> nil then
        begin
          if bBeginFirstChild then
            pTempNode.Parent.FirstChild := pTempNode;
        end;
      finally
        EndOperation(okSortNode);
      end;

      // Consolidate the child list finally.
      Run := pTempNode;
      if pBeginPrevNode <> nil then
        pBeginPrevNode.NextSibling := Run;
      Run.PrevSibling := pBeginPrevNode;

      repeat
        Run.Index := Index;
        Inc(Index);
        if Run.NextSibling = nil then
          Break;
        Run.NextSibling.PrevSibling := Run;
        Run := Run.NextSibling;
      until False;

      if pSortCountNextNode <> nil then
      begin
        Run.NextSibling := pSortCountNextNode;
        pSortCountNextNode.PrevSibling := Run;
      end else
      if (Run.Parent <> nil) and (Run.NextSibling = nil) then
        Run.Parent.LastChild := Run;

      InvalidateCache;
    end;

    with Self do
    begin
      if FUpdateCount = 0 then
      begin
        ValidateCache;
        Invalidate;
      end;
    end;
  end;
end;

{ Other }

function VT_CountTotalNode(vt: TVirtualStringTree): DWORD;
var
  pNode: PVirtualNode;
begin
  Result := 0;
  pNode := vt.GetFirst;
  while pNode <> nil do
  begin
    Inc(Result);
    pNode := vt.GetNext(pNode);
  end;
end;

function VT_CountVisibleNode(vt: TVirtualStringTree): DWORD;
var
  pNode: PVirtualNode;
begin
  Result := 0;
  pNode := vt.GetFirst;
  while pNode <> nil do
  begin
    if vt.IsVisible[pNode] then
      Inc(Result);
    pNode := vt.GetNext(pNode);
  end;
end;

function VT_CountVisibleChildNode(pNode: PVirtualNode): DWORD;
begin
  Result := 0;
  pNode := pNode.FirstChild;
  while pNode <> nil do
  begin
    if vsVisible in pNode.States then
      Inc(Result);

    pNode := pNode.NextSibling;
  end;
end;

function VT_CountVisibleCheckedNode(vt: TVirtualStringTree): DWORD;
var
  pNode: PVirtualNode;
begin
  Result := 0;
  pNode := vt.GetFirst;
  while pNode <> nil do
  begin
    if vt.IsVisible[pNode] and (pNode.CheckState = csCheckedNormal) then
      Inc(Result);
    pNode := vt.GetNext(pNode);
  end;
end;

procedure VT_ReverseSelected(vt: TVirtualStringTree);
var
  pNode: PVirtualNode;
begin
  vt.BeginUpdate;
  try
    pNode := vt.GetFirst;
    while pNode <> nil do
    begin
      vt.Selected[pNode] := not vt.Selected[pNode];
      pNode := vt.GetNext(pNode);
    end;
  finally
    vt.EndUpdate;
  end;
end;

procedure VT_CheckAll(var vt: TVirtualStringTree);
var
  pNode: PVirtualNode;
begin
  vt.BeginUpdate;
  try
    pNode := vt.GetFirst;
    while pNode <> nil do
    begin
      if vt.IsVisible[pNode] and not vt.IsDisabled[pNode] then
        pNode.CheckState := csCheckedNormal;
      pNode := vt.GetNext(pNode, true);
    end;
  finally
    vt.EndUpdate;
  end;
end;

procedure VT_UnCheckAll(var vt: TVirtualStringTree);
var
  pNode: PVirtualNode;
begin
  vt.BeginUpdate;
  try
    pNode := vt.GetFirst;
    while pNode <> nil do
    begin
      if vt.IsVisible[pNode] and not vt.IsDisabled[pNode] then
//        vt.CheckState[pNode] := csUncheckedNormal;
        pNode.CheckState := csUncheckedNormal;
      pNode := vt.GetNext(pNode, true);
    end;
  finally
    vt.EndUpdate;
  end;
end;

procedure VT_ForceCheckNode(pNode: PVirtualNode);
var
  pChildN: PVirtualNode;
begin
  pNode.CheckState := csCheckedNormal;
  pChildN := pNode.FirstChild;
  while pChildN <> nil do
  begin
    pChildN.CheckState := csCheckedNormal;
    if pChildN.ChildCount > 0 then
      VT_ForceCheckNode(pChildN);
    pChildN := pChildN.NextSibling;
  end;
end;

procedure VT_ForceUnCheckNode(pNode: PVirtualNode);
var
  pChildN: PVirtualNode;
begin
  pNode.CheckState := csUncheckedNormal;
  pChildN := pNode.FirstChild;
  while pChildN <> nil do
  begin
    pChildN.CheckState := csUncheckedNormal;
    if pChildN.ChildCount > 0 then
      VT_ForceCheckNode(pChildN);
    pChildN := pChildN.NextSibling;
  end;
end;

procedure VT_ReverseCheckAll(vt: TVirtualStringTree);
var
  pNode: PVirtualNode;
begin
  vt.BeginUpdate;
  try
    pNode := vt.GetFirst;
    while pNode <> nil do
    begin
      if vt.IsVisible[pNode] and not vt.IsDisabled[pNode] then
      begin
        if pNode.CheckState = csCheckedNormal then
          pNode.CheckState := csUncheckedNormal
        else
        if pNode.CheckState = csUncheckedNormal then
          pNode.CheckState := csCheckedNormal;
      end;

      pNode := vt.GetNext(pNode);
    end;
  finally
    vt.EndUpdate;
  end;
end;

procedure VT_SetEnalbedNode(vt: TVirtualStringTree; pNode: PVirtualNode; bVal: Boolean);
begin
  vt.BeginUpdate;
  try
    vt.IsDisabled[pNode] := not bVal;
    if pNode.ChildCount > 0 then
    begin
      pNode := pNode.FirstChild;
      while pNode <> nil do
      begin
        VT_SetEnalbedNode(vt, pNode, bVal);
        pNode := pNode.NextSibling;
      end;
    end;
  finally
    vt.EndUpdate;
  end;
end;

function VT_HasDisableNode(vt: TVirtualStringTree; pNode: PVirtualNode): Boolean;

  function CheckDisableNode(aNode: PVirtualNode): Boolean;
  begin
    Result := false;
    if vt.IsDisabled[aNode] then
    begin
      Result := true;
      exit;
    end;

    if aNode.ChildCount > 0 then
    begin
      aNode := aNode.FirstChild;
      while aNode <> nil do
      begin
        Result := CheckDisableNode(aNode);
        if Result then
          exit;
        aNode := aNode.NextSibling;
      end;
    end;
  end;

begin
  vt.BeginUpdate;
  try
    Result := CheckDisableNode(pNode);
  finally
    vt.EndUpdate;
  end;
end;

procedure VT_ExpandAll(vt: TVirtualStringTree; bFlag: Boolean);
var
  pNode: PVirtualNode;
begin
  vt.BeginUpdate;
  try
    pNode := vt.GetFirst;
    while pNode <> nil do
    begin
      vt.Expanded[pNode] := bFlag;
      pNode := vt.GetNext(pNode);
    end;
  finally
    vt.EndUpdate;
  end;
end;

procedure VT_ExpandNodeAll(vt: TVirtualStringTree; pNode: PVirtualNode; bFlag: Boolean);
begin
  vt.BeginUpdate;
  try
    while pNode <> nil do
    begin
      vt.Expanded[pNode] := bFlag;
      pNode := vt.GetNext(pNode);
    end;
  finally
    vt.EndUpdate;
  end;
end;

function VT_CopyToClipboardSelectedInfo(vt: TVirtualStringTree; nStartColumnIdx: Integer = 1): Integer;
var
  pNode: PVirtualNode;
  sData: String;
  i: Integer;
  cbd: TClipboard;
begin
  Result := 0;
  pNode := vt.GetFirstSelected;
  if pNode = nil then
  begin
    Result := 1;
    exit;
  end;

  if vt.SelectedCount > 1000 then
  begin
    Result := 2;
    exit;
  end;

  if nStartColumnIdx >= vt.Header.Columns.Count then
    nStartColumnIdx := 0;

  sData := '';
  while pNode <> nil do
  begin
    for i := nStartColumnIdx to vt.Header.Columns.Count - 1 do
      if coVisible in vt.Header.Columns[i].Options then
      begin
        sData := sData + vt.Text[pNode, i] + #9;
      end;

    sData := sData + #13#10;

    pNode := vt.GetNextSelected(pNode);
  end;

  if sData <> '' then
  begin
    Guard(cbd, TClipboard.Create);
    cbd.AsText := sData;
  end else Result := 3;
end;

function VT_AddChild(vt: TVirtualStringTree; pParent: PVirtualNode = nil): PVirtualNode; inline;
begin
  Result := vt.AddChild(pParent);
  Include(Result.States, vsInitialized);
end;

function VT_AddChildDataN(vt: TVirtualStringTree; out pAddNode: PVirtualNode; pParent: PVirtualNode = nil): Pointer; inline;
begin
  pAddNode := vt.AddChild(pParent);
  Include(pAddNode.States, vsInitialized);
  Result := vt.GetNodeData(pAddNode);
end;

function VT_AddChildData(vt: TVirtualStringTree; pParent: PVirtualNode = nil): Pointer; inline; overload;
var
  pNode: PVirtualNode;
begin
  Result := VT_AddChildDataN(vt, pNode, pParent);
end;

function VT_HasChildNode(vt: TVirtualStringTree; pParent, pFindNode: PVirtualNode): Boolean;
var
  pNode: PVirtualNode;
begin
  Result := false;

  if pParent = nil then
    exit;

  if pParent = pFindNode then
  begin
    Result := true;
    exit;
  end;

  pNode := pParent.FirstChild;
  while pNode <> nil do
  begin
    Result := VT_HasChildNode(vt, pNode, pFindNode);
    if Result then
      exit;

    pNode := pNode.NextSibling;
  end;
end;

function VT_Get1SelNodeData(vt: TVirtualStringTree): Pointer;
var
  pNode: PVirtualNode;
begin
  pNode := vt.GetFirstSelected;
  if pNode <> nil then
    Result := vt.GetNodeData(pNode)
  else
    Result := nil;
end;

procedure VT_SortAll(vt: TVirtualStringTree; nColumn: Integer; aDirection: TSortDirection);
var
  pNode: PVirtualNode;
begin
  vt.Sort(nil, nColumn, aDirection);

  pNode := vt.GetFirst;
  while pNode <> nil do
  begin
    if pNode.ChildCount > 0 then
      vt.Sort(pNode, nColumn, aDirection);
    pNode := vt.GetNext(pNode);
  end;
end;

procedure VT_SortNodeChilds(vt: TVirtualStringTree; pNode: PVirtualNode; nColumn: Integer; aDirection: TSortDirection);
begin
  vt.Sort(pNode, nColumn, aDirection);

  if pNode = nil then
    pNode := vt.RootNode;

  pNode := pNode.FirstChild;
  while pNode <> nil do
  begin
    if pNode.ChildCount > 0 then
      VT_SortNodeChilds(vt, pNode, nColumn, aDirection);
    pNode := pNode.NextSibling;
  end;
end;

// 잘 동작하는지 테스트 안됨 22_0119 21:34:10 kku
// 확인 되면 이거 지워 ㅇㅇ
function VT_FindNodeFromPath(vt: TVirtualStringTree; sPath: String; sDelimiter: String = '\'; nColumn: Integer = 0): PVirtualNode;

  function GetMatchTextNode(pNode: PVirtualNode; sMatchText: String): PVirtualNode;
  begin
    Result := nil;
    while pNode <> nil do
    begin
      if CompareText(vt.Text[pNode, nColumn], sMatchText) = 0 then
      begin
        Result := pNode;
        exit;
      end;
      pNode := pNode.NextSibling;
    end;
  end;

var
  PathList: TStringList;
  pNode: PVirtualNode;
  i: Integer;
begin
  Result := nil;
  Guard(PathList, TStringList.Create);

  if SplitString2(sDelimiter, sPath, PathList) = 0 then
    exit;

  vt.BeginUpdate;
  try
    pNode := vt.RootNode;
    if pNode = nil then
      exit;

    for i := 0 to PathList.Count - 1 do
    begin
      Result := GetMatchTextNode(pNode.FirstChild, PathList[i]);
      if Result = nil then
        break;
    end;
  finally
    vt.EndUpdate;
  end;
end;

procedure VT_SetCheckTypeAllNode(vt: TVirtualStringTree; aCheckType: TCheckType);
var
  pNode: PVirtualNode;
begin
  pNode := vt.GetFirst;
  while pNode <> nil do
  begin
    pNode.CheckType := aCheckType;
    pNode := vt.GetNext(pNode);
  end;
end;

procedure VT_SetFocuceNode(vt: TVirtualStringTree; pNode: PVirtualNode);
begin
  vt.FocusedNode := nil;
  vt.ClearSelection;

  vt.FocusedNode := pNode;
  vt.Selected[pNode] := true;
  vt.ScrollIntoView(pNode, true);
end;

procedure VT_Clear(aVT: TVirtualStringTree);
begin
  with aVT.Header do
  begin
    if SortColumn <> -1 then
    begin
      Columns[SortColumn].Options := Columns[SortColumn].Options + [coParentColor];
      SortColumn := -1;
    end;
  end;
  aVT.Clear;
end;

end.