<commit_before>{
    fpGUI  -  Free Pascal GUI Toolkit

    Copyright (C) 2006 - 2011 See the file AUTHORS.txt, included in this
    distribution, for details of the copyright.

    See the file COPYING.modifiedLGPL, included in this distribution,
    for details about redistributing fpGUI.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

    Description:
      Defines a basic Treeview control and Node classes. The treeview
      keeps track of the nodes in a double-linked list structure.
      Each Node as .prev and .next property pointing to it's neighbours.
}

unit fpg_tree;

{$mode objfpc}{$H+}

{
  TODO:
    * Lots! :-)
    * Columns need to be reworked. We don't want coluns per node levels. Instead
      we want a main column covering the tree. Then extra columns for user
      text and data.
    * Implement event handlers the user can hook into and do custom drawing.
    * TfpgTreeNode.HasChildren property is not fully implemented yet. The
      property is not update when you do .Append() or .AppendText() calls. It
      such cases .Count is prefered.
}

{.$Define Debug}

interface

uses
  Classes,
  SysUtils,
  fpg_base,
  fpg_main,
  fpg_widget,
  fpg_imagelist,
  fpg_scrollbar,
  fpg_menu;
  
type

  TfpgNodeAttachMode = (naAdd, naAddFirst, naAddChild, naAddChildFirst, naInsert);

  PfpgTreeColumnWidth = ^TfpgTreeColumnWidth;
  TfpgTreeColumnWidth = record
    next: PfpgTreeColumnWidth;
    width: word;
  end;
  
  // forward declaration
  TfpgTreeView = class;
  TfpgTreeNode = class;
  
  TfpgTreeNodeFindMethod = procedure(ANode: TfpgTreeNode; var AFound: boolean) of object;
  TfpgTreeExpandEvent = procedure(Sender: TObject; ANode: TfpgTreeNode) of object;
  TfpgStateImageClickedEvent = procedure(Sender: TObject; ANode: TfpgTreeNode) of object;


  TfpgTreeNode = class(TObject)
  private
    FCollapsed: boolean;
    FData: Pointer;
    FFirstSubNode: TfpgTreeNode; // the subnodes - for list implementation
    FImageIndex: integer;
    FInactSelColor: TfpgColor;
    FInactSelTextColor: TfpgColor;
    FLastSubNode: TfpgTreeNode;
    FNext: TfpgTreeNode;
    FParent: TfpgTreeNode;
    FPrev: TfpgTreeNode;
    FSelColor: TfpgColor;
    FSelTextColor: TfpgColor;
    FStateImageIndex: integer;
    FText: TfpgString;
    FTextColor: TfpgColor;
    FHasChildren: Boolean;
    FTree: TfpgTreeView;
    procedure   SetCollapsed(const AValue: boolean);
    procedure   SetInactSelColor(const AValue: TfpgColor);
    procedure   SetInactSelTextColor(const AValue: TfpgColor);
    procedure   SetParent(const AValue: TfpgTreeNode);
    procedure   SetSelColor(const AValue: TfpgColor);
    procedure   SetSelTextColor(const AValue: TfpgColor);
    procedure   SetText(const AValue: TfpgString);
    procedure   SetTextColor(const AValue: TfpgColor);
    procedure   DoRePaint;
    procedure   SetHasChildren(const AValue: Boolean);
    procedure   DoTreeCheck(ANode: TfpgTreeNode);
    procedure   SetStateImageIndex(const AValue: integer);
  public
    constructor Create;
    destructor  Destroy; override;
    // node related
    function    AppendText(AText: TfpgString): TfpgTreeNode;
    function    Count: integer;
    function    CountRecursive: integer;
    function    FindSubNode(AText: string; ARecursive: Boolean): TfpgTreeNode; overload;
    function    FindSubNode(ATreeNodeFindMethod: TfpgTreeNodeFindMethod): TfpgTreeNode; overload;
    function    FindSubNode(AData: TObject; ARecursive: Boolean): TfpgTreeNode; overload;
    function    GetMaxDepth: integer;
    function    GetMaxVisibleDepth: integer;
    procedure   Append(var ANode: TfpgTreeNode);
    procedure   Clear;  // remove all nodes recursively
    procedure   Collapse;
    procedure   Expand;
    procedure   Remove(var aNode: TfpgTreeNode);
    procedure   MoveTo(Destination: TfpgTreeNode; Mode: TfpgNodeAttachMode);
    procedure   UnregisterSubNode(aNode: TfpgTreeNode);
    // parent color settings
    function    ParentInactSelColor: TfpgColor;
    function    ParentInactSelTextColor: TfpgColor;
    function    ParentSelColor: TfpgColor;
    function    ParentSelTextColor: TfpgColor;
    function    ParentTextColor: TfpgColor;
    // general properties
    property    Collapsed: boolean read FCollapsed write SetCollapsed;
    property    Data: Pointer read FData write FData;
    property    FirstSubNode: TfpgTreeNode read FFirstSubNode;
    property    ImageIndex: integer read FImageIndex write FImageIndex;
    property    StateImageIndex: integer read FStateImageIndex write SetStateImageIndex;
    property    LastSubNode: TfpgTreeNode read FLastSubNode;
    property    Next: TfpgTreeNode read FNext write FNext;
    property    Parent: TfpgTreeNode read FParent write SetParent;
    property    Prev: TfpgTreeNode read FPrev write FPrev;
    property    Text: TfpgString read FText write SetText;
    { determines the + or - image in the treeview }
    property    HasChildren: Boolean read FHasChildren write SetHasChildren;
    // color settings
    property    InactSelColor: TfpgColor read FInactSelColor write SetInactSelColor;
    property    InactSelTextColor: TfpgColor read FInactSelTextColor write SetInactSelTextColor;
    property    SelColor: TfpgColor read FSelColor write SetSelColor;
    property    SelTextColor: TfpgColor read FSelTextColor write SetSelTextColor;
    property    TextColor: TfpgColor read FTextColor write SetTextColor;
  end;
  
  
  TfpgTreeView = class(TfpgWidget)
  private
    FImageList: TfpgImageList;
    FStateImageList: TfpgImageList;
    FColumnHeight: integer; // height of the column header
    FDefaultColumnWidth: word;
    FIndentNodeWithNoImage: boolean;
    FFirstColumn: PfpgTreeColumnWidth; // the list for column widths
    FFont: TfpgFont;
    FHScrollbar: TfpgScrollbar;
    FMoving: boolean;
    FMovingCol: integer;
    FMovingPos: integer;
    FNoImageIndent: integer;
    FOnChange: TNotifyEvent;
    FOnExpand: TfpgTreeExpandEvent;
    FOnStateImageClicked: TfpgStateImageClickedEvent;
    FRootNode: TfpgTreeNode;
    FScrollWheelDelta: integer;
    FSelection: TfpgTreeNode; // currently selected node
    FShowColumns: boolean;
    FShowImages : boolean;
    FTreeLineColor: TfpgColor;
    FTreeLineStyle: TfpgLineStyle;
    FVScrollbar: TfpgScrollbar;
    FXOffset: integer; // for repaint and scrollbar-calculation
    FYOffset: integer;
    FUpdateCount: integer;
    function    GetFontDesc: string;
    function    GetRootNode: TfpgTreeNode;
    procedure   SetDefaultColumnWidth(const AValue: word);
    procedure   SetFontDesc(const AValue: string);
    procedure   SetSelection(const AValue: TfpgTreeNode);
    procedure   SetShowColumns(const AValue: boolean);
    procedure   SetShowImages(const AValue: boolean);
    procedure   SetTreeLineColor(const AValue: TfpgColor);
    procedure   SetTreeLineStyle(const AValue: TfpgLineStyle);
    procedure   SetIndentNodeWithNoImage(const AValue: boolean);
    function    VisibleWidth: integer;
    function    VisibleHeight: integer;
    function    GetNodeHeightSum: integer;
    function    MaxNodeWidth: integer;
    function    GetNodeHeight: integer;
    // width of a node inclusive of image and state image
    function    GetNodeWidth(ANode: TfpgTreeNode): integer;
    function    NodeIsVisible(ANode: TfpgTreeNode): boolean;
    // returns the node-top in pixels
    function    GetAbsoluteNodeTop(ANode: TfpgTreeNode): integer;
    function    GetColumnLeft(AIndex: integer): integer;
    procedure   PreCalcColumnLeft;
    procedure   VScrollbarScroll(Sender: TObject; position: integer);
    procedure   HScrollbarScroll(Sender: TObject; position: integer);
    procedure   UpdateScrollbars;
    procedure   ResetScrollbar;
    procedure   ClearColumnLeft;
    procedure   FreeAllTreeNodes;
  protected
    FColumnLeft: TList;
    FPopupMenu: TfpgPopupMenu;
    procedure   HandleResize(awidth, aheight: TfpgCoord); override;
    procedure   HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override;
    procedure   HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override;
    procedure   HandleRMouseUp(x, y: integer; shiftstate: TShiftState); override;
    procedure   HandleDoubleClick(x, y: integer; button: word; shiftstate: TShiftState); override;
    procedure   HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
    procedure   HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override;
    procedure   HandleShow; override;
    procedure   HandlePaint; override;
    procedure   DrawHeader(ACol: integer; ARect: TfpgRect; AFlags: integer); virtual;
    procedure   DoChange; virtual;
    procedure   DoExpand(ANode: TfpgTreeNode); virtual;
    // the nodes between the given node and the direct next node
    function    SpaceToVisibleNext(aNode: TfpgTreeNode): integer;
    function    StepToRoot(aNode: TfpgTreeNode): integer;
    procedure   RePaint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure   SetColumnWidth(AIndex, AWidth: word);
    // the width of a column - aIndex of the rootnode = 0
    function    GetColumnWidth(AIndex: word): word;
    procedure   GotoNextNodeUp;
    procedure   GotoNextNodeDown;
    procedure   FullCollapse;
    procedure   FullExpand;
    // any next node, even if node is collapsed
    function    NextNode(ANode: TfpgTreeNode): TfpgTreeNode;
    function    PrevNode(ANode: TfpgTreeNode): TfpgTreeNode;
    // only visual (visible) nodes
    function    NextVisualNode(ANode: TfpgTreeNode): TfpgTreeNode;
    function    PrevVisualNode(ANode: TfpgTreeNode): TfpgTreeNode;
    procedure   BeginUpdate;
    procedure   EndUpdate;
    property    Font: TfpgFont read FFont;
    // Invisible node that starts the tree
    property    RootNode: TfpgTreeNode read GetRootNode;
    property    Selection: TfpgTreeNode read FSelection write SetSelection;
    property    ImageList: TfpgImageList read FImageList write FImageList;
    property    StateImageList: TfpgImageList read FStateImageList write FStateImageList;
    property    PopupMenu: TfpgPopupMenu read FPopupMenu write FPopupMenu;
  published
    property    Align;
    property    BackgroundColor default clListBox;
    property    DefaultColumnWidth: word read FDefaultColumnWidth write SetDefaultColumnWidth default 15;
    property    Enabled;
    property    FontDesc: string read GetFontDesc write SetFontDesc;
    property    IndentNodeWithNoImage: boolean read FIndentNodeWithNoImage write SetIndentNodeWithNoImage default True;
    property    NoImageIndent: integer read FNoImageIndent write FNoImageIndent default 16;
    property    ParentShowHint;
    property    ScrollWheelDelta: integer read FScrollWheelDelta write FScrollWheelDelta default 15;
    property    ShowColumns: boolean read FShowColumns write SetShowColumns default False;
    property    Hint;
    property    ShowHint;
    property    ShowImages: boolean read FShowImages write SetShowImages default False;
    property    TabOrder;
    property    TextColor;
    property    TreeLineColor: TfpgColor read FTreeLineColor write SetTreeLineColor default clShadow1;
    property    TreeLineStyle: TfpgLineStyle read FTreeLineStyle write SetTreeLineStyle default lsDot;
    property    OnChange: TNotifyEvent read FOnChange write FOnChange;
    property    OnExpand: TfpgTreeExpandEvent read FOnExpand write FOnExpand;
    property    OnDoubleClick;
    property    OnShowHint;
    property    OnStateImageClicked: TfpgStateImageClickedEvent read FOnStateImageClicked write FOnStateImageClicked;
  end;
  

implementation

{.$IFDEF DEBUG}
uses
  dbugintf;
{.$ENDIF}

type
  PColumnLeft = ^integer;


{ TfpgTreeNode }

procedure TfpgTreeNode.SetInactSelColor(const AValue: TfpgColor);
begin
  if AValue <> FInactSelColor then
  begin
    FInactSelColor := AValue;
    DoRePaint;
  end;
end;

procedure TfpgTreeNode.SetCollapsed(const AValue: boolean);
begin
  if aValue <> FCollapsed then
  begin
    FCollapsed := AValue;
    DoRePaint;
  end;
end;

procedure TfpgTreeNode.SetInactSelTextColor(const AValue: TfpgColor);
begin
  if AValue <> FInactSelTextColor then
  begin
    FInactSelTextColor := AValue;
    DoRePaint;
  end;
end;

procedure TfpgTreeNode.SetParent(const AValue: TfpgTreeNode);
begin
  if aValue <> FParent then
  begin
    if FParent <> nil then
      FParent.UnRegisterSubNode(self); // unregisteres
    FParent := aValue;
    if FParent <> nil then
    begin
      DoRePaint;
    end;
  end;
end;

procedure TfpgTreeNode.SetSelColor(const AValue: TfpgColor);
begin
  if FSelColor <> aValue then
  begin
    FSelColor := aValue;
    DoRePaint;
  end;
end;

procedure TfpgTreeNode.SetSelTextColor(const AValue: TfpgColor);
begin
  if FTextColor <> aValue then
  begin
    FSelTextColor := aValue;
    DoRePaint;
  end;
end;

procedure TfpgTreeNode.SetText(const AValue: TfpgString);
begin
  if AValue <> FText then
  begin
    FText := aValue;
    DoRePaint;
  end;
end;

procedure TfpgTreeNode.SetTextColor(const AValue: TfpgColor);
begin
  if FTextColor <> aValue then
  begin
    FTextColor := aValue;
    DoRePaint;
  end;
end;

procedure TfpgTreeNode.DoRePaint;
begin
//  FTree.Invalidate;
end;

procedure TfpgTreeNode.SetHasChildren(const AValue: Boolean);
begin
  if FHasChildren <> AValue then
  begin
    FHasChildren := AValue;
    DoRePaint;
  end;
end;

procedure TfpgTreeNode.DoTreeCheck(ANode: TfpgTreeNode);
begin
  if ANode.FTree <> FTree then
    raise Exception.Create('Nodes must be of the same tree');
end;

procedure TfpgTreeNode.SetStateImageIndex(const AValue: integer);
begin
  if FStateImageIndex = AValue then
    exit;
  FStateImageIndex := AValue;
  DoRepaint;
end;

constructor TfpgTreeNode.Create;
begin
  FData           := nil;
  FFirstSubNode   := nil;
  FLastSubNode    := nil;
  FText           := '';
  FImageIndex     := -1;
  FStateImageIndex := -1;
  FCollapsed      := True;
  FHasChildren    := False;

  FParent     := nil;
  FNext       := nil;
  FPrev       := nil;

  FSelColor           := clUnset;
  FSelTextColor       := clUnset;
  FTextColor          := clUnset;
  FInactSelColor      := clUnset;
  FInactSelTextColor  := clUnset;
end;

destructor TfpgTreeNode.Destroy;
begin
  if FParent <> nil then
    FParent.UnregisterSubNode(self);
  Clear;
  FData       := nil;
  FParent     := nil;
  FNext       := nil;
  FPrev       := nil;
  FFirstSubNode   := nil;
  FLastSubNode    := nil;
  inherited Destroy;
end;

procedure TfpgTreeNode.UnregisterSubNode(aNode: TfpgTreeNode);
var
  h: TfpgTreeNode;
begin
  h := FFirstSubNode;
  while h <> nil do
  begin
    if h = aNode then
    begin
      if h = FFirstSubNode then
        FFirstSubNode := FFirstSubNode.Next;
      if h = FLastSubNode then
        FLastSubNode := FLastSubNode.Prev;
      if h.prev <> nil then
        h.prev.next := h.next;
      if h.next <> nil then
        h.next.prev := h.prev;
      exit;
    end;
    h := h.next;
  end;
end;

procedure TfpgTreeNode.Append(var ANode: TfpgTreeNode);
begin
  DoTreeCheck(ANode);
  ANode.Parent := self;
  ANode.Next   := nil;

  if FFirstSubNode = nil then
    FFirstSubNode := ANode;

  ANode.Prev := FLastSubNode;

  if FLastSubNode <> nil then
    FLastSubNode.Next := ANode;

  FLastSubNode := ANode;
  FHasChildren := True;
end;

function TfpgTreeNode.FindSubNode(AText: string; ARecursive: Boolean): TfpgTreeNode;
var
  h: TfpgTreeNode;
begin
  result := nil;
  if ARecursive then
  begin
    h := FirstSubNode;
    while h <> nil do
    begin
      if h.Text = AText then
      begin
        result := h;
        Exit; //==>
      end;
      if h.count > 0 then
      begin
        result := h.FindSubNode(AText, ARecursive);
        if result <> nil then
          Exit; //==>
      end;
      h := h.next;
    end;  { while }
  end
  else
  begin
    h := FirstSubNode;
    while h <> nil do
    begin
      if h.Text = AText then
      begin
        result := h;
        break;
      end;
      h := h.next;
    end;
  end;  { if/else }
end;

function TfpgTreeNode.FindSubNode(ATreeNodeFindMethod: TfpgTreeNodeFindMethod): TfpgTreeNode;
var
  lFound: Boolean;
  h: TfpgTreeNode;
begin
  result := nil;
  lFound := False;
  if not Assigned(ATreeNodeFindMethod) then
    Exit; //==>

  h := FirstSubNode;
  while h <> nil do
  begin
    ATreeNodeFindMethod(h, lFound);
    if lFound then
    begin
      result := h;
      Exit; //==>
    end;
    if h.Count > 0 then
    begin
      result := h.FindSubNode(ATreeNodeFindMethod);
      if result <> nil then
        Exit; //==>
    end;
    h := h.next;
  end;
end;

function TfpgTreeNode.FindSubNode(AData: TObject; ARecursive: Boolean): TfpgTreeNode;
var
  h: TfpgTreeNode;
begin
  result := nil;
  if ARecursive then
  begin
    h := FirstSubNode;
    while h <> nil do
    begin
      if TObject(h.Data) = AData then
      begin
        result := h;
        Exit; //==>
      end;
      if h.count > 0 then
      begin
        result := h.FindSubNode(AData, ARecursive);
        if result <> nil then
          Exit; //==>
      end;
      h := h.next;
    end;  { while }
  end
  else
  begin
    h := FirstSubNode;
    while h <> nil do
    begin
      if TObject(h.Data) = AData then
      begin
        result := h;
        break;
      end;
      h := h.next;
    end;
  end;  { if/else }
end;

function TfpgTreeNode.AppendText(AText: TfpgString): TfpgTreeNode;
var
  h: TfpgTreeNode;
begin
  {$IFDEF DEBUG}
  SendDebug(Classname + '.AppendText');
  {$ENDIF}
  h := TfpgTreeNode.Create;
  h.FTree := FTree;
  h.Text := AText;
  Append(h);
  result := h;
end;

function TfpgTreeNode.GetMaxDepth: integer;
var
  h: TfpgTreeNode;
  a: integer;
  t: integer;
begin
  {$IFDEF DEBUG}
  SendDebug(Classname + '.GetMaxDepth');
  {$ENDIF}
  h := FirstSubNode;
  result := 1;
  a := 0;
  while h <> nil do
  begin
    t := h.GetMaxDepth;
    if t > a then
      a := t;
    h := h.next;
  end;
  result := result + a;
end;

function TfpgTreeNode.GetMaxVisibleDepth: integer;
var
  h: TfpgTreeNode;
  a: integer;
  t: integer;
begin
  {$IFDEF DEBUG}
  SendDebug(Classname + '.GetMaxVisibleDepth');
  {$ENDIF}
  result := 1;
  h := FirstSubNode;
  if h.Collapsed then
    exit;
  a := 0;
  while h <> nil do
  begin
    t := h.GetMaxDepth;
    if t > a then
      a := t;
    h := h.next;
  end;
  result := result + a;
end;

procedure TfpgTreeNode.Collapse;
begin
  Collapsed := True;
end;

procedure TfpgTreeNode.Expand;
begin
  Collapsed := False;
end;

function TfpgTreeNode.Count: integer;
var
  h: TfpgTreeNode;
  i: integer;
begin
  h := FirstSubNode;
  i := 0;
  while h <> nil do
  begin
    inc(i);
    h := h.next;
  end;
  result := i;
end;

function TfpgTreeNode.CountRecursive: integer;
var
  h: TfpgTreeNode;
  i: integer;
begin
  h := FFirstSubNode;
  i := 0;
  while h <> nil do
  begin
    inc(i); // current node
    i := i + h.CountRecursive; // increases i by the count of the subnodes of the subnode
    h := h.next;
  end;
  result := i;
end;

procedure TfpgTreeNode.Remove(var aNode: TfpgTreeNode);
begin
  if FirstSubNode = aNode then
  begin
    FFirstSubNode := aNode.next;
    if FFirstSubNode <> nil then
      FFirstSubNode.Prev := nil;
  end
  else
  begin
    if aNode.prev <> nil then
      aNode.Prev.next := aNode.next;
  end;

  if LastSubNode = aNode then
  begin
    FLastSubNode := aNode.prev;
    if FLastSubNode <> nil then
      FLastSubNode.next := nil;
  end
  else
  begin
    if aNode.next <> nil then
      aNode.next.prev := aNode.prev;
  end;

  aNode.prev := nil;
  aNode.next := nil;
  aNode.parent := nil;
end;

procedure TfpgTreeNode.MoveTo(Destination: TfpgTreeNode; Mode: TfpgNodeAttachMode);
begin
  if Destination = nil then
    Exit;
  DoTreeCheck(Destination);

  Parent.Remove(self);
  case Mode of
    naAdd:
        begin
          Destination.Parent.Append(self);
        end;
    naAddFirst:
        begin
          Next := Destination.Parent.FirstSubNode;
          Next.Prev := self;
          Destination.Parent.FFirstSubNode := self;
          Parent := Destination.Parent;
        end;
    naAddChild:
        begin
          Destination.Append(self);
        end;
    naAddChildFirst:
        begin
          Next := Destination.FirstSubNode;
          if Assigned(Destination.FirstSubNode) then
            Destination.FirstSubNode.Prev := self;
          Destination.FFirstSubNode := self;
          Parent := Destination;
          if Destination.LastSubNode = nil then
            Destination.FLastSubNode := self;
        end;
    naInsert:
        begin
          Prev := Destination.Prev;
          Next := Destination;
          Parent := Destination.Parent;
          Destination.Prev := self;
          if Prev = nil then
            Parent.FFirstSubNode := self
          else
            Prev.Next := self;
        end;
  end;  { case }
end;

procedure TfpgTreeNode.Clear;
var
  n: TfpgTreeNode;
  tn: TfpgTreeNode;
begin
  n := LastSubNode;
  while n <> nil do
  begin
    tn := n;
    n := n.prev;
    Remove(tn);
    tn.Free;
  end;
  FHasChildren := False;
end;

function TfpgTreeNode.ParentTextColor: TfpgColor;
begin
  if TextColor <> clUnset then
    result := TextColor
  else
  begin
    if parent <> nil then
      result := parent.ParentTextColor
    else
      result := clText1;
  end;
end;

function TfpgTreeNode.ParentSelTextColor: TfpgColor;
begin
  if SelTextColor <> clUnset then
    result := SelTextColor
  else
  begin
    if parent <> nil then
      result := parent.ParentSelTextColor
    else
      result := clSelectionText;
  end;
end;

function TfpgTreeNode.ParentSelColor: TfpgColor;
begin
  if SelColor <> clUnset then
    result := SelColor
  else
  begin
    if parent <> nil then
      result := parent.ParentSelColor
    else
      result := clSelection;
  end;
end;

function TfpgTreeNode.ParentInactSelTextColor: TfpgColor;
begin
  if InactSelTextColor <> clUnset then
    result := InactSelTextColor
  else
  begin
    if Parent <> nil then
      Result := Parent.ParentInactSelTextColor
    else
      Result := clInactiveSelText;
  end;
end;

function TfpgTreeNode.ParentInactSelColor: TfpgColor;
begin
  if InactSelColor <> clUnset then
    result := InactSelColor
  else
  begin
    if Parent <> nil then
      result := parent.ParentInactSelColor
    else
      result := clInactiveSel;
  end;
end;

{ TfpgTreeview }

procedure TfpgTreeview.VScrollbarScroll(Sender: TObject; position: integer);
begin
  {$IFDEF DEBUG}
  SendDebug(Classname + '.VScrollbarMove');
  {$ENDIF}
  FYOffset := Position;
  RePaint;
end;

function TfpgTreeview.GetFontDesc: string;
begin
  Result := FFont.FontDesc;
end;

function TfpgTreeview.GetRootNode: TfpgTreeNode;
begin
  if FRootNode = nil then
  begin
    FRootNode := TfpgTreeNode.Create;
    FRootNode.FTree := self;
  end;
  FRootNode.TextColor     := clText1;
  FRootnode.SelTextColor  := clSelectionText;
  FRootnode.SelColor      := clSelection;
  Result := FRootNode;
end;

procedure TfpgTreeview.SetDefaultColumnWidth(const AValue: word);
begin
  if (aValue <> FDefaultColumnWidth) and (aValue > 3) then
  begin
    FDefaultColumnWidth := AValue;
    RePaint;
  end;
end;

procedure TfpgTreeview.SetFontDesc(const AValue: string);
begin
  FFont.Free;
  FFont := fpgGetFont(AValue);
  RePaint;
end;

procedure TfpgTreeview.SetSelection(const AValue: TfpgTreeNode);
var
  n: TfpgTreeNode;
  dy: integer;    // y delta - absolute top node
  nh: integer;    // node height
  vh: integer;    // visible height
begin
  if AValue <> FSelection then
  begin
    FSelection := AValue;
    if AValue <> nil then
    begin
      n := AValue.Parent;
      while n <> nil do
      begin
        if n.Collapsed then
        begin
          n.Expand;
          DoExpand(n);
        end;
        n := n.parent;
      end;
      UpdateScrollbars;
    end;

    dy := GetAbsoluteNodeTop(FSelection);
    nh := GetNodeHeight;
    vh := VisibleHeight;
    if dy + nh - FVScrollbar.Position > vh then
    begin
      if FVScrollBar.Max = 0 then    // the first time and no expansion happened before.
        FVScrollBar.Max := dy + Height;
      FVScrollbar.Position := dy + nh - (vh div 2);
      FYOffset := FVScrollbar.Position;
      UpdateScrollBars;
      if FHScrollbar.Visible then    // HScrollbar appeared so we need to adjust position again
      begin
        FVScrollbar.Position := FVScrollbar.Position + FHScrollbar.Height;
        FYOffset := FVScrollbar.Position;
        UpdateScrollBars;
      end;
    end;
    
    if dy - FVScrollbar.Position < 0 then
    begin
      FVScrollbar.Position := dy;
      FYOffset := FVScrollbar.Position;
      UpdateScrollbars;
    end;
  end;
end;

procedure TfpgTreeview.SetShowColumns(const AValue: boolean);
begin
  if FShowColumns <> aValue then
  begin
    FShowColumns := aValue;
    RePaint;
  end;
end;

procedure TfpgTreeview.SetShowImages(const AValue: boolean);
begin
  if AValue <> FShowImages then
  begin
    FShowImages := AValue;
    UpdateScrollbars;
    RePaint;
  end;
end;

procedure TfpgTreeview.SetTreeLineColor(const AValue: TfpgColor);
begin
  if FTreeLineColor = AValue then
    Exit; //==>
  FTreeLineColor := AValue;
  RePaint;
end;

procedure TfpgTreeview.SetTreeLineStyle(const AValue: TfpgLineStyle);
begin
  if FTreeLineStyle = AValue then
    Exit; //==>
  FTreeLineStyle := AValue;
  RePaint;
end;

procedure TfpgTreeView.SetIndentNodeWithNoImage(const AValue: boolean);
begin
  if AValue <> FIndentNodeWithNoImage then
  begin
    FIndentNodeWithNoImage := AValue;
    UpdateScrollbars;
    RePaint;
  end;
end;

function TfpgTreeview.VisibleWidth: integer;
begin
  Result := Width - 2; // border width = 2 pixels
  if FVScrollbar.Visible then
     dec(Result, FVScrollbar.Width);
end;

function TfpgTreeview.VisibleHeight: integer;
begin
  Result := Height - 2; // border width = 2 pixels
  if FShowColumns then
    dec(Result, FColumnHeight);
  if FHScrollbar.Visible then
    dec(Result, FHScrollbar.Height);
end;

function TfpgTreeview.GetNodeHeightSum: integer;
var
  h: TfpgTreeNode;
  i: integer;
begin
  h := RootNode;
  i := -1;
  while h <> nil do
  begin
    inc(i);
    if (not h.Collapsed) and (h.Count > 0) then
    begin
      h := h.FirstSubNode;
    end
    else
    begin
      if h.next <> nil then
        h := h.next
      else
      begin
        while h.next = nil do
        begin
          h := h.parent;
          if h = nil then
          begin
            result := i;
            exit;
          end;
        end;
        h := h.next;
      end;
    end;
  end;
  result := i;
end;

function TfpgTreeview.MaxNodeWidth: integer;
var
  h: TfpgTreeNode;
  w: integer;
  r: integer;
begin
  {$IFDEF DEBUG}
  SendDebug(Classname + '.MaxNodeWidth');
  {$ENDIF}
  result := 0;
  h := RootNode.FirstSubNode;
  r := 0;
  while h <> nil do
  begin
    w := GetColumnLeft(StepToRoot(h));
    if r < w + GetNodeWidth(h) then
      r := w + GetNodeWidth(h);
    if (not h.collapsed) and (h.count > 0) then
      h := h.FirstSubNode
    else
    begin
      if h.next <> nil then
        h := h.next
      else
      begin
        while h.next = nil do
        begin
          h := h.parent;
          if h = nil then
          begin
            result := r + 4;
            exit;
          end;
        end;  { while }
        h := h.next;
      end;
    end;  { if/else }
  end;  { while }
end;

function TfpgTreeview.GetNodeHeight: integer;
begin
  Result := FFont.Height + 2;
end;

function TfpgTreeview.GetNodeWidth(ANode: TfpgTreeNode): integer;
var
  lImageItem: TfpgImageItem;
begin
  {$IFDEF DEBUG}
  SendDebug(Classname + '.GetNodeWidth');
  {$ENDIF}
  if ANode = nil then
    Result := 0
  else
  begin
    Result := FFont.TextWidth(ANode.Text) + 4;
    if ShowImages and ((ImageList <> nil) or (StateImageList <> nil)) then
    begin
      if ImageList <> nil then
      begin
        if ANode.ImageIndex > -1 then
        begin
          lImageItem := ImageList.Items[ANode.ImageIndex];
          if lImageItem <> nil then
            result += lImageItem.Image.Width + 2;
        end
        else if IndentNodeWithNoImage then
          result += NoImageIndent + 2;
      end
      else if IndentNodeWithNoImage then
        result += NoImageIndent + 2;

      if StateImageList <> nil then
      begin
        if ANode.StateImageIndex > -1 then
        begin
          lImageItem := StateImageList.Items[ANode.StateImageIndex];
          if lImageItem <> nil then
            result += lImageItem.Image.Width + 2;
        end
        else if IndentNodeWithNoImage then
          result += NoImageIndent + 2;
      end;
    end;
  end;  { if/else }
end;

function TfpgTreeview.NodeIsVisible(ANode: TfpgTreeNode): boolean;
begin
  Result := True;
  if ANode = nil then
  begin
    Result := False;
    exit;
  end;
  ANode := ANode.Parent;
  while ANode <> nil do
  begin
    if ANode.Collapsed and (ANode.Parent <> nil) then
      Result := False;
    ANode := ANode.Parent;
  end;
end;

function TfpgTreeview.GetAbsoluteNodeTop(ANode: TfpgTreeNode): integer;
var
  i: integer;
begin
  i := 0;
  while (ANode <> nil) and (ANode <> RootNode) do
  begin
    ANode := PrevVisualNode(ANode);
    inc(i);
  end;
  result := (i - 1) * GetNodeHeight;
end;

function TfpgTreeview.GetColumnLeft(AIndex: integer): integer;
begin
  if FColumnLeft = nil then
    PreCalcColumnLeft;

  if AIndex < 0 then
    Result := 0
  else
  begin
    if AIndex > FColumnLeft.Count - 1 then
      result := PColumnLeft(FColumnLeft[FColumnLeft.Count - 1])^
    else
      result := PColumnLeft(FColumnLeft[AIndex])^;
  end;
end;

function TfpgTreeview.GetColumnWidth(AIndex: word): word;
var
  h: PfpgTreeColumnWidth;
  i: integer;
begin
{$IFDEF DEBUG}
  SendDebug(Classname + '.GetColumnWidth');
{$ENDIF}
  h := FFirstColumn;
  i := 0;
  if h = nil then // not found
  begin
    result := DefaultColumnWidth;
    exit;
  end;
  while i < aIndex do
  begin
    if h = nil then // not found - returns the default
    begin
      result := DefaultColumnWidth;
      exit;
    end;
    h := h^.next;
    inc(i);
  end;
  if h <> nil then
    result := h^.width
  else // not found -> returns the default
    result := DefaultColumnWidth;
end;

procedure TfpgTreeView.GotoNextNodeUp;
begin
  if Selection = RootNode.FirstSubNode then
    Exit;
  Selection := PrevNode(Selection);
end;

procedure TfpgTreeView.GotoNextNodeDown;
var
  lNode: TfpgTreeNode;
begin
  if (Selection = RootNode.LastSubNode) and (RootNode.LastSubNode.CountRecursive = 0) then
    Exit;

  lNode := NextNode(Selection);
  if lNode <> nil then
    Selection := lNode;
end;

procedure TfpgTreeView.FullCollapse;
var
  n: TfpgTreeNode;<commit_msg>New method GetNodeAt() for TfpgTreeView.<commit_after>{
    fpGUI  -  Free Pascal GUI Toolkit

    Copyright (C) 2006 - 2011 See the file AUTHORS.txt, included in this
    distribution, for details of the copyright.

    See the file COPYING.modifiedLGPL, included in this distribution,
    for details about redistributing fpGUI.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

    Description:
      Defines a basic Treeview control and Node classes. The treeview
      keeps track of the nodes in a double-linked list structure.
      Each Node as .prev and .next property pointing to it's neighbours.
}

unit fpg_tree;

{$mode objfpc}{$H+}

{
  TODO:
    * Lots! :-)
    * Columns need to be reworked. We don't want coluns per node levels. Instead
      we want a main column covering the tree. Then extra columns for user
      text and data.
    * Implement event handlers the user can hook into and do custom drawing.
    * TfpgTreeNode.HasChildren property is not fully implemented yet. The
      property is not update when you do .Append() or .AppendText() calls. It
      such cases .Count is prefered.
}

{.$Define Debug}

interface

uses
  Classes,
  SysUtils,
  fpg_base,
  fpg_main,
  fpg_widget,
  fpg_imagelist,
  fpg_scrollbar,
  fpg_menu;
  
type

  TfpgNodeAttachMode = (naAdd, naAddFirst, naAddChild, naAddChildFirst, naInsert);

  PfpgTreeColumnWidth = ^TfpgTreeColumnWidth;
  TfpgTreeColumnWidth = record
    next: PfpgTreeColumnWidth;
    width: word;
  end;
  
  // forward declaration
  TfpgTreeView = class;
  TfpgTreeNode = class;
  
  TfpgTreeNodeFindMethod = procedure(ANode: TfpgTreeNode; var AFound: boolean) of object;
  TfpgTreeExpandEvent = procedure(Sender: TObject; ANode: TfpgTreeNode) of object;
  TfpgStateImageClickedEvent = procedure(Sender: TObject; ANode: TfpgTreeNode) of object;


  TfpgTreeNode = class(TObject)
  private
    FCollapsed: boolean;
    FData: Pointer;
    FFirstSubNode: TfpgTreeNode; // the subnodes - for list implementation
    FImageIndex: integer;
    FInactSelColor: TfpgColor;
    FInactSelTextColor: TfpgColor;
    FLastSubNode: TfpgTreeNode;
    FNext: TfpgTreeNode;
    FParent: TfpgTreeNode;
    FPrev: TfpgTreeNode;
    FSelColor: TfpgColor;
    FSelTextColor: TfpgColor;
    FStateImageIndex: integer;
    FText: TfpgString;
    FTextColor: TfpgColor;
    FHasChildren: Boolean;
    FTree: TfpgTreeView;
    procedure   SetCollapsed(const AValue: boolean);
    procedure   SetInactSelColor(const AValue: TfpgColor);
    procedure   SetInactSelTextColor(const AValue: TfpgColor);
    procedure   SetParent(const AValue: TfpgTreeNode);
    procedure   SetSelColor(const AValue: TfpgColor);
    procedure   SetSelTextColor(const AValue: TfpgColor);
    procedure   SetText(const AValue: TfpgString);
    procedure   SetTextColor(const AValue: TfpgColor);
    procedure   DoRePaint;
    procedure   SetHasChildren(const AValue: Boolean);
    procedure   DoTreeCheck(ANode: TfpgTreeNode);
    procedure   SetStateImageIndex(const AValue: integer);
  public
    constructor Create;
    destructor  Destroy; override;
    // node related
    function    AppendText(AText: TfpgString): TfpgTreeNode;
    function    Count: integer;
    function    CountRecursive: integer;
    function    FindSubNode(AText: string; ARecursive: Boolean): TfpgTreeNode; overload;
    function    FindSubNode(ATreeNodeFindMethod: TfpgTreeNodeFindMethod): TfpgTreeNode; overload;
    function    FindSubNode(AData: TObject; ARecursive: Boolean): TfpgTreeNode; overload;
    function    GetMaxDepth: integer;
    function    GetMaxVisibleDepth: integer;
    procedure   Append(var ANode: TfpgTreeNode);
    procedure   Clear;  // remove all nodes recursively
    procedure   Collapse;
    procedure   Expand;
    procedure   Remove(var aNode: TfpgTreeNode);
    procedure   MoveTo(Destination: TfpgTreeNode; Mode: TfpgNodeAttachMode);
    procedure   UnregisterSubNode(aNode: TfpgTreeNode);
    // parent color settings
    function    ParentInactSelColor: TfpgColor;
    function    ParentInactSelTextColor: TfpgColor;
    function    ParentSelColor: TfpgColor;
    function    ParentSelTextColor: TfpgColor;
    function    ParentTextColor: TfpgColor;
    // general properties
    property    Collapsed: boolean read FCollapsed write SetCollapsed;
    property    Data: Pointer read FData write FData;
    property    FirstSubNode: TfpgTreeNode read FFirstSubNode;
    property    ImageIndex: integer read FImageIndex write FImageIndex;
    property    StateImageIndex: integer read FStateImageIndex write SetStateImageIndex;
    property    LastSubNode: TfpgTreeNode read FLastSubNode;
    property    Next: TfpgTreeNode read FNext write FNext;
    property    Parent: TfpgTreeNode read FParent write SetParent;
    property    Prev: TfpgTreeNode read FPrev write FPrev;
    property    Text: TfpgString read FText write SetText;
    { determines the + or - image in the treeview }
    property    HasChildren: Boolean read FHasChildren write SetHasChildren;
    // color settings
    property    InactSelColor: TfpgColor read FInactSelColor write SetInactSelColor;
    property    InactSelTextColor: TfpgColor read FInactSelTextColor write SetInactSelTextColor;
    property    SelColor: TfpgColor read FSelColor write SetSelColor;
    property    SelTextColor: TfpgColor read FSelTextColor write SetSelTextColor;
    property    TextColor: TfpgColor read FTextColor write SetTextColor;
  end;
  
  
  TfpgTreeView = class(TfpgWidget)
  private
    FImageList: TfpgImageList;
    FStateImageList: TfpgImageList;
    FColumnHeight: integer; // height of the column header
    FDefaultColumnWidth: word;
    FIndentNodeWithNoImage: boolean;
    FFirstColumn: PfpgTreeColumnWidth; // the list for column widths
    FFont: TfpgFont;
    FHScrollbar: TfpgScrollbar;
    FMoving: boolean;
    FMovingCol: integer;
    FMovingPos: integer;
    FNoImageIndent: integer;
    FOnChange: TNotifyEvent;
    FOnExpand: TfpgTreeExpandEvent;
    FOnStateImageClicked: TfpgStateImageClickedEvent;
    FRootNode: TfpgTreeNode;
    FScrollWheelDelta: integer;
    FSelection: TfpgTreeNode; // currently selected node
    FShowColumns: boolean;
    FShowImages : boolean;
    FTreeLineColor: TfpgColor;
    FTreeLineStyle: TfpgLineStyle;
    FVScrollbar: TfpgScrollbar;
    FXOffset: integer; // for repaint and scrollbar-calculation
    FYOffset: integer;
    FUpdateCount: integer;
    function    GetFontDesc: string;
    function    GetRootNode: TfpgTreeNode;
    procedure   SetDefaultColumnWidth(const AValue: word);
    procedure   SetFontDesc(const AValue: string);
    procedure   SetSelection(const AValue: TfpgTreeNode);
    procedure   SetShowColumns(const AValue: boolean);
    procedure   SetShowImages(const AValue: boolean);
    procedure   SetTreeLineColor(const AValue: TfpgColor);
    procedure   SetTreeLineStyle(const AValue: TfpgLineStyle);
    procedure   SetIndentNodeWithNoImage(const AValue: boolean);
    function    VisibleWidth: integer;
    function    VisibleHeight: integer;
    function    GetNodeHeightSum: integer;
    function    MaxNodeWidth: integer;
    function    GetNodeHeight: integer;
    // width of a node inclusive of image and state image
    function    GetNodeWidth(ANode: TfpgTreeNode): integer;
    function    NodeIsVisible(ANode: TfpgTreeNode): boolean;
    // returns the node-top in pixels
    function    GetAbsoluteNodeTop(ANode: TfpgTreeNode): integer;
    function    GetColumnLeft(AIndex: integer): integer;
    procedure   PreCalcColumnLeft;
    procedure   VScrollbarScroll(Sender: TObject; position: integer);
    procedure   HScrollbarScroll(Sender: TObject; position: integer);
    procedure   UpdateScrollbars;
    procedure   ResetScrollbar;
    procedure   ClearColumnLeft;
    procedure   FreeAllTreeNodes;
  protected
    FColumnLeft: TList;
    FPopupMenu: TfpgPopupMenu;
    procedure   HandleResize(awidth, aheight: TfpgCoord); override;
    procedure   HandleLMouseUp(x, y: integer; shiftstate: TShiftState); override;
    procedure   HandleLMouseDown(x, y: integer; shiftstate: TShiftState); override;
    procedure   HandleRMouseUp(x, y: integer; shiftstate: TShiftState); override;
    procedure   HandleDoubleClick(x, y: integer; button: word; shiftstate: TShiftState); override;
    procedure   HandleKeyPress(var keycode: word; var shiftstate: TShiftState; var consumed: boolean); override;
    procedure   HandleMouseScroll(x, y: integer; shiftstate: TShiftState; delta: smallint); override;
    procedure   HandleShow; override;
    procedure   HandlePaint; override;
    procedure   DrawHeader(ACol: integer; ARect: TfpgRect; AFlags: integer); virtual;
    procedure   DoChange; virtual;
    procedure   DoExpand(ANode: TfpgTreeNode); virtual;
    // the nodes between the given node and the direct next node
    function    SpaceToVisibleNext(aNode: TfpgTreeNode): integer;
    function    StepToRoot(aNode: TfpgTreeNode): integer;
    procedure   RePaint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    procedure   SetColumnWidth(AIndex, AWidth: word);
    // the width of a column - aIndex of the rootnode = 0
    function    GetColumnWidth(AIndex: word): word;
    function    GetNodeAt(const X, Y: integer): TfpgTreeNode;
    procedure   GotoNextNodeUp;
    procedure   GotoNextNodeDown;
    procedure   FullCollapse;
    procedure   FullExpand;
    // any next node, even if node is collapsed
    function    NextNode(ANode: TfpgTreeNode): TfpgTreeNode;
    function    PrevNode(ANode: TfpgTreeNode): TfpgTreeNode;
    // only visual (visible) nodes
    function    NextVisualNode(ANode: TfpgTreeNode): TfpgTreeNode;
    function    PrevVisualNode(ANode: TfpgTreeNode): TfpgTreeNode;
    procedure   BeginUpdate;
    procedure   EndUpdate;
    property    Font: TfpgFont read FFont;
    // Invisible node that starts the tree
    property    RootNode: TfpgTreeNode read GetRootNode;
    property    Selection: TfpgTreeNode read FSelection write SetSelection;
    property    ImageList: TfpgImageList read FImageList write FImageList;
    property    StateImageList: TfpgImageList read FStateImageList write FStateImageList;
    property    PopupMenu: TfpgPopupMenu read FPopupMenu write FPopupMenu;
  published
    property    Align;
    property    BackgroundColor default clListBox;
    property    DefaultColumnWidth: word read FDefaultColumnWidth write SetDefaultColumnWidth default 15;
    property    Enabled;
    property    FontDesc: string read GetFontDesc write SetFontDesc;
    property    IndentNodeWithNoImage: boolean read FIndentNodeWithNoImage write SetIndentNodeWithNoImage default True;
    property    NoImageIndent: integer read FNoImageIndent write FNoImageIndent default 16;
    property    ParentShowHint;
    property    ScrollWheelDelta: integer read FScrollWheelDelta write FScrollWheelDelta default 15;
    property    ShowColumns: boolean read FShowColumns write SetShowColumns default False;
    property    Hint;
    property    ShowHint;
    property    ShowImages: boolean read FShowImages write SetShowImages default False;
    property    TabOrder;
    property    TextColor;
    property    TreeLineColor: TfpgColor read FTreeLineColor write SetTreeLineColor default clShadow1;
    property    TreeLineStyle: TfpgLineStyle read FTreeLineStyle write SetTreeLineStyle default lsDot;
    property    OnChange: TNotifyEvent read FOnChange write FOnChange;
    property    OnExpand: TfpgTreeExpandEvent read FOnExpand write FOnExpand;
    property    OnDoubleClick;
    property    OnShowHint;
    property    OnStateImageClicked: TfpgStateImageClickedEvent read FOnStateImageClicked write FOnStateImageClicked;
  end;
  

implementation

{.$IFDEF DEBUG}
uses
  dbugintf;
{.$ENDIF}

type
  PColumnLeft = ^integer;


{ TfpgTreeNode }

procedure TfpgTreeNode.SetInactSelColor(const AValue: TfpgColor);
begin
  if AValue <> FInactSelColor then
  begin
    FInactSelColor := AValue;
    DoRePaint;
  end;
end;

procedure TfpgTreeNode.SetCollapsed(const AValue: boolean);
begin
  if aValue <> FCollapsed then
  begin
    FCollapsed := AValue;
    DoRePaint;
  end;
end;

procedure TfpgTreeNode.SetInactSelTextColor(const AValue: TfpgColor);
begin
  if AValue <> FInactSelTextColor then
  begin
    FInactSelTextColor := AValue;
    DoRePaint;
  end;
end;

procedure TfpgTreeNode.SetParent(const AValue: TfpgTreeNode);
begin
  if aValue <> FParent then
  begin
    if FParent <> nil then
      FParent.UnRegisterSubNode(self); // unregisteres
    FParent := aValue;
    if FParent <> nil then
    begin
      DoRePaint;
    end;
  end;
end;

procedure TfpgTreeNode.SetSelColor(const AValue: TfpgColor);
begin
  if FSelColor <> aValue then
  begin
    FSelColor := aValue;
    DoRePaint;
  end;
end;

procedure TfpgTreeNode.SetSelTextColor(const AValue: TfpgColor);
begin
  if FTextColor <> aValue then
  begin
    FSelTextColor := aValue;
    DoRePaint;
  end;
end;

procedure TfpgTreeNode.SetText(const AValue: TfpgString);
begin
  if AValue <> FText then
  begin
    FText := aValue;
    DoRePaint;
  end;
end;

procedure TfpgTreeNode.SetTextColor(const AValue: TfpgColor);
begin
  if FTextColor <> aValue then
  begin
    FTextColor := aValue;
    DoRePaint;
  end;
end;

procedure TfpgTreeNode.DoRePaint;
begin
//  FTree.Invalidate;
end;

procedure TfpgTreeNode.SetHasChildren(const AValue: Boolean);
begin
  if FHasChildren <> AValue then
  begin
    FHasChildren := AValue;
    DoRePaint;
  end;
end;

procedure TfpgTreeNode.DoTreeCheck(ANode: TfpgTreeNode);
begin
  if ANode.FTree <> FTree then
    raise Exception.Create('Nodes must be of the same tree');
end;

procedure TfpgTreeNode.SetStateImageIndex(const AValue: integer);
begin
  if FStateImageIndex = AValue then
    exit;
  FStateImageIndex := AValue;
  DoRepaint;
end;

constructor TfpgTreeNode.Create;
begin
  FData           := nil;
  FFirstSubNode   := nil;
  FLastSubNode    := nil;
  FText           := '';
  FImageIndex     := -1;
  FStateImageIndex := -1;
  FCollapsed      := True;
  FHasChildren    := False;

  FParent     := nil;
  FNext       := nil;
  FPrev       := nil;

  FSelColor           := clUnset;
  FSelTextColor       := clUnset;
  FTextColor          := clUnset;
  FInactSelColor      := clUnset;
  FInactSelTextColor  := clUnset;
end;

destructor TfpgTreeNode.Destroy;
begin
  if FParent <> nil then
    FParent.UnregisterSubNode(self);
  Clear;
  FData       := nil;
  FParent     := nil;
  FNext       := nil;
  FPrev       := nil;
  FFirstSubNode   := nil;
  FLastSubNode    := nil;
  inherited Destroy;
end;

procedure TfpgTreeNode.UnregisterSubNode(aNode: TfpgTreeNode);
var
  h: TfpgTreeNode;
begin
  h := FFirstSubNode;
  while h <> nil do
  begin
    if h = aNode then
    begin
      if h = FFirstSubNode then
        FFirstSubNode := FFirstSubNode.Next;
      if h = FLastSubNode then
        FLastSubNode := FLastSubNode.Prev;
      if h.prev <> nil then
        h.prev.next := h.next;
      if h.next <> nil then
        h.next.prev := h.prev;
      exit;
    end;
    h := h.next;
  end;
end;

procedure TfpgTreeNode.Append(var ANode: TfpgTreeNode);
begin
  DoTreeCheck(ANode);
  ANode.Parent := self;
  ANode.Next   := nil;

  if FFirstSubNode = nil then
    FFirstSubNode := ANode;

  ANode.Prev := FLastSubNode;

  if FLastSubNode <> nil then
    FLastSubNode.Next := ANode;

  FLastSubNode := ANode;
  FHasChildren := True;
end;

function TfpgTreeNode.FindSubNode(AText: string; ARecursive: Boolean): TfpgTreeNode;
var
  h: TfpgTreeNode;
begin
  result := nil;
  if ARecursive then
  begin
    h := FirstSubNode;
    while h <> nil do
    begin
      if h.Text = AText then
      begin
        result := h;
        Exit; //==>
      end;
      if h.count > 0 then
      begin
        result := h.FindSubNode(AText, ARecursive);
        if result <> nil then
          Exit; //==>
      end;
      h := h.next;
    end;  { while }
  end
  else
  begin
    h := FirstSubNode;
    while h <> nil do
    begin
      if h.Text = AText then
      begin
        result := h;
        break;
      end;
      h := h.next;
    end;
  end;  { if/else }
end;

function TfpgTreeNode.FindSubNode(ATreeNodeFindMethod: TfpgTreeNodeFindMethod): TfpgTreeNode;
var
  lFound: Boolean;
  h: TfpgTreeNode;
begin
  result := nil;
  lFound := False;
  if not Assigned(ATreeNodeFindMethod) then
    Exit; //==>

  h := FirstSubNode;
  while h <> nil do
  begin
    ATreeNodeFindMethod(h, lFound);
    if lFound then
    begin
      result := h;
      Exit; //==>
    end;
    if h.Count > 0 then
    begin
      result := h.FindSubNode(ATreeNodeFindMethod);
      if result <> nil then
        Exit; //==>
    end;
    h := h.next;
  end;
end;

function TfpgTreeNode.FindSubNode(AData: TObject; ARecursive: Boolean): TfpgTreeNode;
var
  h: TfpgTreeNode;
begin
  result := nil;
  if ARecursive then
  begin
    h := FirstSubNode;
    while h <> nil do
    begin
      if TObject(h.Data) = AData then
      begin
        result := h;
        Exit; //==>
      end;
      if h.count > 0 then
      begin
        result := h.FindSubNode(AData, ARecursive);
        if result <> nil then
          Exit; //==>
      end;
      h := h.next;
    end;  { while }
  end
  else
  begin
    h := FirstSubNode;
    while h <> nil do
    begin
      if TObject(h.Data) = AData then
      begin
        result := h;
        break;
      end;
      h := h.next;
    end;
  end;  { if/else }
end;

function TfpgTreeNode.AppendText(AText: TfpgString): TfpgTreeNode;
var
  h: TfpgTreeNode;
begin
  {$IFDEF DEBUG}
  SendDebug(Classname + '.AppendText');
  {$ENDIF}
  h := TfpgTreeNode.Create;
  h.FTree := FTree;
  h.Text := AText;
  Append(h);
  result := h;
end;

function TfpgTreeNode.GetMaxDepth: integer;
var
  h: TfpgTreeNode;
  a: integer;
  t: integer;
begin
  {$IFDEF DEBUG}
  SendDebug(Classname + '.GetMaxDepth');
  {$ENDIF}
  h := FirstSubNode;
  result := 1;
  a := 0;
  while h <> nil do
  begin
    t := h.GetMaxDepth;
    if t > a then
      a := t;
    h := h.next;
  end;
  result := result + a;
end;

function TfpgTreeNode.GetMaxVisibleDepth: integer;
var
  h: TfpgTreeNode;
  a: integer;
  t: integer;
begin
  {$IFDEF DEBUG}
  SendDebug(Classname + '.GetMaxVisibleDepth');
  {$ENDIF}
  result := 1;
  h := FirstSubNode;
  if h.Collapsed then
    exit;
  a := 0;
  while h <> nil do
  begin
    t := h.GetMaxDepth;
    if t > a then
      a := t;
    h := h.next;
  end;
  result := result + a;
end;

procedure TfpgTreeNode.Collapse;
begin
  Collapsed := True;
end;

procedure TfpgTreeNode.Expand;
begin
  Collapsed := False;
end;

function TfpgTreeNode.Count: integer;
var
  h: TfpgTreeNode;
  i: integer;
begin
  h := FirstSubNode;
  i := 0;
  while h <> nil do
  begin
    inc(i);
    h := h.next;
  end;
  result := i;
end;

function TfpgTreeNode.CountRecursive: integer;
var
  h: TfpgTreeNode;
  i: integer;
begin
  h := FFirstSubNode;
  i := 0;
  while h <> nil do
  begin
    inc(i); // current node
    i := i + h.CountRecursive; // increases i by the count of the subnodes of the subnode
    h := h.next;
  end;
  result := i;
end;

procedure TfpgTreeNode.Remove(var aNode: TfpgTreeNode);
begin
  if FirstSubNode = aNode then
  begin
    FFirstSubNode := aNode.next;
    if FFirstSubNode <> nil then
      FFirstSubNode.Prev := nil;
  end
  else
  begin
    if aNode.prev <> nil then
      aNode.Prev.next := aNode.next;
  end;

  if LastSubNode = aNode then
  begin
    FLastSubNode := aNode.prev;
    if FLastSubNode <> nil then
      FLastSubNode.next := nil;
  end
  else
  begin
    if aNode.next <> nil then
      aNode.next.prev := aNode.prev;
  end;

  aNode.prev := nil;
  aNode.next := nil;
  aNode.parent := nil;
end;

procedure TfpgTreeNode.MoveTo(Destination: TfpgTreeNode; Mode: TfpgNodeAttachMode);
begin
  if Destination = nil then
    Exit;
  DoTreeCheck(Destination);

  Parent.Remove(self);
  case Mode of
    naAdd:
        begin
          Destination.Parent.Append(self);
        end;
    naAddFirst:
        begin
          Next := Destination.Parent.FirstSubNode;
          Next.Prev := self;
          Destination.Parent.FFirstSubNode := self;
          Parent := Destination.Parent;
        end;
    naAddChild:
        begin
          Destination.Append(self);
        end;
    naAddChildFirst:
        begin
          Next := Destination.FirstSubNode;
          if Assigned(Destination.FirstSubNode) then
            Destination.FirstSubNode.Prev := self;
          Destination.FFirstSubNode := self;
          Parent := Destination;
          if Destination.LastSubNode = nil then
            Destination.FLastSubNode := self;
        end;
    naInsert:
        begin
          Prev := Destination.Prev;
          Next := Destination;
          Parent := Destination.Parent;
          Destination.Prev := self;
          if Prev = nil then
            Parent.FFirstSubNode := self
          else
            Prev.Next := self;
        end;
  end;  { case }
end;

procedure TfpgTreeNode.Clear;
var
  n: TfpgTreeNode;
  tn: TfpgTreeNode;
begin
  n := LastSubNode;
  while n <> nil do
  begin
    tn := n;
    n := n.prev;
    Remove(tn);
    tn.Free;
  end;
  FHasChildren := False;
end;

function TfpgTreeNode.ParentTextColor: TfpgColor;
begin
  if TextColor <> clUnset then
    result := TextColor
  else
  begin
    if parent <> nil then
      result := parent.ParentTextColor
    else
      result := clText1;
  end;
end;

function TfpgTreeNode.ParentSelTextColor: TfpgColor;
begin
  if SelTextColor <> clUnset then
    result := SelTextColor
  else
  begin
    if parent <> nil then
      result := parent.ParentSelTextColor
    else
      result := clSelectionText;
  end;
end;

function TfpgTreeNode.ParentSelColor: TfpgColor;
begin
  if SelColor <> clUnset then
    result := SelColor
  else
  begin
    if parent <> nil then
      result := parent.ParentSelColor
    else
      result := clSelection;
  end;
end;

function TfpgTreeNode.ParentInactSelTextColor: TfpgColor;
begin
  if InactSelTextColor <> clUnset then
    result := InactSelTextColor
  else
  begin
    if Parent <> nil then
      Result := Parent.ParentInactSelTextColor
    else
      Result := clInactiveSelText;
  end;
end;

function TfpgTreeNode.ParentInactSelColor: TfpgColor;
begin
  if InactSelColor <> clUnset then
    result := InactSelColor
  else
  begin
    if Parent <> nil then
      result := parent.ParentInactSelColor
    else
      result := clInactiveSel;
  end;
end;

{ TfpgTreeview }

procedure TfpgTreeview.VScrollbarScroll(Sender: TObject; position: integer);
begin
  {$IFDEF DEBUG}
  SendDebug(Classname + '.VScrollbarMove');
  {$ENDIF}
  FYOffset := Position;
  RePaint;
end;

function TfpgTreeview.GetFontDesc: string;
begin
  Result := FFont.FontDesc;
end;

function TfpgTreeview.GetRootNode: TfpgTreeNode;
begin
  if FRootNode = nil then
  begin
    FRootNode := TfpgTreeNode.Create;
    FRootNode.FTree := self;
  end;
  FRootNode.TextColor     := clText1;
  FRootnode.SelTextColor  := clSelectionText;
  FRootnode.SelColor      := clSelection;
  Result := FRootNode;
end;

procedure TfpgTreeview.SetDefaultColumnWidth(const AValue: word);
begin
  if (aValue <> FDefaultColumnWidth) and (aValue > 3) then
  begin
    FDefaultColumnWidth := AValue;
    RePaint;
  end;
end;

procedure TfpgTreeview.SetFontDesc(const AValue: string);
begin
  FFont.Free;
  FFont := fpgGetFont(AValue);
  RePaint;
end;

procedure TfpgTreeview.SetSelection(const AValue: TfpgTreeNode);
var
  n: TfpgTreeNode;
  dy: integer;    // y delta - absolute top node
  nh: integer;    // node height
  vh: integer;    // visible height
begin
  if AValue <> FSelection then
  begin
    FSelection := AValue;
    if AValue <> nil then
    begin
      n := AValue.Parent;
      while n <> nil do
      begin
        if n.Collapsed then
        begin
          n.Expand;
          DoExpand(n);
        end;
        n := n.parent;
      end;
      UpdateScrollbars;
    end;

    dy := GetAbsoluteNodeTop(FSelection);
    nh := GetNodeHeight;
    vh := VisibleHeight;
    if dy + nh - FVScrollbar.Position > vh then
    begin
      if FVScrollBar.Max = 0 then    // the first time and no expansion happened before.
        FVScrollBar.Max := dy + Height;
      FVScrollbar.Position := dy + nh - (vh div 2);
      FYOffset := FVScrollbar.Position;
      UpdateScrollBars;
      if FHScrollbar.Visible then    // HScrollbar appeared so we need to adjust position again
      begin
        FVScrollbar.Position := FVScrollbar.Position + FHScrollbar.Height;
        FYOffset := FVScrollbar.Position;
        UpdateScrollBars;
      end;
    end;
    
    if dy - FVScrollbar.Position < 0 then
    begin
      FVScrollbar.Position := dy;
      FYOffset := FVScrollbar.Position;
      UpdateScrollbars;
    end;
  end;
end;

procedure TfpgTreeview.SetShowColumns(const AValue: boolean);
begin
  if FShowColumns <> aValue then
  begin
    FShowColumns := aValue;
    RePaint;
  end;
end;

procedure TfpgTreeview.SetShowImages(const AValue: boolean);
begin
  if AValue <> FShowImages then
  begin
    FShowImages := AValue;
    UpdateScrollbars;
    RePaint;
  end;
end;

procedure TfpgTreeview.SetTreeLineColor(const AValue: TfpgColor);
begin
  if FTreeLineColor = AValue then
    Exit; //==>
  FTreeLineColor := AValue;
  RePaint;
end;

procedure TfpgTreeview.SetTreeLineStyle(const AValue: TfpgLineStyle);
begin
  if FTreeLineStyle = AValue then
    Exit; //==>
  FTreeLineStyle := AValue;
  RePaint;
end;

procedure TfpgTreeView.SetIndentNodeWithNoImage(const AValue: boolean);
begin
  if AValue <> FIndentNodeWithNoImage then
  begin
    FIndentNodeWithNoImage := AValue;
    UpdateScrollbars;
    RePaint;
  end;
end;

function TfpgTreeview.VisibleWidth: integer;
begin
  Result := Width - 2; // border width = 2 pixels
  if FVScrollbar.Visible then
     dec(Result, FVScrollbar.Width);
end;

function TfpgTreeview.VisibleHeight: integer;
begin
  Result := Height - 2; // border width = 2 pixels
  if FShowColumns then
    dec(Result, FColumnHeight);
  if FHScrollbar.Visible then
    dec(Result, FHScrollbar.Height);
end;

function TfpgTreeview.GetNodeHeightSum: integer;
var
  h: TfpgTreeNode;
  i: integer;
begin
  h := RootNode;
  i := -1;
  while h <> nil do
  begin
    inc(i);
    if (not h.Collapsed) and (h.Count > 0) then
    begin
      h := h.FirstSubNode;
    end
    else
    begin
      if h.next <> nil then
        h := h.next
      else
      begin
        while h.next = nil do
        begin
          h := h.parent;
          if h = nil then
          begin
            result := i;
            exit;
          end;
        end;
        h := h.next;
      end;
    end;
  end;
  result := i;
end;

function TfpgTreeview.MaxNodeWidth: integer;
var
  h: TfpgTreeNode;
  w: integer;
  r: integer;
begin
  {$IFDEF DEBUG}
  SendDebug(Classname + '.MaxNodeWidth');
  {$ENDIF}
  result := 0;
  h := RootNode.FirstSubNode;
  r := 0;
  while h <> nil do
  begin
    w := GetColumnLeft(StepToRoot(h));
    if r < w + GetNodeWidth(h) then
      r := w + GetNodeWidth(h);
    if (not h.collapsed) and (h.count > 0) then
      h := h.FirstSubNode
    else
    begin
      if h.next <> nil then
        h := h.next
      else
      begin
        while h.next = nil do
        begin
          h := h.parent;
          if h = nil then
          begin
            result := r + 4;
            exit;
          end;
        end;  { while }
        h := h.next;
      end;
    end;  { if/else }
  end;  { while }
end;

function TfpgTreeview.GetNodeHeight: integer;
begin
  Result := FFont.Height + 2;
end;

function TfpgTreeview.GetNodeWidth(ANode: TfpgTreeNode): integer;
var
  lImageItem: TfpgImageItem;
begin
  {$IFDEF DEBUG}
  SendDebug(Classname + '.GetNodeWidth');
  {$ENDIF}
  if ANode = nil then
    Result := 0
  else
  begin
    Result := FFont.TextWidth(ANode.Text) + 4;
    if ShowImages and ((ImageList <> nil) or (StateImageList <> nil)) then
    begin
      if ImageList <> nil then
      begin
        if ANode.ImageIndex > -1 then
        begin
          lImageItem := ImageList.Items[ANode.ImageIndex];
          if lImageItem <> nil then
            result += lImageItem.Image.Width + 2;
        end
        else if IndentNodeWithNoImage then
          result += NoImageIndent + 2;
      end
      else if IndentNodeWithNoImage then
        result += NoImageIndent + 2;

      if StateImageList <> nil then
      begin
        if ANode.StateImageIndex > -1 then
        begin
          lImageItem := StateImageList.Items[ANode.StateImageIndex];
          if lImageItem <> nil then
            result += lImageItem.Image.Width + 2;
        end
        else if IndentNodeWithNoImage then
          result += NoImageIndent + 2;
      end;
    end;
  end;  { if/else }
end;

function TfpgTreeview.NodeIsVisible(ANode: TfpgTreeNode): boolean;
begin
  Result := True;
  if ANode = nil then
  begin
    Result := False;
    exit;
  end;
  ANode := ANode.Parent;
  while ANode <> nil do
  begin
    if ANode.Collapsed and (ANode.Parent <> nil) then
      Result := False;
    ANode := ANode.Parent;
  end;
end;

function TfpgTreeview.GetAbsoluteNodeTop(ANode: TfpgTreeNode): integer;
var
  i: integer;
begin
  i := 0;
  while (ANode <> nil) and (ANode <> RootNode) do
  begin
    ANode := PrevVisualNode(ANode);
    inc(i);
  end;
  result := (i - 1) * GetNodeHeight;
end;

function TfpgTreeview.GetColumnLeft(AIndex: integer): integer;
begin
  if FColumnLeft = nil then
    PreCalcColumnLeft;

  if AIndex < 0 then
    Result := 0
  else
  begin
    if AIndex > FColumnLeft.Count - 1 then
      result := PColumnLeft(FColumnLeft[FColumnLeft.Count - 1])^
    else
      result := PColumnLeft(FColumnLeft[AIndex])^;
  end;
end;

function TfpgTreeview.GetColumnWidth(AIndex: word): word;
var
  h: PfpgTreeColumnWidth;
  i: integer;
begin
{$IFDEF DEBUG}
  SendDebug(Classname + '.GetColumnWidth');
{$ENDIF}
  h := FFirstColumn;
  i := 0;
  if h = nil then // not found
  begin
    result := DefaultColumnWidth;
    exit;
  end;
  while i < aIndex do
  begin
    if h = nil then // not found - returns the default
    begin
      result := DefaultColumnWidth;
      exit;
    end;
    h := h^.next;
    inc(i);
  end;
  if h <> nil then
    result := h^.width
  else // not found -> returns the default
    result := DefaultColumnWidth;
end;

function TfpgTreeView.GetNodeAt(const X, Y: integer): TfpgTreeNode;
var
  col: integer;
  lTop: integer;
  lLeft: integer;
  i, i1: integer;
  cancel: boolean;
  last, node: TfpgTreeNode;
  w: integer;
  lNodeXOffset: integer;
begin
  if ShowColumns then
    col := FColumnHeight
  else
    col := 0;

  Result := nil;
  i := 0;
  lTop := y - col - 1 + FYOffset;
  lLeft := x + FXOffset;
  cancel := False;
  last := RootNode;

  while not ((((i - 1) * GetNodeHeight) <= lTop) and ((i * GetNodeHeight) >= lTop)) do
  begin
    node := NextVisualNode(last);
    if node = nil then
      exit; //==>
    if node = last then
    begin
      cancel := True;
      break;  //==>
    end;
    inc(i);
    last := node;
  end;
  
  if (not cancel) or (node <> nil) then
  begin
    // +/- or node-selection?
    i1  := StepToRoot(node);
    w   := GetColumnLeft(i1);
    lNodeXOffset := w - GetColumnWidth(i1) div 2 + 6;
    if lLeft > lNodeXOffset then  { we are in the actual treenode area }
    begin
      Result := node;
    end;
  end;
end;

procedure TfpgTreeView.GotoNextNodeUp;
begin
  if Selection = RootNode.FirstSubNode then
    Exit;
  Selection := PrevNode(Selection);
end;

procedure TfpgTreeView.GotoNextNodeDown;
var
  lNode: TfpgTreeNode;
begin
  if (Selection = RootNode.LastSubNode) and (RootNode.LastSubNode.CountRecursive = 0) then
    Exit;

  lNode := NextNode(Selection);
  if lNode <> nil then
    Selection := lNode;
end;

procedure TfpgTreeView.FullCollapse;
var
  n: TfpgTreeNode;
{'fraction_non_alphanumeric': 0.08340491871082689, 'fraction_numerical': 0.0020998377398110148, 'mean_word_length': 2.9145027710318203, 'pattern_counts': {'":': 0, '<': 147, '<?xml version=': 0, '>': 186, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1417828', 'n_tokens_mistral': 21054, 'n_tokens_neox': 20417, 'n_words': 5730}