jvlinklabel.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: JvLinkLabel.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): Bianconi, 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:
  LinkLabel.pas contains the main component, TJvLinkLabel, a rich-text label.
  It makes use of the renderer and parser stored in Renderer.pas and Parser.pas,
  respectively.

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

unit JvLinkLabel;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  SysUtils, Classes,
  {$IFDEF VCL}
  Messages,
  {$ENDIF VCL}
  Windows, Graphics, Controls, Forms, StdCtrls,
  JvLinkLabelParser, JvLinkLabelRenderer, JvLinkLabelTree,
  JvTypes, JvComponent;

type
  ELinkLabelError = class(EJVCLException);

  TLinkClickEvent = procedure(Sender: TObject; LinkNumber: Integer;
    LinkText, LinkParam: string) of object;  // added LinkParam by Cetkovsky
  TDynamicTagInitEvent = procedure(Sender: TObject; out Source: string;
    Number: Integer) of object;

  TJvCustomLinkLabel = class(TJvGraphicControl, IDynamicNodeHandler)
  private
    FText: TStringList;
    FRenderer: IRenderer;
    FActiveLinkNode: TLinkNode;
    FHotLinks: Boolean;
    FLinkCursor: TCursor;  // Bianconi
    // FRect: TRect;
    FAutoHeight: Boolean;
    FMarginWidth: Integer;
    FMarginHeight: Integer;
    FOriginalCursor: TCursor;
    FOnCaptionChanged: TNotifyEvent;
    FOnLinkClick: TLinkClickEvent;
    FOnDynamicTagInit: TDynamicTagInitEvent;
    FParser: IParser;
    FLayout: TTextLayout;  // Bianconi
    FCaption: TCaption;
    {$IFDEF VCL}
    procedure SetText(const Value: TCaption);
    {$ENDIF VCL}
    procedure SetTransparent(const Value: Boolean);
    function GetLinkColor: TColor;
    function GetLinkStyle: TFontStyles;
    procedure SetLinkColor(const Value: TColor);
    procedure SetLinkStyle(const Value: TFontStyles);
    function GetLinkCursor: TCursor;                    // Bianconi
    procedure SetLinkCursor(AValue: TCursor);           // Bianconi
    procedure SynchronizeRootAndFont;
    function GetLinkColorClicked: TColor;
    procedure SetLinkColorClicked(const Value: TColor);
    function GetLinkColorHot: TColor;
    procedure SetLinkColorHot(const Value: TColor);
    procedure ActivateLinkNodeAtPos(const P: TPoint; State: TLinkState);
    procedure DeactivateActiveLinkNode;
    procedure HandleDynamicNode(out Source: string; const Node: TDynamicNode);
    function GetTransparent: Boolean;
    function IsActiveLinkNodeClicked: Boolean;
    procedure SetAutoHeight(const Value: Boolean);
    procedure SetMarginHeight(const Value: Integer);
    procedure SetMarginWidth(const Value: Integer);
    function GetStrings: TStrings;
    procedure SetStrings(const Value: TStrings);
    procedure SetLayout(AValue: TTextLayout);     // Bianconi
  protected
    FNodeTree: TNodeTree;
    {$IFDEF VisualCLX}
    procedure SetText(const Value: TCaption); override;
    {$ENDIF VisualCLX}
    procedure TextChanged; override;
    procedure FontChanged; override;
    procedure Paint; override;
    function CreateParser: IParser; virtual;
    function CreateRenderer: IRenderer; virtual;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure MouseLeave(Control: TControl); override;
    procedure Resize; override;
    procedure DoCaptionChanged; virtual;
    procedure DoLinkClicked(LinkNumber: Integer; LinkText, LinkParam: string); virtual;  // added LinkParam by Cetkovsky
    procedure DoDynamicTagInit(out Source: string; Number: Integer); virtual;
    property Parser: IParser read FParser;
    property Renderer: IRenderer read FRenderer;
    property Caption: TCaption read FCaption write SetText;
    property Text: TStrings read GetStrings write SetStrings;
    property Transparent: Boolean read GetTransparent write SetTransparent default False;
    property Layout: TTextLayout read FLayout write SetLayout default tlTop;                // Bianconi
    property LinkColor: TColor read GetLinkColor write SetLinkColor default clBlue;
    property LinkColorClicked: TColor read GetLinkColorClicked write SetLinkColorClicked default clRed;
    property LinkColorHot: TColor read GetLinkColorHot write SetLinkColorHot default clPurple;
    property LinkCursor: TCursor read GetLinkCursor write SetLinkCursor default crHandPoint;
    property LinkStyle: TFontStyles read GetLinkStyle write SetLinkStyle default [fsUnderline];
    property HotLinks: Boolean read FHotLinks write FHotLinks default False;
    property AutoHeight: Boolean read FAutoHeight write SetAutoHeight default True;
    property MarginWidth: Integer read FMarginWidth write SetMarginWidth default 0;
    property MarginHeight: Integer read FMarginHeight write SetMarginHeight default 0;
    property OnDynamicTagInit: TDynamicTagInitEvent read FOnDynamicTagInit write FOnDynamicTagInit;
    property OnCaptionChanged: TNotifyEvent read FOnCaptionChanged write FOnCaptionChanged;
    property OnLinkClick: TLinkClickEvent read FOnLinkClick write FOnLinkClick;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Loaded; override;
    procedure UpdateDynamicTag(Number: Integer; const Source: string);
    function GetDynamicTagContents(Number: Integer): string;
  end;

  TJvLinkLabel = class(TJvCustomLinkLabel)
  published
    property Caption;
    property Text;
    property Anchors;
    property Transparent;
    property Layout;                   // Bianconi
    property LinkColor;
    property LinkColorClicked;
    property LinkColorHot;
    property LinkCursor;               // Bianconi
    property LinkStyle;
    property HotLinks;
    property AutoHeight;
    property MarginWidth;
    property MarginHeight;

    property OnDynamicTagInit;
    property OnCaptionChanged;
    property OnLinkClick;

    property Enabled;                 // Cetkovsky

    property Align;
    property Color;
    property Constraints;
    {$IFDEF VCL}
    property DragCursor;
    {$ENDIF VCL}
    property DragMode;
    property Font;
    property Height default 17;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property Visible;
    property Width default 160;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnStartDrag;
    property OnEndDrag;
    property OnMouseUp;
    property OnMouseDown;
    property OnMouseMove;
  end;

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

implementation

uses
  JvThemes, JvResources;

// Bianconi - Use property LinkCursor
//{.$R ../resources/JvLinkLabel.res}

const
  crNewLinkHand = 1;

constructor TJvCustomLinkLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLinkCursor := crHandPoint;
  FText := TStringList.Create;
  ControlStyle := ControlStyle + [csOpaque, csReplicatable];
  {$IFDEF VCL}
  IncludeThemeStyle(Self, [csParentBackground]);
  {$ENDIF VCL}
  Width := 160;
  Height := 17;
  FNodeTree := TNodeTree.Create;
  FAutoHeight := True;

  // Give descendant components an opportunity to replace the default classes
  FParser := CreateParser;
  FParser.SetDynamicNodeHandler(Self);
  FRenderer := CreateRenderer;

  FLayout := tlTop;              // Bianconi

  SetLinkColor(clBlue);
  SetLinkColorClicked(clRed);
  SetLinkColorHot(clPurple);
  SetLinkStyle([fsUnderline]);

  //  Screen.Cursors[crNewLinkHand] := LoadCursor(HInstance, 'LINKHAND');  // Bianconi
end;

destructor TJvCustomLinkLabel.Destroy;
begin
  FNodeTree.Free;
  FText.Free;
  inherited Destroy;
end;

procedure TJvCustomLinkLabel.ActivateLinkNodeAtPos(const P: TPoint; State: TLinkState);
var
  NodeAtPoint: TLinkNode;
  Pt: TPoint;  // Bianconi #2
  TmpRect: TRect;

  function IsNewNode: Boolean;
  begin
    { We must only redraw the TLinkNode if it either isn't the same as the
      currently active TLinkNode (FActiveLinkNode), or if we're trying to change
      the state (that is, alter the color). }
    Result := (FActiveLinkNode <> NodeAtPoint);
    if not Result and Assigned(FActiveLinkNode) then
      Result := FActiveLinkNode.State <> State;
  end;

begin
  // Bianconi #2
  // Changes Control's canvas point to relative coordinates
  Pt := Point(P.X - FNodeTree.Root.StartingPoint.X,P.Y - FNodeTree.Root.StartingPoint.Y);

  if FNodeTree.IsPointInNodeClass(Pt, TLinkNode) then
  begin
    NodeAtPoint := FNodeTree.GetNodeAtPointOfClass(Pt, TLinkNode) as TLinkNode;
    if Assigned(NodeAtPoint) and IsNewNode then
    begin
      DeactivateActiveLinkNode;
      NodeAtPoint.State := State;
      FActiveLinkNode := NodeAtPoint;
      TmpRect := ClientRect;
      InflateRect(TmpRect,-FMarginWidth,-FMarginHeight);
      FRenderer.RenderNode(Canvas, TmpRect, NodeAtPoint);
    end;
  end;
end;

procedure TJvCustomLinkLabel.DeactivateActiveLinkNode;
var
  TmpRect: TRect;
begin
  if Assigned(FActiveLinkNode) then
  try
    FActiveLinkNode.State := lsNormal;
    TmpRect := ClientRect;
    InflateRect(TmpRect,-FMarginWidth,-FMarginHeight);
    FRenderer.RenderNode(Canvas, TmpRect, FActiveLinkNode);
  finally
    FActiveLinkNode := nil;
  end;
end;

procedure TJvCustomLinkLabel.FontChanged;

  procedure ClearWordInfo;
  var
    Enum: INodeEnumerator;
  begin
    Enum := FNodeTree.GetTopLevelNodeEnumerator(TStringNode);
    while Enum.HasNext do
      (Enum.GetNext as TStringNode).ClearWordInfo;
  end;

begin
  inherited FontChanged;
  SynchronizeRootAndFont;
  ClearWordInfo;
  Invalidate;
end;

procedure TJvCustomLinkLabel.MouseLeave(Control: TControl);
begin
  if csDesigning in ComponentState then
    Exit;
  inherited MouseLeave(Control);;
  if FHotLinks and not IsActiveLinkNodeClicked then
    DeactivateActiveLinkNode;
end;

procedure TJvCustomLinkLabel.TextChanged;
begin
  inherited TextChanged;
  Invalidate;
end;

function TJvCustomLinkLabel.CreateParser: IParser;
begin
  { Descendant components wishing to use another parser (implementing the
    IParser interface) should override this routine and provide their own. A
    pointer to this object should be returned.

    function TMyLinkLabel.CreateParser: IParser;
    begin
      Result := TMyParser.Create;
    end; }
  Result := TDefaultParser.Create;
end;

function TJvCustomLinkLabel.CreateRenderer: IRenderer;
begin
  // Please refer to the comment in TJvCustomLinkLabel.CreateParser above.
  Result := TDefaultRenderer.Create;
end;

procedure TJvCustomLinkLabel.DoCaptionChanged;
begin
  if Assigned(FOnCaptionChanged) then
    FOnCaptionChanged(Self);
end;

procedure TJvCustomLinkLabel.DoDynamicTagInit(out Source: string; Number: Integer);
begin
  if Assigned(FOnDynamicTagInit) then
    FOnDynamicTagInit(Self, Source, Number);
end;

 // added LinkParam by Cetkovsky
procedure TJvCustomLinkLabel.DoLinkClicked(LinkNumber: Integer; LinkText, LinkParam: string);
begin
  if Assigned(FOnLinkClick) then
    FOnLinkClick(Self, LinkNumber, LinkText, LinkParam);
end;