jvqlinklabeltree.pas

East make Tray Icon in delphi

  inherited Create;
  FText := ConvertEntities(Text);
end;

procedure TStringNode.AddRect(const Rect: TRect);
begin
  SetLength(FRectArray, Length(FRectArray) + 1);
  FRectArray[High(FRectArray)] := Rect;
end;

procedure TStringNode.AddWordInfo(SpaceInfo: TSpaceInfo; Width: Integer);
begin
  SetLength(FWordInfoArray, Length(FWordInfoArray) + 1);
  FWordInfoArray[High(FWordInfoArray)].Width := Width;
  FWordInfoArray[High(FWordInfoArray)].SpaceInfo := SpaceInfo;
end;

procedure TStringNode.ClearRects;
begin
  FRectArray := nil;
end;

procedure TStringNode.ClearWordInfo;
begin
  FWordInfoArray := nil;
end;

//Cetkovsky -->
class function TStringNode.ConvertEntities(Text: string): string;
//<-- Cetkovsky
type
  TEntity = record
    Entity: PChar;
    Str: PChar;
  end;
const
  NumberOfEntities = 2;
  Entities: array [0..NumberOfEntities - 1] of TEntity =
    ((Entity: '&lt;'; Str: '<'),
     (Entity: '&gt;'; Str: '>'));
var
  I: Integer;
begin
  { Our support for entities is very limited. Right now, we only use it as a way
    to write the "<" and ">" characters, which would've been impossible without
    the use of entities. To implement full support, akin to XHTML, we would need
    to revise this simple implementation, which only handles simple string
    replacement (the renderer is oblivious to entities). For our uses, however,
    it's sufficient. }
  for I := Low(Entities) to High(Entities) do
    with Entities[I] do
      TStringTools.Replace(Entity, Str, Text);
  Result := Text;
end;

function TStringNode.GetWordInfo(const Pos: Integer): TWordInfo;
begin
  if IsWordInfoInArray(Pos) then
    Result := FWordInfoArray[Pos]
  else
    raise ENodeError.CreateRes(@RsEWordInfoIndexOutOfBounds);
end;

function TStringNode.IsPointInNode(const P: TPoint): Boolean;
var
  I: Integer;
begin
  Result := False;
  for I := Low(FRectArray) to High(FRectArray) do
  begin
    Result := TGraphicTools.IsPointInRect(FRectArray[I], P);
    if Result then
      Break;
  end;
end;

function TStringNode.IsWordInfoInArray(const Pos: Integer): Boolean;
begin
  Result := Pos <= High(FWordInfoArray);
end;

//=== { TStyleNode } =========================================================

constructor TStyleNode.Create(const Style: TFontStyle);
begin
  inherited Create;
  FStyle := Style;
end;

// Bianconi
//=== { TColorNode } =========================================================

constructor TColorNode.Create(const AColor: TColor);
begin
  inherited Create;
  if AColor <> clNone then
    FColor := AColor
  else
    FColor := inherited GetColor;
end;
// End of Bianconi

//=== { TUnknownNode } =======================================================

constructor TUnknownNode.Create(const Tag: string);
begin
  inherited Create;
  FTag := Tag;
end;

//=== { TActionNode } ========================================================

constructor TActionNode.Create(const Action: TActionType);
begin
  inherited Create;
  FAction := Action;
end;

//=== { TAreaNode } ==========================================================

constructor TAreaNode.Create;
begin
  inherited Create;
  FStartingPoint := Point(0, 0);
end;

function TAreaNode.GetColor: TColor;
begin
  Result := FColor;
end;

function TAreaNode.GetNodeAtPointOfClass(const P: TPoint; NodeClass: TNodeClass): TNode;
var
  NodeEnum: INodeEnumerator;
  CurrentNode: TAreaNode;
begin
  Result := nil;
  NodeEnum := Self.GetTopLevelNodeEnumerator(TAreaNode);
  while NodeEnum.HasNext do
  begin
    CurrentNode := NodeEnum.GetNext as TAreaNode;
    if CurrentNode.IsPointInNode(P) then
      if CurrentNode is NodeClass then
      begin
        Result := CurrentNode;
        Break;
      end
      else
        Result := CurrentNode.GetNodeAtPointOfClass(P, NodeClass);
  end;
end;

function TAreaNode.GetRectEnumerator: IRectEnumerator;
var
  NodeEnum: INodeEnumerator;
  CurrentNode: TStringNode;
  FList: TRectList;
  I: Integer;
begin
  FList := TRectList.Create;

  try
    { Retrieve a top-level enumerator which we use to get pointers to all
      TStringNodes we own (we write Self.Get... to make explicit the fact that
      we only get pointers to TStringNodes we own). }
    NodeEnum := Self.GetTopLevelNodeEnumerator(TStringNode);
    while NodeEnum.HasNext do
    begin
      CurrentNode := NodeEnum.GetNext as TStringNode;
      for I := Low(CurrentNode.RectArray) to High(CurrentNode.RectArray) do
        FList.AddRect(CurrentNode.RectArray[I]);
    end;

    // FList will be destroyed by TRectEnumerator's destructor
    Result := TRectEnumerator.Create(FList);
  except
    FList.Free;
    raise;
  end;
end;

function TAreaNode.GetStyles: TFontStyles;
begin
  Result := FStyles;
end;

function TAreaNode.GetText: string;
var
  NodeEnum: INodeEnumerator;
begin
  Result := '';
  NodeEnum := Self.GetTopLevelNodeEnumerator(TStringNode);
  while NodeEnum.HasNext do
    Result := Result + (NodeEnum.GetNext as TStringNode).Text;
end;

function TAreaNode.IsPointInNode(const P: TPoint): Boolean;
var
  NodeEnum: INodeEnumerator;
  CurrentNode: TStringNode;
begin
  Result := False;
  NodeEnum := Self.GetTopLevelNodeEnumerator(TStringNode);
  while NodeEnum.HasNext do
  begin
    CurrentNode := NodeEnum.GetNext as TStringNode;
    Result := CurrentNode.IsPointInNode(P);
    if Result then
      Break;
  end;
end;

function TAreaNode.IsPointInNodeClass(const P: TPoint;
  NodeClass: TNodeClass): Boolean;
var
  NodeEnum: INodeEnumerator;
  CurrentNode: TNode;
begin
  Result := False;
  NodeEnum := Self.GetTopLevelNodeEnumerator(NodeClass);
  while NodeEnum.HasNext do
  begin
    CurrentNode := NodeEnum.GetNext;
    if (CurrentNode is TAreaNode) then
    begin
      Result := TAreaNode(CurrentNode).IsPointInNode(P);
      if Result then
        Break;
    end;
  end;
end;

//=== { TNode } ==============================================================

// Bianconi #2
constructor TNode.Create;
begin
  inherited Create;
  FParent := nil;
  FRootNode := nil;
end;

destructor TNode.Destroy;
begin
  FParent := nil;
  FRootNode := nil;
  inherited Destroy;
end;
// End of Bianconi #2

function TNode.GetNodeType: TNodeType;
var
  NodeClass: TClass;
const
  NodeClasses: array [TNodeType] of TClass =
    (TNode, TParentNode, TAreaNode, TStyleNode, TColorNode,     // Bianconi
     TLinkNode, TDynamicNode, TRootNode, TStringNode, TActionNode, TUnknownNode);
begin
  { We get the dynamic type using TObject.ClassType, which returns a pointer to
    the class' virtual memory table, instead of testing using the "is" reserved
    word. We do this as any node is a TNode (thanks to polymorphism); we would
    have to test in reverse order, as if we tested for TNode first everything
    would appear to be a TNode. This could get messy when we add more TNode
    descendants later. }
  NodeClass := Self.ClassType;

  for Result := Low(TNodeType) to High(TNodeType) do
    if NodeClasses[Result] = NodeClass then
      Exit;

  raise ENodeError.CreateRes(@RsETNodeGetNodeTypeUnknownClass);
end;

//=== { TTopLevelNodeEnumerator } ============================================

constructor TTopLevelNodeEnumerator.Create(const Root: TParentNode;
  NodeClass: TNodeClass);
begin
  inherited Create;
  FRoot := Root;
  FNodeClass := NodeClass;
  FIndex := 0;

  FList := TNodeList.Create;
  BuildList;
end;

destructor TTopLevelNodeEnumerator.Destroy;
begin
  FList.Free;
  inherited Destroy;
end;

procedure TTopLevelNodeEnumerator.BuildList;

  procedure RecurseTree(CurrentRoot: TParentNode);
  var
    I: Integer;
  begin
    for I := 0 to CurrentRoot.Children.Count - 1 do
    begin
      { If we find a child that is of the requested type, add it to the list.
        Don't continue to recurse, as we're not interested in this node's
        children (after all, we're a top level enumerator!). }
      if CurrentRoot.Children[I] is FNodeClass then
        FList.Add(CurrentRoot.FChildren[I])
      else
      if CurrentRoot.Children[I] is TParentNode then
        RecurseTree(TParentNode(CurrentRoot.Children[I]));
    end;
  end;

begin
  FList.Clear;
  RecurseTree(FRoot);
end;

function TTopLevelNodeEnumerator.GetNext: TNode;
begin
  if HasNext then
  begin
    Result := FList[FIndex];
    Inc(FIndex);
  end
  else
    raise ENodeError.CreateRes(@RsENoMoreNodesToReturn);
end;

function TTopLevelNodeEnumerator.HasNext: Boolean;
begin
  Result := FIndex < FList.Count;
end;

procedure TTopLevelNodeEnumerator.Reset;
begin
  FIndex := 0;
end;

//=== { TRectEnumerator } ====================================================

constructor TRectEnumerator.Create(const List: TRectList);
begin
  inherited Create;
  FList := List;
  FIndex := 0;
end;

destructor TRectEnumerator.Destroy;
begin
  FList.Free;
  inherited Destroy;
end;

function TRectEnumerator.GetNext: TRect;
begin
  if HasNext then
  begin
    Result := FList[FIndex]^;
    Inc(FIndex);
  end
  else
    raise ENodeError.CreateRes(@RsENoMoreRecordsToReturn);
end;

function TRectEnumerator.HasNext: Boolean;
begin
  Result := FIndex < FList.Count;
end;

procedure TRectEnumerator.Reset;
begin
  FIndex := 0;
end;

//=== { TRectList } ==========================================================

procedure TRectList.AddRect(const Rect: TRect);
var
  NewRecord: PRect;
begin
  New(NewRecord);
  try
    NewRecord^.Left := Rect.Left;
    NewRecord^.Top := Rect.Top;
    NewRecord^.Right := Rect.Right;
    NewRecord^.Bottom := Rect.Bottom;
    FList.Add(NewRecord);
  except
    Dispose(NewRecord);
    raise;
  end;
end;

function TRectList.Get(Index: Integer): PRect;
begin
  Result := FList[Index];
end;

//=== { TLinkNode } ==========================================================

//Cetkovsky -->
constructor TLinkNode.Create(const AParam: string);
//<-- Cetkovsky
begin
  inherited Create;
  FNumber := LinkNodeCount;
  Inc(LinkNodeCount);
  //Cetkovsky -->
  FParam := AParam;
  //<-- Cetkovsky
end;

function TLinkNode.GetColor: TColor;
begin
  case State of
    lsNormal:
      Result := clNormalLink;
    lsClicked:
      Result := clClickedLink;
    lsHot:
      Result := clHotLink;
  else
    Result := inherited GetColor; // To get rid of a compiler warning
  end;
end;

class procedure TLinkNode.ResetCount;
begin
  LinkNodeCount := 0;
end;

//Cetkovsky -->
function TLinkNode.GetParam: string;
begin
  Result := FParam;
end;

procedure TLinkNode.SetParam(Value: string);
begin
  FParam := Value;
end;
//<-- Cetkovsky

//=== { TRootNode } ==========================================================

procedure TRootNode.AddRect(const Rect: TRect);
begin
  SetLength(FRectArray, Length(FRectArray) + 1);
  FRectArray[High(FRectArray)] := Rect;
end;

function TRootNode.IsPointInNodeClass(const P: TPoint; NodeClass: TNodeClass): Boolean;
var
  I: Integer;
begin
  { In the root, we cache the locations of all our TLinkNode children, not only
    our most immediate children but all of them, even if they have a parent
    other than the root node. We do this to improve performance, as this routine
    might be queried every time the mouse is moved. On a PII-400 MHz computer,
    TJvLinkLabel alone might consume 20% CPU power without this optimization when
    we move the mouse pointer as fast as we can, which is not acceptable. With
    this optimization, we consume only about a third as much CPU power. }
  if (NodeClass = TLinkNode) and (Length(FRectArray) <> 0) then
  begin
    Result := False;
    for I := Low(FRectArray) to High(FRectArray) do
      if TGraphicTools.IsPointInRect(FRectArray[I], P) then
      begin
        Result := True;
        Break;
      end;
  end
  else
    Result := inherited IsPointInNodeClass(P, NodeClass);
end;

procedure TRootNode.RetrieveRectsOfTLinkNodeChildren;
var
  NodeEnum: INodeEnumerator;
  RectEnum: IRectEnumerator;
begin
  FRectArray := nil;
  NodeEnum := Self.GetTopLevelNodeEnumerator(TLinkNode);
  while NodeEnum.HasNext do
  begin
    RectEnum := (NodeEnum.GetNext as TLinkNode).GetRectEnumerator;
    while RectEnum.HasNext do
      AddRect(RectEnum.GetNext);
  end;
end;

//=== { TDynamicNode } =======================================================

constructor TDynamicNode.Create;
begin
  inherited Create;
  FNumber := DynamicNodeCount;
  Inc(DynamicNodeCount);
end;

class procedure TDynamicNode.ResetCount;
begin
  DynamicNodeCount := 0;
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQLinkLabelTree.pas,v $';
    Revision: '$Revision: 1.16 $';
    Date: '$Date: 2004/12/21 09:45:18 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.