jvlinklabeltree.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: Tree.pas, released 2002-01-06.

The Initial Developer of the Original Code is David Polberger <dpol att swipnet dott se>
Portions created by David Polberger are Copyright (C) 2002 David Polberger.
All Rights Reserved.

Contributor(s): Cetkovsky

Current Version: 2.00

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Known Issues:
  Please see the accompanying documentation.
Description:
  Tree.pas provides the tree data structure used elsewhere, TNodeTree, as well
  as supporting classes.

  Note: Documentation for this unit can be found in Doc\Source.txt and
        Doc\Readme.txt!
-----------------------------------------------------------------------------}
// $Id: JvLinkLabelTree.pas,v 1.19 2005/02/17 10:20:42 marquardt Exp $

unit JvLinkLabelTree;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Classes, SysUtils, Windows, Graphics,
  JvLinkLabelTools, JvTypes;

type
  ENodeError = class(EJVCLException);

  { Object hierarchy:

    TNode
    |  TParentNode
    |  |  TAreaNode
    |  |  |  TStyleNode
    |  |  |  TColorNode
    |  |  |  TLinkNode
    |  |  |  TDynamicNode
    |  |  |  TRootNode
    |  TStringNode
    |  TActionNode
    |  TUnknownNode
  }

  TNodeClass = class of TNode;
  TNodeType = (ntNode, ntParentNode, ntAreaNode, ntStyleNode, ntColorNode,      // Bianconi
    ntLinkNode, ntDynamicNode, ntRootNode, ntStringNode, ntActionNode, ntUnknownNode);
  TParentNode = class;
  TRootNode = class;

  TNode = class(TObject)
  private
    FParent: TParentNode;
    FRootNode: TRootNode;
  public
    // Bianconi #2
    constructor Create;
    destructor Destroy; override;
    // End of Bianconi #2
    function GetNodeType: TNodeType;
    property Parent: TParentNode read FParent write FParent;
    property Root: TRootNode read FRootNode write FRootNode;
  end;

  INodeEnumerator = interface
    function GetNext: TNode;
    function HasNext: Boolean;
    procedure Reset;
  end;

  TNodeList = class;
  TParentNode = class(TNode)
  private
    FChildren: TNodeList;
    FOwnsChildren: Boolean;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddChild(const ANode: TNode; const ARoot: TRootNode);
    procedure DestroyChildren;
    function IndexOfChild(const Node: TNode): Integer;
    function GetTopLevelNodeEnumerator(const NodeClass: TNodeClass): INodeEnumerator;
    function GetFirstNodeOfClass(NodeClass: TNodeClass): TNode;
    function GetSpecificNodeOfClass(Index: Integer; NodeClass: TNodeClass): TNode;
    property Children: TNodeList read FChildren;
    property OwnsChildren: Boolean read FOwnsChildren write FOwnsChildren;
  end;

  IRectEnumerator = interface;

  TAreaNode = class(TParentNode)
  private
    FStartingPoint: TPoint;
    FStyles: TFontStyles;
    FColor: TColor;
    function GetText: string;
  protected
    function GetStyles: TFontStyles; virtual;
    function GetColor: TColor; virtual;
  public
    constructor Create;
    function GetRectEnumerator: IRectEnumerator;
    function IsPointInNode(const P: TPoint): Boolean;
    function IsPointInNodeClass(const P: TPoint; NodeClass: TNodeClass): Boolean; virtual;
    function GetNodeAtPointOfClass(const P: TPoint; NodeClass: TNodeClass): TNode;
    property StartingPoint: TPoint read FStartingPoint write FStartingPoint;
    property Styles: TFontStyles read GetStyles write FStyles;
    property Color: TColor read GetColor write FColor;
    property Text: string read GetText;
  end;

  TStyleNode = class(TAreaNode)
  private
    FStyle: TFontStyle;
  public
    constructor Create(const Style: TFontStyle);
    property Style: TFontStyle read FStyle write FStyle;
  end;

  // Bianconi
  TColorNode = class(TAreaNode)
  private
    FColor: TColor;
  public
    constructor Create(const AColor: TColor);
    property Color: TColor read FColor write FColor;
  end;
  // End of Bianconi

  TLinkState = (lsNormal, lsClicked, lsHot);
  TLinkNode = class(TAreaNode)
  private
    FState: TLinkState;
    FNumber: Integer;
    //Cetkovsky -->
    FParam: string;
    //<-- Cetkovsky
  protected
    function GetColor: TColor; override;

    //Cetkovsky -->
    function GetParam: string; virtual;
    procedure SetParam(Value: string); virtual;
    //<-- Cetkovsky
  public
    //Cetkovsky -->
    constructor Create(const AParam: string);
    //<-- Cetkovsky
    //constructor Create;
    class procedure ResetCount;
    property State: TLinkState read FState write FState;
    property Number: Integer read FNumber;

    //Cetkovsky -->
    property Param: string read GetParam write SetParam;
    //<-- Cetkovsky
  end;

  TDynamicNode = class(TAreaNode)
  private
    FNumber: Integer;
  public
    constructor Create;
    class procedure ResetCount;
    property Number: Integer read FNumber;
  end;

  TRectArray = array of TRect;

  TRootNode = class(TAreaNode)
  private
    FRectArray: TRectArray;
    procedure AddRect(const Rect: TRect);
  public
    procedure RetrieveRectsOfTLinkNodeChildren;
    function IsPointInNodeClass(const P: TPoint; NodeClass: TNodeClass): Boolean; override;
  end;

  TSpaceInfo = record
    LastWordEndsWithSpace: Boolean;
    SpaceWidth: Integer;
  end;

  TWordInfo = record
    SpaceInfo: TSpaceInfo;
    Width: Integer;
  end;

  TWordInfoArray = array of TWordInfo;

  TStringNode = class(TNode)
  private
    FText: string;
    FRectArray: TRectArray;
    FWordInfoArray: TWordInfoArray;
    FFirstWordWidthRetrieved: Boolean;
  protected
    //Cetkovsky -->
    class function ConvertEntities(Text: string): string;
    //<-- Cetkovsky
//    function ConvertEntities(Text: string): string;
  public
    constructor Create(const Text: string);
    procedure AddRect(const Rect: TRect);
    procedure ClearRects;
    procedure AddWordInfo(SpaceInfo: TSpaceInfo; Width: Integer);
    procedure ClearWordInfo;
    function IsWordInfoInArray(const Pos: Integer): Boolean;
    function GetWordInfo(const Pos: Integer): TWordInfo;
    function IsPointInNode(const P: TPoint): Boolean;
    property Text: string read FText write FText;
    property RectArray: TRectArray read FRectArray;
    property FirstWordWidthRetrieved: Boolean read FFirstWordWidthRetrieved write FFirstWordWidthRetrieved;
  end;

  TActionType = (atLineBreak, atParagraphBreak);

  TActionNode = class(TNode)
  private
    FAction: TActionType;
  public
    constructor Create(const Action: TActionType);
    property Action: TActionType read FAction write FAction;
  end;

  TUnknownNode = class(TNode)
  private
    FTag: string;
  public
    constructor Create(const Tag: string);
    property Tag: string read FTag;
  end;

  TNodeList = class(TList)
  private
    function Get(Index: Integer): TNode;
    procedure Put(Index: Integer; const Value: TNode);
  public
    function Add(Item: TNode): Integer;
    procedure Insert(Index: Integer; Item: TNode);
    function Remove(Item: TNode): Integer;
    function IndexOf(Item: TNode): Integer;
    property Items[Index: Integer]: TNode read Get write Put; default;
  end;

  TNodeTree = class(TObject)
  private
    FRoot: TRootNode;
  public
    constructor Create;
    destructor Destroy; override;
    function GetTopLevelNodeEnumerator(const NodeClass: TNodeClass): INodeEnumerator;
    function IsPointInTree(const P: TPoint): Boolean;
    function IsPointInNodeClass(const P: TPoint; NodeClass: TNodeClass): Boolean;
    function GetNodeAtPointOfClass(const P: TPoint; NodeClass: TNodeClass): TNode;
    function GetSpecificNodeOfClass(Index: Integer; NodeClass: TNodeClass): TNode;
    procedure Clear;
    property Root: TRootNode read FRoot;
  end;

  IRectEnumerator = interface
    function GetNext: TRect;
    function HasNext: Boolean;
    procedure Reset;
  end;

const
  clNormalLink = TColor($400 or $80000000);
  clClickedLink = TColor($401 or $80000000);
  clHotLink = TColor($402 or $80000000);

procedure ResetNodeCount;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvLinkLabelTree.pas,v $';
    Revision: '$Revision: 1.19 $';
    Date: '$Date: 2005/02/17 10:20:42 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  JvConsts, JvResources;

type
  TRectList = class(TOwnerPointerList)
  private
    function Get(Index: Integer): PRect;
  public
    procedure AddRect(const Rect: TRect);
    property Items[Index: Integer]: PRect read Get; default;
  end;

  TRectEnumerator = class(TInterfacedObject, IRectEnumerator)
  private
    FList: TRectList;
    FIndex: Integer;
  public
    constructor Create(const List: TRectList);
    destructor Destroy; override;
    function GetNext: TRect;
    function HasNext: Boolean;
    procedure Reset;
  end;

  TTopLevelNodeEnumerator = class(TInterfacedObject, INodeEnumerator)
  private
    FRoot: TParentNode;
    FNodeClass: TNodeClass;
    FList: TNodeList;
    FIndex: Integer;
    procedure BuildList;
  public
    constructor Create(const Root: TParentNode; NodeClass: TNodeClass);
    destructor Destroy; override;
    function GetNext: TNode;
    function HasNext: Boolean;
    procedure Reset;
  end;

var
  LinkNodeCount: Integer = 0;
  DynamicNodeCount: Integer = 0;

procedure ResetNodeCount;
begin
  TLinkNode.ResetCount;
  TDynamicNode.ResetCount;
end;

//=== { TNodeTree } ==========================================================

constructor TNodeTree.Create;
begin
  inherited Create;
  FRoot := TRootNode.Create;
  FRoot.Styles := [];
  FRoot.Color := clWindowText;
end;

destructor TNodeTree.Destroy;
begin
  Clear;
  FRoot.Free;
  inherited Destroy;
end;

procedure TNodeTree.Clear;
begin
  FRoot.DestroyChildren;
end;

function TNodeTree.GetNodeAtPointOfClass(const P: TPoint; NodeClass: TNodeClass): TNode;
begin
  Result := FRoot.GetNodeAtPointOfClass(P, NodeClass);
end;

function TNodeTree.GetSpecificNodeOfClass(Index: Integer;
  NodeClass: TNodeClass): TNode;
begin
  Result := FRoot.GetSpecificNodeOfClass(Index, NodeClass);
end;

function TNodeTree.GetTopLevelNodeEnumerator(
  const NodeClass: TNodeClass): INodeEnumerator;
begin
  Result := FRoot.GetTopLevelNodeEnumerator(NodeClass);
end;

function TNodeTree.IsPointInNodeClass(const P: TPoint;
  NodeClass: TNodeClass): Boolean;
begin
  Result := FRoot.IsPointInNodeClass(P, NodeClass);
end;

function TNodeTree.IsPointInTree(const P: TPoint): Boolean;
begin
  Result := FRoot.IsPointInNode(P);
end;

//=== { TParentNode } ========================================================

constructor TParentNode.Create;
begin
  inherited Create;
  FChildren := TNodeList.Create;
  FOwnsChildren := True;
end;

destructor TParentNode.Destroy;
begin
  DestroyChildren;
  FChildren.Free;
  inherited Destroy;
end;

procedure TParentNode.AddChild(const ANode: TNode; const ARoot: TRootNode);
begin
  FChildren.Add(ANode);
  ANode.Parent := Self;
  ANode.Root   := ARoot;
end;

procedure TParentNode.DestroyChildren;
var
  I: Integer;
begin
  if FOwnsChildren then
    for I := FChildren.Count - 1 downto 0 do
    begin
      FChildren[I].Free;
      FChildren.Delete(I);
    end;
end;

function TParentNode.GetFirstNodeOfClass(NodeClass: TNodeClass): TNode;

  function RecurseTree(CurrentRoot: TParentNode): TNode;
  var
    I: Integer;
  begin
    Result := nil;
    for I := 0 to CurrentRoot.Children.Count - 1 do
    begin
      if CurrentRoot.Children[I] is NodeClass then
      begin
        Result := CurrentRoot.FChildren[I];
        Break;
      end
      else
      if CurrentRoot.Children[I] is TParentNode then
        Result := RecurseTree(TParentNode(CurrentRoot.Children[I]));
    end;
  end;

begin
  Result := RecurseTree(Self);
end;

function TParentNode.GetSpecificNodeOfClass(Index: Integer;
  NodeClass: TNodeClass): TNode;
var
  NodeEnum: INodeEnumerator;
  CurrentNode: TNode;
  CurrentIndex: Integer;
begin
  Result := nil;
  CurrentIndex := 0;
  NodeEnum := Self.GetTopLevelNodeEnumerator(NodeClass);
  while NodeEnum.HasNext do
  begin
    CurrentNode := NodeEnum.GetNext;
    if CurrentIndex = Index then
      Result := CurrentNode;
    Inc(CurrentIndex);
  end;
end;

function TParentNode.GetTopLevelNodeEnumerator(const NodeClass: TNodeClass): INodeEnumerator;
begin
  Result := TTopLevelNodeEnumerator.Create(Self, NodeClass);
end;

function TParentNode.IndexOfChild(const Node: TNode): Integer;
begin
  Result := FChildren.IndexOf(Node);
end;

//=== { TNodeList } ==========================================================

function TNodeList.Add(Item: TNode): Integer;
begin
  Result := inherited Add(Item);
end;

function TNodeList.Get(Index: Integer): TNode;
begin
  Result := inherited Get(Index);
end;

function TNodeList.IndexOf(Item: TNode): Integer;
begin
  Result := inherited IndexOf(Item);
end;

procedure TNodeList.Insert(Index: Integer; Item: TNode);
begin
  inherited Insert(Index, Item);
end;

procedure TNodeList.Put(Index: Integer; const Value: TNode);
begin
  inherited Put(Index, Value);
end;

function TNodeList.Remove(Item: TNode): Integer;
begin