Перезапуск дерева в Lazarus с помощью объекта TTreeView

Я рисую дерево с TTreeView симулировать прямоугольное дерево. Это дерево используется в науке, напоминающее багетологию в спортивном турнире.

TTreeView имеет несколько встроенных инструментов, облегчающих создание и отображение. Мне действительно нужно, чтобы это работало в формате прямоугольного дерева. Я едва получил его на работу, используя TTreeView, У него все еще есть ошибки в старом корне, который должен стать одной веткой, и новый корень, который разделится на 2 ветви.

Дети ниже нового корня останутся прежними. Родитель и брат должны быть на другой ветви корня. Дети останутся такими же. Бабушка и дедушка и выше станут детьми родителей до тех пор, пока он не достигнет старого корня, который снова пройдет через детей.

У меня возникают проблемы с определением, где находится старый корень, и я часто добавляю нежелательный дополнительный узел снова. CreateDownNode проходит по дереву. CreateUpNode пересекает дерево.

Вот часть кода:

    procedure TfrmTreeListDown.btnSetRootClick(Sender: TObject);
    var
      SelectedTreeMember,
      TreeMember: PTreeViewMember;
      dblBrnchLngth,
      dblLngth: double;
      intNP: integer;
      strSlctText,
      strNewRootParent,
      strTopLabel: string;
      NdRoot,
      NCT,
      NCB,
      NPT,
      NSB,
      NdTree,
      NdTreeBottom,
      NdTreeTop: TTreeNode;
    begin
      if (trvwTextDownBased.Selected = nil) then
        exit;
      trvwTextDownBased.Selected;
      trvwRerootedTree.Items.Clear;
      NdRoot := nil;
      with TestTableForSpeciesData do
      begin
        intOldRoot[0] := NodeCount - 1;
        intOldRoot[1] := NodeCount;
        intOldRoot[2] := NodeCount + 1;
      end;
      if trvwTextDownBased.Selected.Parent <> nil then
      begin
        strTopLabel := trvwTextDownBased.Items[0].Text;
        strSlctText := trvwTextDownBased.Selected.Text;
        SelectedTreeMember := PTreeViewMember(trvwTextDownBased.Selected.Data);
        intNP := SelectedTreeMember^.intNodePos;
        strNewRootParent := trvwTextDownBased.Selected.Parent.Text;
        if intNP in [intOldRoot[0], intOldRoot[1], intOldRoot[2]] then
        begin
          NdTree := trvwRerootedTree.Items.AddFirst(NdRoot, '*New Root*' + strTopLabel);
          TreeMember := PTreeViewMember(trvwTextDownBased.Selected.Data);
          NdTreeBottom := trvwRerootedTree.Items.AddChild(NdTree, strBranchLabel(TreeMember^.intNodePos, 0));
        end
        else
        begin
          NdTree := trvwRerootedTree.Items.AddFirst(NdRoot, '*New Root*' + trvwTextDownBased.Selected.Text);
          TreeMember := PTreeViewMember(trvwTextDownBased.Selected.Data);
          dblBrnchLngth := TestTableForSpeciesData.Species[TreeMember^.intNodePos].BranchLength;
          dblLngth := dblSplitLength(dblBrnchLngth);
          NdTreeBottom := trvwRerootedTree.Items.AddChild(NdTree,  strBranchLabel(TreeMember^.intNodePos, dblLngth));
        end;
        If trvwTextDownBased.Selected.HasChildren then
        begin
          CreateDownNode(trvwTextDownBased.Selected, NdTreeBottom, kboolFirst);
          CreateDownNode(trvwTextDownBased.Selected, NdTreeBottom, kboolSecond);
        end;
        if trvwTextDownBased.Selected.Parent.Text = strTopLabel then
          if trvwTextDownBased.Selected.GetNextSibling = nil then
            NdTreeTop := trvwRerootedTree.Items.AddChildFirst(NdTree, trvwTextDownBased.Selected.GetPrevSibling.Text)
          else
            NdTreeTop := trvwRerootedTree.Items.AddChildFirst(NdTree, trvwTextDownBased.Selected.GetNextSibling.Text)
        else
          NdTreeTop := trvwRerootedTree.Items.AddChildFirst(NdTree, strBranchLabel(-1, dblBrnchLngth - dblLngth));
        if trvwTextDownBased.Selected.Parent.HasChildren then
          if trvwTextDownBased.Selected.Parent.GetFirstChild.Text <> trvwTextDownBased.Selected.Text then
          begin
            CreateDownNode(trvwTextDownBased.Selected.Parent.GetFirstChild, NdTreeTop, kboolFirst);
            CreateDownNode(trvwTextDownBased.Selected.Parent.GetFirstChild, NdTreeTop, kboolSecond);
          end
          else
          begin
            CreateDownNode(trvwTextDownBased.Selected.Parent.GetLastChild, NdTreeTop, kboolFirst);
            CreateDownNode(trvwTextDownBased.Selected.Parent.GetLastChild, NdTreeTop, kboolSecond);
          end;
        if trvwTextDownBased.Selected.Parent.Text <> trvwTextDownBased.Items[0].Text then
          CreateUpNode(trvwTextDownBased.Selected.Parent, NdTreeTop{, NdTreeBottomNSB});
        if trvwTextDownBased.Items.Count <> trvwRerootedTree.Items.Count then
          MessageDlg('Original Tree:' + IntToStr(trvwTextDownBased.Items.Count) + ' does not equal Rerooted Tree:' + IntToStr(trvwRerootedTree.Items.Count), mtWarning, [mbOK], 0);
      end;
  if trvwTextDownBased.Selected = nil then
    trvwRerootedTree.FullExpand;
end;

procedure TfrmTreeListDown.CreateDownNode(const tnOriginal, tnCurrent: TTreeNode; const boolFirstChild: boolean);
var
  tnChild: TTreeNode;
begin
  with trvwRerootedTree do
    if tnOriginal.HasChildren then
    begin
      if boolFirstChild then
      begin
        tnChild := Items.AddChildFirst(tnCurrent, tnOriginal.GetFirstChild.Text);
        CreateDownNode(tnOriginal.GetFirstChild, tnChild, kboolFirst);
        CreateDownNode(tnOriginal.GetFirstChild, tnChild, kboolSecond);
      end
      else
      begin
        tnChild := Items.AddChild(tnCurrent, tnOriginal.GetLastChild.Text);
        CreateDownNode(tnOriginal.GetLastChild, tnChild, kboolFirst);
        CreateDownNode(tnOriginal.GetLastChild, tnChild, kboolSecond);
      end;
    end
end;

procedure TfrmTreeListDown.CreateUpNode(const tnOriginal, tnCurrent: TTreeNode);
var
  PrntTreeMember: PTreeViewMember;
  tnSibling,
  tnParent: TTreeNode;
  intNP: integer;
begin
  with trvwRerootedTree do
  begin
    if tnOriginal <> nil then
    begin
      if tnOriginal.Parent.GetFirstChild.Text <> tnCurrent.Text then
      begin
        tnSibling := Items.AddChildFirst(tnCurrent, tnOriginal.Parent.GetFirstChild.Text);
        CreateDownNode(tnOriginal.Parent.GetFirstChild, tnSibling, kboolFirst);
        CreateDownNode(tnOriginal.Parent.GetFirstChild, tnSibling, kboolSecond);
      end
      else
      begin
        tnSibling := Items.AddChildFirst(tnCurrent, tnOriginal.Parent.GetLastChild.Text);
        CreateDownNode(tnOriginal.Parent.GetLastChild, tnSibling, kboolFirst);
        CreateDownNode(tnOriginal.Parent.GetLastChild, tnSibling, kboolSecond);
      end;
      if tnOriginal.Parent <> nil then
        if tnOriginal.Parent.Text <> trvwTextDownBased.Items[0].Text then
        begin
          PrntTreeMember := PTreeViewMember(tnOriginal.Parent.Data);
          intNP := PrntTreeMember^.intNodePos;
          if intNP in [intOldRoot[0], intOldRoot[1], intOldRoot[2]] then
            tnParent := Items.AddChildFirst(tnCurrent, strBranchLabel(-1, TestTableForSpeciesData.Species[TestTableForSpeciesData.NodeCount + 1].BranchLength))
          else
            tnParent := Items.AddChildFirst(tnCurrent, tnOriginal.Parent.Text);
          CreateUpNode(tnOriginal.Parent, tnParent{, tnSibling});
        end;
    end;
  end;
end;

0 ответов

Другие вопросы по тегам