unit frxComCtrls;
{$I frx.inc}
interface

uses
  {$IFNDEF NONWINFPC}Windows, CommCtrl,{$ENDIF}
  {$IFDEF FPC}LCLType, LMessages, LCLIntf, LazHelper, LazarusPackageIntf,{$ENDIF}
  Messages, SysUtils, Variants, Classes, Graphics,
  Controls, ComCtrls, frxDPIAwareBaseControls, frxUtils, frxCtrls, ImgList, frxDPIAwareInt;

type
  TfrxFilterAlign = (fraLeft, fraRight, fraWidth);
  TfrxToolAlign = (ftaTop, ftaBottom);

  TfrxDataNode = class(TObject)
  private
    FParent: TfrxDataNode;
    FFirstChild: TfrxDataNode;
    FRSibling: TfrxDataNode;
    FLSibling: TfrxDataNode;
    FData: TObject;
    FImageIndex: Integer;
    FSelectedIndex: Integer;
    FOriginalNode: TTreeNode;
    FText: String;
  public
    destructor Destroy; override;
    procedure Clear;
  end;

  TfrxTreeNodeClass = class of TfrxTreeNode;

  TfrxTreeNode = class(TTreeNode)
  private
    FDataNode: TfrxDataNode;
    FNeedFixUp: Boolean;
  public
    constructor CreateWithData(AOwner: TTreeNodes; aDataNode: TfrxDataNode); overload;
    destructor Destroy; override;
    procedure MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode); override;
  end;

  TfrxTreeNodes = class(TTreeNodes)
  protected
     procedure DefineProperties(Filer: TFiler); override;
  public
     procedure Assign(Source: TPersistent); override;
  end;

  TfrxTVFilterCompareEvent = function(Sender: TObject; Node: TTreeNode; const aFilter: string): Boolean of object;

  TfrxTreeView = class(TTreeView)
  private
    FIsUpdating: Boolean;
    FOnEditedNew: TTVEditedEvent;
    FRootNode: TfrxDataNode;
    FLastFilter: String;
    FOnFilterCompare: TfrxTVFilterCompareEvent;
    FOnExpandButtonClick: TNotifyEvent;
    FExpandLevel: Integer;
    FDrawExpandButton: Boolean;
    FExpandButtonState: Boolean;
    FExpandButtonActive: Boolean;
    FExpandButtonWidth: Integer;
    FExpandButtonAlign: TfrxToolAlign;
    FExpandButtonRect: TRect;
    FCurrentPPI: Integer;
    procedure SetDrawExpandButton(const Value: Boolean);
    procedure SetExpandButtonState(const Value: Boolean);
    procedure InvalidateExpandButton(HideButton: Boolean = False);
    procedure WMHScroll(var Message: TWMHScroll); message WM_HSCROLL;
    procedure WMVScroll(var Message: TWMVScroll); message WM_VSCROLL;
{$IFDEF FPC}
    procedure WMMouseWheel(var Message: TLMMouseEvent); message LM_MOUSEWHEEL;
{$ELSE}
    procedure WMMouseWheel(var Message: TWMMouseWheel); message WM_MOUSEWHEEL;
{$ENDIF}
    procedure WMDpiChanged(var Message: TMessage); message FRX_WM_DPICHANGED_AFTERPARENT;
    procedure SetExpandButtonAlign(const Value: TfrxToolAlign);
    procedure UpdateExpandButton;
    procedure DrawArrow;
  protected
    function CreateNode: TTreeNode; override;
    function CreateNodes: TTreeNodes; override;
    function CanChange(Node: TTreeNode): Boolean; override;
    function CanCollapse(Node: TTreeNode): Boolean; override;
    procedure Change(Node: TTreeNode); override;
    procedure Delete(Node: TTreeNode); override;
    procedure Added(Node: TTreeNode); override;
    procedure DoEdit(Sender: TObject; Node: TTreeNode; var S: string);
    procedure DoPPIChanged(aNewPPI: Integer); virtual;
    procedure DestroyWnd; override;
    function IsCustomDrawn(Target: TCustomDrawTarget; Stage: TCustomDrawStage): Boolean; override;
    function CustomDraw(const ARect: TRect; Stage: TCustomDrawStage): Boolean; override;
    function CustomDrawItem(Node: TTreeNode; State: TCustomDrawState;
      Stage: TCustomDrawStage; var PaintImages: Boolean): Boolean; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ResetFilter;
    procedure Filter(const aFilter: string);
    procedure UpdateFilter;
    property ExpandLevel: Integer read FExpandLevel write FExpandLevel;
    property DrawExpandButton: Boolean read FDrawExpandButton write SetDrawExpandButton;
    property ExpandButtonState: Boolean read FExpandButtonState write SetExpandButtonState;
    property ExpandButtonAlign: TfrxToolAlign read FExpandButtonAlign write SetExpandButtonAlign;
  published
    property OnEdited: TTVEditedEvent read FOnEditedNew write FOnEditedNew;
    property OnFilterCompare: TfrxTVFilterCompareEvent read FOnFilterCompare write FOnFilterCompare;
    property OnExpandButtonClick: TNotifyEvent read FOnExpandButtonClick write FOnExpandButtonClick;
  end;

  TfrxToolPanel = class;

  TfrxToolButttonStyle = (fbsButton, fbsCheckButton, fbsRadioButton, fbsDropDownButton);
  TfrxToolButttonKind = (fbkButton, fbkSeparator);

  TfrxToolPanelCustomButton = class(TGraphicControl)
  public
    constructor Create(AOwner: TComponent); override;
  end;

  TfrxToolPanelSeparator = class(TfrxToolPanelCustomButton)
  protected
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

  { TfrxToolPanelButton }

  TfrxToolPanelButton = class(TfrxToolPanelCustomButton)
  private
    FIsActive: Boolean;
    FIsDown: Boolean;
    FImageIndex: Integer;
    FButtonStyle: TfrxToolButttonStyle;
    FGroup: Integer;
    function GetParentPanel: TfrxToolPanel;
    procedure SetButtonStyle(const Value: TfrxToolButttonStyle);
    procedure SetIsDown(const Value: Boolean);
  protected
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
  protected
    procedure Paint; override;
    function GetArrowWidth: Integer;
  public
    constructor Create(AOwner: TComponent); override;
    //function IsDown: Boolean;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
{$IFDEF FPC}
    procedure ChangeBounds(ALeft, ATop, AWidth, AHeight: integer; KeepBase: boolean); override;
{$ENDIF}
    property ButtonStyle: TfrxToolButttonStyle read FButtonStyle write SetButtonStyle;
    property ImageIndex: Integer read FImageIndex write FImageIndex;
    property IsDown: Boolean read FIsDown write SetIsDown;
  end;

  TfrxToolPanel = class(TfrxDPIAwarePanel)
  private
    FButtons: TList;
    FImageList: TCustomImageList;
    FOnBtnClick: TNotifyEvent;
    procedure SetImageList(const Value: TCustomImageList);
    procedure ResetRadioGroup(GroupIndex: Integer);
  protected
    function CalcButtonsWidth: Integer;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function AddButton(ImageIndex: Integer; HintText: String = ''; Tag: NativeInt = -1; ButtonStyle: TfrxToolButttonStyle = fbsButton; Group: Integer = -1): TfrxToolPanelButton;
    function AddCustomButton(aKind: TfrxToolButttonKind): TfrxToolPanelCustomButton;
    procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
{$IFDEF FPC}
    procedure ChangeBounds(ALeft, ATop, AWidth, AHeight: integer; KeepBase: boolean); override;
{$ENDIF}
    function GetArrowWidth: Integer;
    procedure Paint; override;
    procedure RealignButtons;
    property ImageList: TCustomImageList read FImageList write SetImageList;
    property OnBtnClick: TNotifyEvent read FOnBtnClick write FOnBtnClick;
  end;

  { TfrxTreePanel }

  TfrxTreePanel = class(TfrxDPIAwarePanel)
  private
    FToolPanel: TfrxToolPanel;
    FPanel: TfrxDPIAwarePanel;
    FTreeView: TfrxTreeView;
    FFilter: TfrxFilterEdit;
    FFileterMinWidth: Integer;
    FFileterMaxWidth: Integer;
    FFilterActiveImageIndex: Integer;
    FFilterUnactiveImageIndex: Integer;
    FFilterAlign: TfrxFilterAlign;
    FToolPanelAlign: TfrxToolAlign;
    procedure SetFilterVisible(const Value: Boolean);
    function GetFilterVisible: Boolean;
    function GetToolVisible: Boolean;
    procedure SetToolVisible(const Value: Boolean);
    function GetImageList: TCustomImageList;
    procedure SetImageList(const Value: TCustomImageList);
    procedure SetFilterActiveImageIndex(const Value: Integer);
    procedure SetFilterUnactiveImageIndex(const Value: Integer);
    procedure SetFileterMaxWidth(const Value: Integer);
    procedure SetFileterMinWidth(const Value: Integer);
    procedure ExpandButtonClick(Sender: TObject);
    procedure SetFilterAlign(const Value: TfrxFilterAlign);
    procedure SetToolPanelAlign(const Value: TfrxToolAlign);
    procedure SetFilterColor(const Value: TColor);
    function GetFilterColor: TColor;
  protected
    procedure UpdateSize;
    function CalcButtonsWidth: Integer;
    procedure Resize; override;
{$IFDEF FPC}
    procedure DoOnResize; override;
{$ENDIF}
    procedure SetParent(AParent: TWinControl); override;
    procedure EditChange(Sender: TObject);
    procedure DoPPIChanged(aNewPPI: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property FilterColor: TColor read GetFilterColor write SetFilterColor;
    property FilterEdit: TfrxFilterEdit read FFilter;
    property FilterVisible: Boolean read GetFilterVisible write SetFilterVisible;
    property FilterActiveImageIndex: Integer read FFilterActiveImageIndex write SetFilterActiveImageIndex;
    property FilterUnactiveImageIndex: Integer read FFilterUnactiveImageIndex write SetFilterUnactiveImageIndex;
    property FileterMinWidth: Integer read FFileterMinWidth write SetFileterMinWidth;
    property FileterMaxWidth: Integer read FFileterMaxWidth write SetFileterMaxWidth;
    property FilterAlign: TfrxFilterAlign read FFilterAlign write SetFilterAlign;
    property ToolPanel: TfrxToolPanel read FToolPanel;
    property ToolVisible: Boolean read GetToolVisible write SetToolVisible;
    property ToolImageList: TCustomImageList read GetImageList write SetImageList;
    property ToolPanelAlign: TfrxToolAlign read FToolPanelAlign write SetToolPanelAlign;
    property TreeView: TfrxTreeView read FTreeView;
  end;


implementation
uses Forms;
{ TfrxTreeNode }

constructor TfrxTreeNode.CreateWithData(AOwner: TTreeNodes; aDataNode: TfrxDataNode);
begin
  inherited Create(AOwner);
  FDataNode := aDataNode;
end;

destructor TfrxTreeNode.Destroy;
begin
  if assigned(FDataNode) then
    FDataNode.FOriginalNode := nil;
  if Assigned(Owner.Owner) and not TfrxTreeView(Owner.Owner).FIsUpdating then
    FDataNode.Free;
  inherited;
end;

procedure TfrxTreeNode.MoveTo(Destination: TTreeNode; Mode: TNodeAttachMode);
var
  dNode: TfrxDataNode;
begin
  if Assigned(FDataNode) then
  begin
    if Assigned(FDataNode.FLSibling) then
      FDataNode.FLSibling.FRSibling := FDataNode.FRSibling;
    if Assigned(FDataNode.FRSibling) then
      FDataNode.FRSibling.FLSibling := FDataNode.FLSibling;
    if Assigned(FDataNode.FParent) and (FDataNode.FParent.FFirstChild = FDataNode) then
      FDataNode.FParent.FFirstChild := FDataNode.FRSibling;
  end;
  inherited;
  if Assigned(FDataNode) and (Destination is TfrxTreeNode) and Assigned(TfrxTreeNode(Destination).FDataNode) then
  begin
    dNode := TfrxTreeNode(Destination).FDataNode;
    if (Destination <> nil) and not (Mode in [naAddChild, naAddChildFirst]) then
      dNode := dNode.FParent;
    if Mode = naInsert then
    begin
      Destination := Destination.GetPrevSibling;
      if Destination = nil then
        Mode := naAddFirst
      else
        dNode := TfrxTreeNode(Destination).FDataNode;
    end;

    if Mode in [naAddFirst, naAddChildFirst] then
    begin
      while (dNode.FLSibling <> nil) do
        dNode := dNode.FLSibling;
      dNode.FLSibling := FDataNode;
      FDataNode.FRSibling := dNode;
      FDataNode.FParent := dNode.FParent;
      If Assigned(dNode.FParent) then
        dNode.FParent.FFirstChild := FDataNode;
    end
    else if Mode in [naAdd, naAddChild, naInsert] then
    begin
      if Mode = naInsert then
        FDataNode.FRSibling := dNode.FRSibling
      else
      begin
        while (dNode.FRSibling <> nil) do
          dNode := dNode.FRSibling;
        FDataNode.FRSibling := nil;
      end;
      dNode.FRSibling := FDataNode;
      FDataNode.FLSibling := dNode;
      FDataNode.FParent := dNode.FParent;
    end;
  end;
end;

{ TfrxTreeView }

procedure TfrxTreeView.Added(Node: TTreeNode);
var
  dNode, dNodeSibl, ParentNode: TfrxDataNode;
  lNode: TTreeNode;
begin
  inherited;
  if not FIsUpdating and (Node is TfrxTreeNode) and (TfrxTreeNode(Node).FDataNode = nil) then
  begin
    TfrxTreeNode(Node).FDataNode := TfrxDataNode.Create;

    dNode := TfrxTreeNode(Node).FDataNode;
    dNode.FOriginalNode := Node;
    if Assigned(Node.Parent)then
      ParentNode := TfrxTreeNode(Node.Parent).FDataNode
    else
      ParentNode := FRootNode;

    dNode.FParent := ParentNode;
    dNode.FText := Node.Text;
    dNode.FData := Node.Data;
    { fixup after restoring from stream }
    if TfrxTreeNode(Node).FNeedFixUp then
    begin
      TfrxTreeNode(Node).FNeedFixUp := False;
      lNode := TfrxTreeNode(Node.getFirstChild);
      if Assigned(lNode) and Assigned(TfrxTreeNode(lNode).FDataNode) then
      begin
        dNode.FFirstChild := TfrxTreeNode(lNode).FDataNode;
        TfrxTreeNode(lNode).FDataNode.FParent := dNode;
      end;
    end;

    lNode := TfrxTreeNode(Node.getPrevSibling);
    if lNode = nil then
    begin
      dNode.FLSibling := nil;
      if Assigned(ParentNode) then
        ParentNode.FFirstChild := dNode
      else if Assigned(Node.Parent) then
        TfrxTreeNode(Node.Parent).FNeedFixUp := True;
    end
    else
    begin
      dNodeSibl := TfrxTreeNode(lNode).FDataNode;
      dNode.FLSibling := dNodeSibl;
      dNodeSibl.FRSibling := dNode;
    end;
    Node :=  Node.getNextSibling;
    if Assigned(Node) then
    begin
      dNodeSibl := TfrxTreeNode(Node).FDataNode;
      dNodeSibl.FLSibling := dNode;
      dNode.FRSibling := dNodeSibl;
    end;
  end;
end;

function TfrxTreeView.CanChange(Node: TTreeNode): Boolean;
begin
  if FIsUpdating then
    Result := True
  else
    Result := inherited CanChange(Node);
end;

function TfrxTreeView.CanCollapse(Node: TTreeNode): Boolean;
begin
  Result := inherited CanCollapse(Node);
  if Result then
    InvalidateExpandButton(True);
end;

procedure TfrxTreeView.Change(Node: TTreeNode);
begin
  if FIsUpdating then
    Select(Selected, KeyDataToShiftState(0) + [ssLeft])
  else
    inherited;
end;

constructor TfrxTreeView.Create(AOwner: TComponent);
begin
  inherited;
  FRootNode := TfrxDataNode.Create;
  FExpandLevel := -1;
  FCurrentPPI := Screen.PixelsPerInch;
  FExpandButtonWidth := MulDiv(16, FCurrentPPI, 96);
end;

function TfrxTreeView.CreateNode: TTreeNode;
var
  LClass: TTreeNodeClass;
begin
  LClass := TfrxTreeNode;
  if Assigned(OnCreateNodeClass) then
    OnCreateNodeClass(Self, LClass);
  Result := LClass.Create(Items);
end;

function TfrxTreeView.CreateNodes: TTreeNodes;
begin
  Result := TfrxTreeNodes.Create(Self);
end;

function TfrxTreeView.CustomDraw(const ARect: TRect;
  Stage: TCustomDrawStage): Boolean;
begin
  Result := inherited CustomDraw(ARect, Stage);
  if (Stage = cdPostPaint) and FDrawExpandButton then
    DrawArrow;
end;

function TfrxTreeView.CustomDrawItem(Node: TTreeNode; State: TCustomDrawState;
  Stage: TCustomDrawStage; var PaintImages: Boolean): Boolean;
begin
  Result := inherited CustomDrawItem(Node, State, Stage, PaintImages);
  if (Stage = cdPostPaint) and FDrawExpandButton then
    DrawArrow;
end;

procedure TfrxTreeView.Delete(Node: TTreeNode);
begin
//  if not FIsUpdating and (Node is TfrxTreeNode) and Assigned(TfrxTreeNode(Node).FDataNode) then
//    FreeAndNil(TfrxTreeNode(Node).FDataNode);
  inherited;
end;

destructor TfrxTreeView.Destroy;
begin
  FIsUpdating := True;
  FRootNode.Clear;
  FreeAndNil(FRootNode);
  inherited;
end;

procedure TfrxTreeView.DestroyWnd;
begin
  if Owner is TfrxTreeView then
    TfrxTreeView(Owner).ResetFilter;
  inherited;
  FRootNode.Clear;
end;

procedure TfrxTreeView.DoEdit(Sender: TObject; Node: TTreeNode; var S: string);
begin
  if (Node is TfrxTreeNode) then
    TfrxTreeNode(Node).FDataNode.FText := Node.Text;
  if Assigned(FOnEditedNew) then
    FOnEditedNew(Self, Node, S);
end;

procedure TfrxTreeView.DoPPIChanged(aNewPPI: Integer);
begin
  FExpandButtonWidth := MulDiv(16, aNewPPI, 96);
  UpdateExpandButton;
end;

procedure TfrxTreeView.DrawArrow;
var
  BtnCl: TColor;
begin
  Canvas.Brush.Color := clWindow;
  Canvas.Pen.Width := 1;
  if FExpandButtonActive then
    BtnCl := clWindowText
  else
    BtnCl := clActiveBorder;
  frxDrawArrows(Canvas, FExpandButtonRect, BtnCl, FExpandButtonState, FExpandButtonState and (FExpandButtonAlign = ftaTop));
end;

procedure TfrxTreeView.Filter(const aFilter: string);
var
  lFilter: String;
  Method: TNodeAttachMode;
  aList: TList;
  { TODO : Expand up to Lvl }
  { not implimented yet }
  procedure ExpandUpTo(Lvl: Integer);
  var
    aItem: TTreeNode;
  begin
    aItem := Items.GetFirstNode;
    if Assigned(aItem) then
      aItem.Expanded := True;
  end;

  function RestoreParentNode(lnode: TfrxDataNode): TfrxTreeNode;
  begin
    Result := TfrxTreeNode(lnode.FOriginalNode);
    if Assigned(lnode.FOriginalNode) then Exit;
    if (lnode.FParent <> nil) and (lnode.FParent <> FRootNode)  then
      Result := RestoreParentNode(lnode.FParent);
    if (Result = nil) and (lnode.FParent = FRootNode) then
       Method := naAdd
    else
      Method := naAddChild;
    Result := TfrxTreeNode(Items.AddNode(TfrxTreeNode.CreateWithData(Items, lnode), Result, lnode.FText, nil, Method));
    Result.FDataNode := lnode;
    Result.Data := lnode.FData;
    Result.ImageIndex := lnode.FImageIndex;
    Result.SelectedIndex := lnode.FSelectedIndex;
    Result.FDataNode.FOriginalNode := Result;
  end;

  procedure DoCheckNodes(aRootNode: TfrxDataNode);
  var
    nNext: TfrxDataNode;
    lNode: TTreeNode;
    bFound: Boolean;
  begin
    nNext := aRootNode.FFirstChild;
    while Assigned(nNext) do
    begin
      DoCheckNodes(nNext);
      bFound := False;
      if Assigned(FOnFilterCompare) then
        bFound := FOnFilterCompare(Self, nNext.FOriginalNode, aFilter);
      if not bFound then
        bFound := (Pos(lFilter, UpperCase(nNext.FText)) > 0);
      if bFound or (lFilter = '') then
      begin
        if nNext.FOriginalNode = nil then
          RestoreParentNode(nNext);
      end
      else
      begin
        if (nNext.FOriginalNode <> nil) and not(nNext.FOriginalNode.HasChildren) then
        begin
          lNode := nNext.FOriginalNode;
          TfrxTreeNode(nNext.FOriginalNode).FDataNode := nil;
          nNext.FText := nNext.FOriginalNode.Text;
          nNext.FData := nNext.FOriginalNode.Data;
          nNext.FImageIndex := nNext.FOriginalNode.ImageIndex;
          nNext.FSelectedIndex := nNext.FOriginalNode.SelectedIndex;
          nNext.FOriginalNode := nil;
          Items.Delete(lNode);
        end;
      end;
      nNext := nNext.FRSibling;
    end;
  end;
{$IFDEF FPC}
  procedure GetSelections(aList: TList);
  var
    I: Integer;
  begin
    aList.Clear;
    for I := 0 to Self.SelectionCount - 1 do
      aList.Add(Self.Selections[I]);
  end;
{$ENDIF}
begin
  if FIsUpdating then Exit;
  lFilter := UpperCase(aFilter);
  Items.BeginUpdate;
  FIsUpdating := True;
  aList := TList.Create;
  try
    DoCheckNodes(FRootNode);
    GetSelections(aList);
  finally
    Items.EndUpdate;
    try
      Selected := nil;
      FIsUpdating := False;
      FLastFilter := aFilter;
      if ExpandLevel < 0 then
        FullExpand
      else
        ExpandUpTo(FExpandLevel);
      Select(aList);
    finally
      aList.Free;
    end;
  end;
end;

procedure TfrxTreeView.InvalidateExpandButton(HideButton: Boolean);
var
  bSaveState: Boolean;
begin
  if not HandleAllocated then Exit;
  bSaveState := FDrawExpandButton;
  try
    if HideButton then FDrawExpandButton := False;
    InvalidateRect(Handle, @FExpandButtonRect, not (csOpaque in ControlStyle));
  finally
    FDrawExpandButton := bSaveState;
  end;
end;

function TfrxTreeView.IsCustomDrawn(Target: TCustomDrawTarget;
  Stage: TCustomDrawStage): Boolean;
begin
  Result := inherited IsCustomDrawn(Target, Stage) or FDrawExpandButton;
end;

procedure TfrxTreeView.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  if FExpandButtonActive then
  begin
    ExpandButtonState := not ExpandButtonState;
    if Assigned(FOnExpandButtonClick) then
      FOnExpandButtonClick(Self);
  end;
end;

procedure TfrxTreeView.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  IsActive: Boolean;
begin
  inherited;
  IsActive := (X >= FExpandButtonRect.Left) and (X <= FExpandButtonRect.Right) and (Y >= FExpandButtonRect.Top) and (Y <= FExpandButtonRect.Bottom);
  if FExpandButtonActive <> IsActive then
    InvalidateExpandButton;
  FExpandButtonActive := IsActive;
end;

procedure TfrxTreeView.ResetFilter;
begin
  if FLastFilter <> '' then Filter('');
  FLastFilter := '';
end;

procedure TfrxTreeView.Resize;
begin
  InvalidateExpandButton(True);
  UpdateExpandButton;
  inherited;
  InvalidateExpandButton;
end;

procedure TfrxTreeView.SetDrawExpandButton(const Value: Boolean);
begin
  FDrawExpandButton := Value;
  InvalidateExpandButton;
end;

procedure TfrxTreeView.SetExpandButtonAlign(const Value: TfrxToolAlign);
begin
  FExpandButtonAlign := Value;
  InvalidateExpandButton;
end;

procedure TfrxTreeView.SetExpandButtonState(const Value: Boolean);
begin
  FExpandButtonState := Value;
  InvalidateExpandButton;
end;

procedure TfrxTreeView.UpdateExpandButton;
var
  w, h: Integer;
begin
  w := ClientWidth;
  h := ClientHeight;
  case FExpandButtonAlign of
    ftaTop: FExpandButtonRect := Rect(w - (FExpandButtonWidth + 4), 2, w - 4, FExpandButtonWidth + 2);
    ftaBottom: FExpandButtonRect := Rect(w - (FExpandButtonWidth + 4), h - 2 - FExpandButtonWidth, w - 4, h - 2);
  end;
end;

procedure TfrxTreeView.UpdateFilter;
begin
  if FLastFilter <> '' then
    Filter(FLastFilter);
end;

procedure TfrxTreeView.WMDpiChanged(var Message: TMessage);
var
  NewPPI: Integer;
begin
  Inherited;
  NewPPI := frxGetDpiForWindow(Handle);
  if NewPPI = FCurrentPPI then Exit;
  DoPPIChanged(NewPPI);
  FCurrentPPI := NewPPI;
end;

procedure TfrxTreeView.WMHScroll(var Message: TWMHScroll);
begin
  InvalidateExpandButton(True);
  inherited;
end;

{$IFDEF FPC}
procedure TfrxTreeView.WMMouseWheel(var Message: TLMMouseEvent);
{$ELSE}
procedure TfrxTreeView.WMMouseWheel(var Message: TWMMouseWheel);
{$ENDIF}
begin
  InvalidateExpandButton(True);
  inherited;
end;

procedure TfrxTreeView.WMVScroll(var Message: TWMVScroll);
begin
  InvalidateExpandButton(True);
  inherited;
end;

{ TfrxDataNode }

procedure TfrxDataNode.Clear;
  procedure FreeNode(aNode: TfrxDataNode);
  var
    nNext: TfrxDataNode;
  begin
    nNext := aNode.FFirstChild;
    while nNext <> nil do
    begin
      aNode := nNext;
      FreeNode(nNext);
      nNext := nNext.FRSibling;
      aNode.Free;
    end;
  end;
begin
  FreeNode(Self);
end;

destructor TfrxDataNode.Destroy;
begin
  if (FFirstChild <> nil) then Clear;
  if Assigned(FOriginalNode) then TfrxTreeNode(FOriginalNode).FDataNode := nil;
  if (FLSibling = nil) then
  begin
    if Assigned(FParent) then
    begin
      FParent.FFirstChild := FRSibling;
      if Assigned(FRSibling) then
        FRSibling.FParent := FParent;
    end;
  end
  else
    FLSibling.FRSibling := FRSibling;
  if Assigned(FRSibling) then
    FRSibling.FLSibling := FLSibling;
  inherited;
end;

{ TfrxTreePanel }

function TfrxTreePanel.CalcButtonsWidth: Integer;
begin
  Result := FToolPanel.CalcButtonsWidth;
end;

constructor TfrxTreePanel.Create(AOwner: TComponent);
begin
  FToolPanel := TfrxToolPanel.Create(Self);
  FPanel := TfrxDPIAwarePanel.Create(FToolPanel);
  FTreeView := TfrxTreeView.Create(Self);
  FFilter := TfrxFilterEdit.Create(FPanel);
  inherited;
  FFilter.OnFilterChanged := EditChange;
  FTreeView.OnExpandButtonClick := ExpandButtonClick;
  FPanel.BorderStyle := bsNone;
  FPanel.BevelInner := bvNone;
  FPanel.BevelOuter := bvNone;
  FilterAlign := fraRight;
  FFileterMinWidth := 40;
  FFileterMaxWidth := 200;
  FTreeView.BorderWidth := 0;
  FTreeView.BorderStyle := bsNone;
  FFilter.EditControl.Font.Size := 8;
  FToolPanel.Height := 24;
  FPanel.BorderWidth := 2;
  FPanel.Align := alRight;
  FFilterActiveImageIndex := -1;
  FFilterUnactiveImageIndex := -1;
end;

destructor TfrxTreePanel.Destroy;
begin
  FToolPanel := nil;
  FTreeView := nil;
  FFilter := nil;
  FPanel := nil;
  inherited;
end;

procedure TfrxTreePanel.DoPPIChanged(aNewPPI: Integer);
begin
  inherited;
  FFileterMinWidth := MulDiv(FFileterMinWidth, aNewPPI, CurrentPPI);
  FFileterMaxWidth := MulDiv(FFileterMaxWidth, aNewPPI, CurrentPPI);
end;

procedure TfrxTreePanel.EditChange(Sender: TObject);
begin
  FTreeView.Filter(FFilter.EditControl.Text);
end;

procedure TfrxTreePanel.ExpandButtonClick(Sender: TObject);
begin
  FToolPanel.Visible := FTreeView.ExpandButtonState;
end;

function TfrxTreePanel.GetFilterColor: TColor;
begin
  Result := FFilter.FilterColor;
end;

function TfrxTreePanel.GetFilterVisible: Boolean;
begin
  Result := FPanel.Visible and FFilter.Visible;
end;

function TfrxTreePanel.GetImageList: TCustomImageList;
begin
  Result := nil;
  if Assigned(FToolPanel) then
    Result := FToolPanel.ImageList;
end;

function TfrxTreePanel.GetToolVisible: Boolean;
begin
  Result := False;
  if Assigned(FToolPanel) then
    Result := FToolPanel.Visible;
end;

procedure TfrxTreePanel.Resize;
begin
  inherited Resize;
{$IFNDEF FPC}
  UpdateSize;
{$ENDIF}
end;

{$IFDEF FPC}
procedure TfrxTreePanel.DoOnResize;
begin
  inherited DoOnResize;
  UpdateSize;
end;
{$ENDIF}

procedure TfrxTreePanel.SetFileterMaxWidth(const Value: Integer);
begin
  FFileterMaxWidth := Value;
  UpdateSize;
end;

procedure TfrxTreePanel.SetFileterMinWidth(const Value: Integer);
begin
  FFileterMinWidth := Value;
  UpdateSize;
end;

procedure TfrxTreePanel.SetFilterActiveImageIndex(const Value: Integer);
begin
  FFilterActiveImageIndex := Value;
  FFilter.BitmapActive.Height := 0;
  FFilter.BitmapActive.Width := 0;
  if Assigned(FToolPanel.ImageList) then
    frxDrawIcon(FToolPanel.ImageList, FFilter.BitmapActive, FFilterActiveImageIndex, FFilter.FilterColor);
end;

procedure TfrxTreePanel.SetFilterAlign(const Value: TfrxFilterAlign);
begin
  FFilterAlign := Value;
  case Value of
    fraLeft, fraWidth: FPanel.Align := alLeft;
    fraRight: FPanel.Align := alRight;
  end;
end;

procedure TfrxTreePanel.SetFilterColor(const Value: TColor);
begin
  FilterEdit.FilterColor := Value;
  SetFilterActiveImageIndex(FilterActiveImageIndex);
  SetFilterUnactiveImageIndex(FilterUnactiveImageIndex);
end;

procedure TfrxTreePanel.SetFilterUnactiveImageIndex(const Value: Integer);
begin
  FFilterUnactiveImageIndex := Value;
  FFilter.BitmapUnactive.Height := 0;
  FFilter.BitmapUnactive.Width := 0;

  if Assigned(FToolPanel.ImageList) then
    frxDrawIcon(FToolPanel.ImageList, FFilter.BitmapUnactive, FFilterUnactiveImageIndex, FFilter.FilterColor);
end;

procedure TfrxTreePanel.SetFilterVisible(const Value: Boolean);
begin
  FPanel.Visible := Value;
  FFilter.Visible := Value;
end;

procedure TfrxTreePanel.SetImageList(const Value: TCustomImageList);
begin
  FToolPanel.ImageList := Value;
  SetFilterActiveImageIndex(FFilterActiveImageIndex);
  SetFilterUnactiveImageIndex(FFilterUnactiveImageIndex);
end;

procedure TfrxTreePanel.SetParent(AParent: TWinControl);
begin
  if AParent = nil then
  begin
    if Assigned(FToolPanel) then
      FToolPanel.Parent := nil;
    if Assigned(FTreeView) then
      FTreeView.Parent := nil;
    if Assigned(FFilter) then
      FFilter.Parent := nil;
  end;
  inherited;
  if AParent <> nil then
  begin
    FToolPanel.Parent := Self;
    SetToolPanelAlign(FToolPanelAlign);
    FTreeView.Parent := Self;
    FTreeView.Align := alClient;
    FPanel.Parent := FToolPanel;
    FFilter.Parent := FPanel;
  end;

end;

procedure TfrxTreePanel.SetToolPanelAlign(const Value: TfrxToolAlign);
begin
  FToolPanelAlign := Value;
  FTreeView.ExpandButtonAlign := Value;
  case Value of
    ftaTop: FToolPanel.Align := alTop;
    ftaBottom: FToolPanel.Align := alBottom;
  end;
end;

procedure TfrxTreePanel.SetToolVisible(const Value: Boolean);
begin
  FToolPanel.Visible := Value;
end;

procedure TfrxTreePanel.UpdateSize;
var
  lWidth: Integer;
begin
  if not Assigned(FToolPanel) and not ToolVisible then Exit;
  FPanel.Parent := nil;
  FTreeView.FExpandButtonState := FToolPanel.Visible;
  FToolPanel.Width := Width;
  lWidth := Width - CalcButtonsWidth - FToolPanel.Height div 3;
  if FFilterAlign = fraWidth  then
    FPanel.Width := Width - FToolPanel.Height div 3
  else if lWidth > FFileterMaxWidth then
    FPanel.Width := FFileterMaxWidth
  else if lWidth < FFileterMinWidth then
    FPanel.Visible := False
  else
    FPanel.Width := lWidth;
  if lWidth > FFileterMinWidth then
    FPanel.Visible := True;
  FFilter.Align := alRight;
  FFilter.SetBounds(2, 0, FPanel.Width - 4, FPanel.Height);
  FPanel.Parent := FToolPanel;
end;

{ TfrxToolPanelButton }

procedure TfrxToolPanelButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  FIsActive := True;
  Invalidate;
end;

procedure TfrxToolPanelButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  FIsActive := False;
  Invalidate;
end;

constructor TfrxToolPanelButton.Create(AOwner: TComponent);
begin
  inherited;
  FGroup := -1;
  FButtonStyle := fbsButton;
  FImageIndex := -1;
end;

function TfrxToolPanelButton.GetArrowWidth: Integer;
var
  pPanel: TfrxToolPanel;
begin
  Result := 0;
  pPanel := GetParentPanel;
  if Assigned(pPanel) then
    Result := pPanel.GetArrowWidth;
end;

function TfrxToolPanelButton.GetParentPanel: TfrxToolPanel;
begin
  Result := nil;
  if Parent is TfrxToolPanel then
    Result := TfrxToolPanel(Parent);
end;

{function TfrxToolPanelButton.IsDown: Boolean;
begin
  Result := FIsDown;
end;}

procedure TfrxToolPanelButton.MouseDown(Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Panel: TfrxToolPanel;
begin
  inherited;
  Panel := GetParentPanel;
  if (FButtonStyle = fbsRadioButton) and Assigned(Panel) then
    Panel.ResetRadioGroup(FGroup);
  if (FButtonStyle = fbsCheckButton) then
    FIsDown := not FIsDown
  else
    FIsDown := True;
  Invalidate;
end;

procedure TfrxToolPanelButton.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  Panel: TfrxToolPanel;
begin
  inherited;
  Panel := GetParentPanel;
  if (FButtonStyle <> fbsCheckButton) and (FButtonStyle <> fbsRadioButton) then
    FIsDown := False;
  if Assigned(Panel) and Assigned(Panel.FOnBtnClick) then
    Panel.FOnBtnClick(Self);
  Invalidate;
end;

procedure TfrxToolPanelButton.Paint;
var
  R: TRect;
  pPanel: TfrxToolPanel;
begin
  inherited;
  pPanel := GetParentPanel;
  R := GetClientRect;
  if Assigned(pPanel) then
  begin
    Canvas.Brush.Color := pPanel.Color;
    if pPanel.ParentBackground then
      Canvas.Brush.Color := clNone
    else
      Canvas.FillRect(R);
  end
  else
  begin
    Canvas.Brush.Color := clBtnFace;
    Canvas.FillRect(R);
  end;
  InflateRect(R, -2, -2);
  if FIsDown then
  begin
    Canvas.Brush.Color := frxBlend(clWindow, clHighlight, 355);
    Canvas.FillRect(R);
  end
  else if FIsActive then
  begin
    Canvas.Brush.Color :=  frxBlend(clWindow, clHighlight, 555);
    Canvas.FillRect(R);
  end;

  if FIsActive then
  begin
    Canvas.Brush.Color :=  clHighlight;
    Canvas.FrameRect(R);
  end
  else
  begin

  end;
  if (FImageIndex > -1) and Assigned(pPanel) and Assigned(pPanel.FImageList) then
    pPanel.FImageList.Draw(Canvas, 4, 4, FImageIndex, Enabled);

  if FButtonStyle = fbsDropDownButton then
  begin
    R.Left := R.Right - GetArrowWidth;
    frxDrawArrow(Canvas, R, clBtnText);
  end;
end;

procedure TfrxToolPanelButton.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
var
  tp: TfrxToolPanel;
begin
  tp := GetParentPanel;
  if Assigned(tp) and Assigned(tp.ImageList) then
  begin
    AWidth := tp.ImageList.Height + 8;
    AHeight := AWidth;
  end;
  if (FButtonStyle = fbsDropDownButton) and (AWidth <= AHeight) then AWidth := AWidth + 16;
  inherited SetBounds(ALeft, ATop, AWidth, AHeight);
end;

{$IFDEF FPC}
procedure TfrxToolPanelButton.ChangeBounds(ALeft, ATop, AWidth,
  AHeight: integer; KeepBase: boolean);
var
  tp: TfrxToolPanel;
begin
  tp := GetParentPanel;
  if Assigned(tp) and Assigned(tp.ImageList) then
  begin
    AWidth := tp.ImageList.Height + 8;
    AHeight := AWidth;
  end;
  if (FButtonStyle = fbsDropDownButton) and (AWidth <= AHeight) then AWidth := AWidth + 16;
  inherited ChangeBounds(ALeft, ATop, AWidth, AHeight, KeepBase);
end;
{$ENDIF}

procedure TfrxToolPanelButton.SetButtonStyle(const Value: TfrxToolButttonStyle);
begin
  FButtonStyle := Value;
  if FButtonStyle = fbsDropDownButton then Width := Width + 16;
end;

procedure TfrxToolPanelButton.SetIsDown(const Value: Boolean);
begin
  FIsDown := Value;
  Invalidate;
end;

{ TfrxToolPanel }

function TfrxToolPanel.AddButton(ImageIndex: Integer; HintText: String = ''; Tag: NativeInt = -1; ButtonStyle: TfrxToolButttonStyle = fbsButton; Group: Integer = -1): TfrxToolPanelButton;
begin
  Result := AddCustomButton(fbkButton) as TfrxToolPanelButton;
  Result.Tag := Tag;
  Result.FImageIndex := ImageIndex;
  Result.ButtonStyle := ButtonStyle;
  Result.FGroup := Group;
  Result.Hint := HintText;
  if HintText <> '' then
    Result.ShowHint := True;
end;

function TfrxToolPanel.AddCustomButton(
  aKind: TfrxToolButttonKind): TfrxToolPanelCustomButton;
begin
  case akind of
    fbkButton: Result := TfrxToolPanelButton.Create(Self);
    fbkSeparator: Result := TfrxToolPanelSeparator.Create(Self);
    else
      Result := TfrxToolPanelSeparator.Create(Self);
  end;
  Result.Parent := Self;
  FButtons.Add(Result);
end;

procedure TfrxToolPanel.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
begin
  if FImageList <> nil then
    aHeight := FImageList.Height + 8;
  inherited SetBounds(aLeft, aTop, aWidth, aHeight);
end;

{$IFDEF FPC}
procedure TfrxToolPanel.ChangeBounds(ALeft, ATop, AWidth, AHeight: integer;
  KeepBase: boolean);
begin
  if FImageList <> nil then
    aHeight := FImageList.Height + 8;
  inherited ChangeBounds(ALeft, ATop, AWidth, AHeight, KeepBase);
  RealignButtons;
end;
{$ENDIF}

constructor TfrxToolPanel.Create(AOwner: TComponent);
begin
  inherited;
  FButtons := TList.Create;
  BorderStyle := bsNone;
  BevelInner := bvNone;
  BevelOuter := bvNone;
end;

destructor TfrxToolPanel.Destroy;
begin
  FreeAndNil(FButtons);
  inherited;
end;

function TfrxToolPanel.GetArrowWidth: Integer;
begin
  Result := Height div 2;
end;

procedure TfrxToolPanel.Paint;
begin
  inherited;
end;
procedure TfrxToolPanel.RealignButtons;
var
  i: Integer;
  btn: TfrxToolPanelCustomButton;
begin
  if FImageList = nil then Exit;
  if FButtons.Count > 0 then
     TfrxToolPanelCustomButton(FButtons[0]).Left := 0;
  for i := 0 to FButtons.Count - 1 do
  begin
    btn := TfrxToolPanelCustomButton(FButtons[i]);
    if i > 0 then
       btn.Left := TfrxToolPanelCustomButton(FButtons[i - 1]).Left + TfrxToolPanelCustomButton(FButtons[i - 1]).Width;
    btn.Width := FImageList.Height;
    btn.Height := FImageList.Height;
  end;
end;

procedure TfrxToolPanel.ResetRadioGroup(GroupIndex: Integer);
var
  i: Integer;
begin
  if GroupIndex = -1 then Exit;
  { we arent expecting that this component will be used somwhere outside FR }
  { so just cycle all the buttons }
  for i := 0 to FButtons.Count - 1 do
    if (TObject(FButtons[i]) is TfrxToolPanelButton) and (TfrxToolPanelButton(FButtons[i]).FGroup = GroupIndex) then
      if TfrxToolPanelButton(FButtons[i]).FIsDown then
      begin
        TfrxToolPanelButton(FButtons[i]).FIsDown := False;
        TfrxToolPanelButton(FButtons[i]).Invalidate;
      end;
end;

function TfrxToolPanel.CalcButtonsWidth: Integer;
var
  i: Integer;
begin
  Result := 0;
  for i := 0 to FButtons.Count - 1 do
    Inc(Result, TfrxToolPanelCustomButton(FButtons[i]).Width);
end;

procedure TfrxToolPanel.SetImageList(const Value: TCustomImageList);
var
  i: Integer;
  b: TfrxToolPanelCustomButton;
begin
  FImageList := Value;
  Height := FImageList.Height + 8;
  for i := 0 to FButtons.Count - 1 do
  begin
    b := TfrxToolPanelCustomButton(FButtons[i]);
    b.SetBounds(b.Left, b.Top, Height, Height);
  end;
end;

{ TfrxToolPanelCustomButton }

constructor TfrxToolPanelCustomButton.Create(AOwner: TComponent);
begin
  inherited;
{$IFDEF FPC}
  if AOwner is TfrxToolPanel then
     Left := TfrxToolPanel(AOwner).CalcButtonsWidth + 1
  else
{$ENDIF}
    Align := alLeft;
  if AOwner is TControl then
  begin
    Width := TControl(AOwner).Height;
    Height := TControl(AOwner).Height;
  end;
end;

{ TfrxTreeNodes }

procedure TfrxTreeNodes.Assign(Source: TPersistent);
begin
  if Owner is TfrxTreeView then
    TfrxTreeView(Owner).ResetFilter;
  inherited;
end;

procedure TfrxTreeNodes.DefineProperties(Filer: TFiler);
begin
  if Owner is TfrxTreeView then
    TfrxTreeView(Owner).ResetFilter;
  inherited;
end;

{ TfrxToolPanelSeparator }

constructor TfrxToolPanelSeparator.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  if AOwner is TControl then
    Width := TControl(AOwner).Height div 3;
end;

procedure TfrxToolPanelSeparator.Paint;
var
  x: Integer;
begin
  inherited;
  x := Width div 2;
  Canvas.Pen.Color := clBtnShadow;
  Canvas.MoveTo(x - 1, 2);
  Canvas.LineTo(x - 1, Height - 2);
  Canvas.Pen.Color := clBtnHighlight;
  Canvas.MoveTo(x, 2);
  Canvas.LineTo(x, Height - 2);
end;

end.
