memtreeeh.pas

最新的 DBGRIDEH4.0

end;

procedure TTreeListEh.Expand(Node: TBaseTreeNodeEh; Recurse: Boolean);
var
  I: Integer;
begin
  if Node = nil then Node := FRoot;
  if Node.Count > 0 then
  begin
    if Node <> FRoot then
      Node.Expanded := True;
    if Recurse then
      for I := 0 to Node.Count-1 do
        Expand(Node.Items[I], True);
  end;
end;

procedure TTreeListEh.Collapse(Node: TBaseTreeNodeEh; Recurse: Boolean);
var
  I: Integer;
begin
  if Node = nil then Node := FRoot;
  Node.Expanded := False;
  if Recurse then
    for I := 0 to Node.Count-1 do
      Collapse(Node.Items[I], True);
end;


procedure TTreeListEh.AddNode(Node: TBaseTreeNodeEh; Destination: TBaseTreeNodeEh; Mode: TNodeAttachModeEh; ReIndex: Boolean);
begin
  if (Node = nil) or (Node = FRoot) then Exit;
  if Destination = nil then Destination := FRoot;
  if (Destination = FRoot) and (Mode <> naAddChildEh) and
     (Mode <> naAddChildFirstEh)
  then Exit;

  case Mode of
    naAddChildEh:
      begin
        Node.Parent := Destination;
        Destination.HasChildren := True;
        Node.FIndex := Destination.Add(Node);
        Node.SetLevel(Destination.Level + 1);
      end;
    naAddChildFirstEh:
      begin
        Node.Parent := Destination;
        Destination.HasChildren := True;
        Destination.Insert(0, Node);
        Node.FIndex := 0;
        Node.SetLevel(Destination.Level + 1);
        if ReIndex then BuildChildrenIndex(Node.Parent, False);
      end;
    naAddEh:
      begin
        AddNode(Node, Destination.Parent, naAddChildEh, False);
      end;
    naAddFirstEh:
      begin
        AddNode(Node, Destination.Parent, naAddChildFirstEh, ReIndex);
      end;
    naInsertEh:
      begin
        Node.Parent := Destination.Parent;
        Destination.Parent.HasChildren := True;
        Destination.Parent.Insert(Destination.Index, Node);
        Node.FIndex := Destination.Index;
        Node.SetLevel(Destination.Parent.Level + 1);
        if ReIndex then BuildChildrenIndex(Destination.Parent, False);
      end;
  end;
end;

procedure TTreeListEh.MoveTo(Node: TBaseTreeNodeEh; Destination: TBaseTreeNodeEh; Mode: TNodeAttachModeEh; ReIndex: Boolean);
begin
  if {(Destination = nil) or} (Node = nil) or (Node = FRoot) then Exit;
  if (Destination = FRoot) and (Mode <> naAddChildEh) and (Mode <> naAddChildFirstEh) then
    Exit;

  if Destination.HasParentOf(Node) then
    raise Exception.Create('Reference-loop found');

  Node.Parent.Delete(Node.Index);
  Node.Parent.HasChildren := (Node.Parent.Count > 0);
//
  if ReIndex then BuildChildrenIndex(Node.Parent, False);
  AddNode(Node, Destination, Mode, ReIndex);
end;

function TTreeListEh.GetNode(StartNode: TBaseTreeNodeEh; Data: TObject): TBaseTreeNodeEh;
var
  I: Integer;
  CurNode: TBaseTreeNodeEh;
begin
  Result := nil;
  if StartNode = nil then StartNode := FRoot;
  for I := 0 to StartNode.Count - 1 do
  begin
    CurNode := StartNode.Items[I];
    if CurNode.Data = Data then
    begin
      Result := CurNode;
      Break;
    end
    else
    begin
      Result := GetNode(CurNode, Data);
      if result <> nil then
        Break;
    end;
  end
end;

function TTreeListEh.GetPrevSibling(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
begin
  if (Node = nil) or (Node.Index = 0) or (Node.Parent = nil) then
  begin
    Result := nil;
    exit;
  end;
  Result := TBaseTreeNodeEh(Node.Parent.Items[Node.Index - 1]);
end;

function TTreeListEh.GetNextSibling(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
begin
  if (Node = nil) or (Node.Parent = nil) or (Node.Index = Node.Parent.Count - 1) then
  begin
    Result := nil;
    Exit;
  end;
  Result := Node.Parent.Items[Node.Index + 1];
end;

function TTreeListEh.GetFirstChild(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
begin
  if (Node = nil) or (Node.Count = 0) then
  begin
    Result := nil;
    Exit;
  end;
  Result := Node.Items[0];
end;

function TTreeListEh.GetLastChild(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
begin
  if (Node = nil) or (Node.Count = 0) then
  begin
    result := nil;
    Exit;
  end;
  Result := Node.Items[Node.Count - 1];
end;


function TTreeListEh.GetFirst: TBaseTreeNodeEh;
begin
  Result := GetFirstChild(FRoot);
end;


function TTreeListEh.GetPrevious(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
var
  PrevSiblingNode: TBaseTreeNodeEh;
begin
  Result := Node;
  if (Result = nil) or (Result = FRoot) then exit;
  PrevSiblingNode := GetPrevSibling(Result);
  if PrevSiblingNode <> nil then
  begin
    Result := GetLast(PrevSiblingNode);
    if Result = nil then
      Result := PrevSiblingNode;
  end
  else
    if Node.Parent <> FRoot then
      Result := Node.Parent
    else
      Result := nil;
end;

function TTreeListEh.GetNext(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
var
  FirstChild, NextSibling: TBaseTreeNodeEh;
begin
  Result := Node;
  if (Result = nil) or (Result = FRoot) then
    Exit;
  FirstChild := GetFirstChild(Result);
  if FirstChild <> nil then
  begin
    Result := FirstChild;
    Exit;
  end;
  repeat
    NextSibling := GetNextSibling(Result);
    if NextSibling <> nil then
    begin
      Result := NextSibling;
      Break;
    end
    else
    begin
      if Result.Parent <> FRoot then
        Result := Result.Parent
      else
      begin
        Result := nil;
        Break;
      end;
    end;
  until False;
end;


function TTreeListEh.GetLast(Node: TBaseTreeNodeEh = nil): TBaseTreeNodeEh;
var
  Next: TBaseTreeNodeEh;
begin
  if Node = nil then
    Node := FRoot;
  Result := GetLastChild(Node);
  while Result <> nil do
  begin
    Next := GetLastChild(Result);
    if Next = nil then
      Break;
    Result := Next;
  end;
end;

function TTreeListEh.IsHasChildren(Node: TBaseTreeNodeEh = nil): Boolean;
begin
  if Node = nil then
    Node := FRoot;
  Result := Node.Count > 0;
end;

function TTreeListEh.CountChildren(Node: TBaseTreeNodeEh = nil): Integer;
begin
  if Node = nil then
    Node := FRoot;
  Result := Node.Count;
end;

function TTreeListEh.GetParentAtLevel(Node: TBaseTreeNodeEh; ParentLevel: Integer): TBaseTreeNodeEh;
begin
  Result := nil;
  if (Node = nil) or (Node = FRoot) then
    Exit;
  if (ParentLevel >= Node.Level) or (ParentLevel < 0) then
    Exit;
  if ParentLevel = 0 then
  begin
    Result := FRoot;
    Exit;
  end;
  Result := Node;
  while Result <> nil do
  begin
    Result := Result.Parent;
    if Result <> nil then
      if Result.Level = ParentLevel then
        Break;
  end;
end;

function TTreeListEh.GetFirstVisible: TBaseTreeNodeEh;
var
  CurNode: TBaseTreeNodeEh;
begin
  Result := nil;
  if not IsHasChildren then
    Exit;
  CurNode := GetFirstChild(FRoot);
  if CurNode = nil then
    Exit;
  Result := CurNode;
  if not Result.Visible then
  begin
    repeat
      CurNode := GetNextSibling(Result);
      if CurNode <> nil then
      begin
        Result := CurNode;
        if Result.Visible then
          Break;
      end else
      begin
        if Result.Parent <> FRoot then
          Result := Result.Parent
        else
        begin
          Result := nil;
          Break;
        end;
      end;
    until False;
  end;
end;

function TTreeListEh.GetPathVisible(Node: TBaseTreeNodeEh; ConsiderCollapsed: Boolean): Boolean;
begin
  Result := False;
  if (Node = nil) or (Node = FRoot) then exit;
  repeat
    Node := Node.Parent;
  until (Node = FRoot) or not (Node.Expanded or not ConsiderCollapsed) or not (Node.Visible);
  Result := (Node = FRoot);
end;

function TTreeListEh.GetParentVisible(Node: TBaseTreeNodeEh; ConsiderCollapsed: Boolean): TBaseTreeNodeEh;
begin
  Result := Node;
  while Result <> FRoot do
  begin
    repeat
      Result := Result.Parent;
    until (Result.Expanded or not ConsiderCollapsed);
    if (Result = FRoot) or (Result.Visible and GetPathVisible(Result, ConsiderCollapsed)) then
      Break;
    while (Result <> FRoot) and (Result.Parent.Expanded or not ConsiderCollapsed) do
      Result := Result.Parent;
  end;
end;

function TTreeListEh.GetNextVisible(Node: TBaseTreeNodeEh; ConsiderCollapsed: Boolean): TBaseTreeNodeEh;
var
  ForceSearch: Boolean;
  FirstChild, NextSibling: TBaseTreeNodeEh;
begin
  Result := Node;
  if Result <> nil then
  begin
    if Result = FRoot then
    begin
      Result := nil;
      Exit;
    end;
    if not (Result.Visible) or not (GetPathVisible(Result, ConsiderCollapsed))  then
      Result := GetParentVisible(Result, ConsiderCollapsed);

    FirstChild := GetFirstChild(Result);
    if (Result.Expanded or not ConsiderCollapsed) and (FirstChild <> nil)  then
    begin
      Result := FirstChild;
      ForceSearch := False;
    end
    else
      ForceSearch := True;

    if (Result <> nil) and (ForceSearch or not (Result.Visible)) then
    begin
      repeat
        NextSibling := GetNextSibling(Result);
        if NextSibling <> nil then
        begin
          Result := NextSibling;
          if Result.Visible then
            Break;
        end
        else
        begin
          if Result.Parent <> FRoot then
            Result := Result.Parent
          else
          begin
            Result := nil;
            Break;
          end;
        end;
      until False;
    end;
  end;
end;

procedure TTreeListEh.Clear;
begin
 DeleteChildren(FRoot);
end;

procedure TTreeListEh.BuildChildrenIndex(Node: TBaseTreeNodeEh = nil; Recurse: Boolean = True);
var
  I: Integer;
  CurNode: TBaseTreeNodeEh;
begin
  if Node = nil then
    Node := FRoot;
  Node.FVisibleItems.Clear;
  for I := 0 to Node.Count - 1 do
  begin
    CurNode := Node.Items[I];
    CurNode.FIndex := I;
{    if CurNode.Visible
      then CurNode.FVisibleIndex := Node.FVisibleItems.Add(CurNode)
      else CurNode.FVisibleIndex := -1;}
    if Recurse then
      BuildChildrenIndex(CurNode, True);
  end;
  Node.BuildVisibleItems;
end;

procedure TTreeListEh.ExportToTreeView(TreeView:TTreeView; Node: TBaseTreeNodeEh; NodeTree: TTreeNode;AddChild:Boolean);
var
  CurNode:TBaseTreeNodeEh;
  TreeNode:TTreeNode;
begin
  CurNode := Node;
  while CurNode <> nil do
  begin
    if AddChild then
      TreeNode:=TreeView.Items.AddChildObject(NodeTree, CurNode.Text, CurNode.Data)
    else
      TreeNode:=TreeView.Items.AddObject(NodeTree, CurNode.Text, CurNode.Data);
      TreeNode.Expanded := CurNode.Expanded;
      ExportToTreeView(TreeView, GetFirstChild(CurNode), TreeNode,True);
      CurNode:=GetNextSibling(CurNode);
  end;
end;

procedure TTreeListEh.QuickSort(L, R: Integer; Compare: TCompareNodesEh);
begin
end;

procedure TTreeListEh.SortData(CompareProg: TCompareNodesEh; ParamSort: TObject;  ARecurse: Boolean);
begin
  FRoot.SortData(CompareProg, ParamSort, ARecurse);
end;

function TTreeListEh.GetNextVisibleSibling(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
begin
  if Node.Parent.Count = Node.Parent.VisibleCount then
    Result := GetNextSibling(Node)
  else
  begin
    if (Node = nil) or (Node.Parent = nil) or (Node.VisibleIndex = Node.Parent.VisibleCount - 1) then
    begin
      Result := nil;
      Exit;
    end;
    Result := Node.Parent.VisibleItem[Node.VisibleIndex + 1];
  end;
end;

function TTreeListEh.GetPrevVisibleSibling(Node: TBaseTreeNodeEh): TBaseTreeNodeEh;
begin
  if Node.Parent.Count = Node.Parent.VisibleCount then
    Result := GetPrevSibling(Node)
  else
  begin
    if (Node = nil) or (Node.Parent = nil) or (Node.VisibleIndex = 0) then
    begin
      Result := nil;
      Exit;
    end;
    Result := Node.Parent.VisibleItem[Node.VisibleIndex - 1];
  end;
end;

procedure TTreeListEh.ExpandedChanged(Node: TBaseTreeNodeEh);
begin
  if Assigned(OnExpandedChanged) then
    OnExpandedChanged(Node);
end;

function TTreeListEh.ExpandedChanging(Node: TBaseTreeNodeEh): Boolean;
begin
  Result := True;
  if Assigned(OnExpandedChanging) then
    Result := OnExpandedChanging(Node);
end;

end.