{-----------------------------------------------------------------------------
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: LinkLabel.pas, released 2008-10-20.

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

Contributor(s): Bianconi, Cetkovsky, Arvid Winkelsdorf

Last Modified: 2008-10-20;
Current Version: 2.01

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!
-----------------------------------------------------------------------------}

unit LinkLabelMain;

// AW: was renamed to avoid package conflict with JEDI vcl

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, 
  LinkLabelParser, LinkLabelRenderer, LinkLabelTree, LinkLabelTools;

const
  TJvLinkLabel_VERSION = '2.01';

type
  ELinkLabelError = class(Exception);

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

  TJvCustomLinkLabel = class(TCustomControl, IDynamicNodeHandler)
  private
    FText: TLinkLabelStringList;
    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;
    FCaption: UnicodeString;
    procedure SetText(const Value: UnicodeString);
    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: UnicodeString; const Node: TDynamicNode);
    function GetTransparent: Boolean;
    function IsActiveLinkNodeClicked: Boolean;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure SetAutoHeight(const Value: Boolean);
    procedure SetMarginHeight(const Value: Integer);
    procedure SetMarginWidth(const Value: Integer);
    function GetStrings: TLinkLabelStrings;
    procedure SetStrings(const Value: TLinkLabelStrings);
  protected
    FNodeTree: TNodeTree;
    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 Resize; override;
    procedure DoCaptionChanged; virtual;
    procedure DoLinkClicked(LinkNumber: Integer; LinkText, LinkParam: UnicodeString); virtual;  // added LinkParam by Cetkovsky
    procedure DoDynamicTagInit(out Source: UnicodeString; Number: Integer); virtual;
    property Parser: IParser read FParser;
    property Renderer: IRenderer read FRenderer;
    property Caption: UnicodeString read FCaption write SetText;
    property Text: TLinkLabelStrings read GetStrings write SetStrings;
    property Transparent: Boolean read GetTransparent write SetTransparent;

    property LinkColor: TColor read GetLinkColor write SetLinkColor;
    property LinkColorClicked: TColor read GetLinkColorClicked write SetLinkColorClicked;
    property LinkColorHot: TColor read GetLinkColorHot write SetLinkColorHot;
    property LinkCursor: TCursor read GetLinkCursor write SetLinkCursor default crHandPoint;
    property LinkStyle: TFontStyles read GetLinkStyle write SetLinkStyle;
    property HotLinks: Boolean read FHotLinks write FHotLinks;
    property AutoHeight: Boolean read FAutoHeight write SetAutoHeight;
    property MarginWidth: Integer read FMarginWidth write SetMarginWidth;
    property MarginHeight: Integer read FMarginHeight write SetMarginHeight;
    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: UnicodeString);
    function GetDynamicTagContents(Number: Integer): UnicodeString;
  end;

  TJvLinkLabel = class(TJvCustomLinkLabel)
  published
    property Caption;
    property Text;
    property Anchors;
    property Transparent;
    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;
    property DragCursor;
    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;

implementation

uses
  LinkLabelResources;

{ TJvLinkLabel }
constructor TJvCustomLinkLabel.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  
  FLinkCursor := crHandPoint;
  FText := TLinkLabelStringList.Create;
  ControlStyle := ControlStyle + [csOpaque, csReplicatable];
  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;

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

  DoubleBuffered := True;
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);
      Self.Repaint; // Invalidate will not work as it is asynchronous
      Canvas.Font.Assign(Font);
      FRenderer.RenderNode(Canvas, TmpRect, NodeAtPoint);
    end;
  end;
end;

procedure TJvCustomLinkLabel.DeactivateActiveLinkNode;
begin
  if Assigned(FActiveLinkNode) then
  begin
    FActiveLinkNode := nil;
    Self.Invalidate;
  end;
end;

procedure TJvCustomLinkLabel.CMFontChanged(var Message: TMessage);

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

begin
  inherited;
  SynchronizeRootAndFont;
  ClearWordInfo;
  Invalidate;
end;

procedure TJvCustomLinkLabel.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  if FHotLinks and not IsActiveLinkNodeClicked then
    DeactivateActiveLinkNode;
end;

procedure TJvCustomLinkLabel.CMTextChanged(var Message: TMessage);
begin
  inherited;
  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: UnicodeString;
  Number: Integer);
begin
  if Assigned(FOnDynamicTagInit) then
    FOnDynamicTagInit(Self, Source, Number);
end;

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

function TJvCustomLinkLabel.GetDynamicTagContents(Number: Integer): UnicodeString;
var
  Node: TAreaNode;
begin
  { Note that the output of this method is not serialized, that is, it will be
    plain text, with no tags present. In other words, simply the contents of
    the TStringNodes owned by the sought TDynamicNode. }
  Node := FNodeTree.GetSpecificNodeOfClass(Number, TDynamicNode) as TAreaNode;
  if Assigned(Node) then
    Result := Node.Text
  else
    raise ELinkLabelError.CreateRes(@RsEUnableToLocateMode);
end;

function TJvCustomLinkLabel.GetLinkColor: TColor;
begin
  Result := FRenderer.LinkColor;
end;

function TJvCustomLinkLabel.GetLinkColorClicked: TColor;
begin
  Result := FRenderer.LinkColorClicked;
end;

function TJvCustomLinkLabel.GetLinkColorHot: TColor;
begin
  Result := FRenderer.LinkColorHot;
end;

function TJvCustomLinkLabel.GetLinkStyle: TFontStyles;
begin
  Result := FRenderer.LinkStyle;
end;

function TJvCustomLinkLabel.GetTransparent: Boolean;
begin
  Result := not (csOpaque in ControlStyle);
end;

procedure TJvCustomLinkLabel.HandleDynamicNode(out Source: UnicodeString;
  const Node: TDynamicNode);
begin
  if Assigned(Node) then
    DoDynamicTagInit(Source, Node.Number);
end;

function TJvCustomLinkLabel.IsActiveLinkNodeClicked: Boolean;
begin
  Result := Assigned(FActiveLinkNode);
  if Result then
    Result := FActiveLinkNode.State = lsClicked;
end;

procedure TJvCustomLinkLabel.Loaded;
begin
  inherited Loaded;
  FOriginalCursor := Cursor;
  // Resize;
end;

procedure TJvCustomLinkLabel.MouseDown(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
  inherited MouseDown(Button, Shift, X, Y);
  ActivateLinkNodeAtPos(Point(X, Y), lsClicked);
end;

procedure TJvCustomLinkLabel.MouseMove(Shift: TShiftState; X, Y: Integer);
var
  Pt: TPoint;  // Bianconi #2
begin
  inherited MouseMove(Shift, X, Y);

  // Bianconi #2
  Pt := Point(X - FNodeTree.Root.StartingPoint.X,Y - FNodeTree.Root.StartingPoint.Y);

  if FNodeTree.IsPointInNodeClass(Pt, TLinkNode) then
  begin
    Cursor := LinkCursor;
    if FHotLinks and not IsActiveLinkNodeClicked then
      ActivateLinkNodeAtPos(Point(X, Y), lsHot);
  end
  else
  begin
    Cursor := FOriginalCursor;
    if FHotLinks and not IsActiveLinkNodeClicked then
      DeactivateActiveLinkNode;
  end;
end;

procedure TJvCustomLinkLabel.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var
  NodeAtPoint: TLinkNode;
  Pt: TPoint;  // Bianconi #2
begin
  inherited MouseUp(Button, Shift, X, Y);

  // Bianconi #2
  Pt := Point(X - FNodeTree.Root.StartingPoint.X,Y - FNodeTree.Root.StartingPoint.Y);

  if FNodeTree.IsPointInNodeClass(Pt, TLinkNode) then
  begin
    NodeAtPoint := FNodeTree.GetNodeAtPointOfClass(Pt, TLinkNode) as TLinkNode;
    if Assigned(NodeAtPoint) then
      DoLinkClicked(NodeAtPoint.Number, NodeAtPoint.Text, NodeAtPoint.Param);  // added LinkParam by Cetkovsky
  end;

  DeactivateActiveLinkNode;
end;

// Arvid Winkelsdorf, Bianconi
procedure TJvCustomLinkLabel.Paint;
var
  TmpRect: TRect;

	procedure DrawTransparent(Control: TControl; Canvas: TCanvas);
	var
	  Position: TPoint;
	  DC: HDC;
	  SaveIndex: Integer;
	begin
	  with Control do
	  begin
	    if Parent = nil then
	      Exit;
	    DC := Canvas.Handle;
	    SaveIndex := SaveDC(DC);
	    try
	      GetViewportOrgEx(DC, Position);
	      SetViewportOrgEx(DC, Position.X - Left, Position.Y - Top, nil);
	      IntersectClipRect(DC, 0, 0, Parent.ClientWidth, Parent.ClientHeight);
	      Parent.Perform(WM_ERASEBKGND, Integer(DC), 0);
	      Parent.Perform(WM_PAINT, Integer(DC), 0);
	    finally
	      RestoreDC(DC, SaveIndex);
	    end;
	  end;
	end;

begin
  if Assigned(FNodeTree) then
  begin
    Canvas.Font.Assign(Font);
    TmpRect := ClientRect;

    if not Transparent then
    begin
      // repaint Canvas
      Canvas.Brush.Color := Color;
      Canvas.Brush.Style := bsSolid;
      Canvas.FillRect(TmpRect);
    end;

    Canvas.Brush.Style := bsClear;

    // only when class descendant of TCustomControl:
    if Transparent then
      DrawTransparent(Self, Canvas);

    // Set new start point relative to temporary Canvas, Left & Top corner
    FNodeTree.Root.StartingPoint := Point(0,0);  // Bianconi #2
    FRenderer.RenderTree(Canvas, TmpRect, FNodeTree);

    //  Set new height and don't draw in this pass.
    //  Wait for next paint event.
    //  Allow correctly layout position and improve some performance
    if FAutoHeight and
      (Align in [alNone, alTop, alBottom]) and
      (ClientHeight <> (FRenderer.GetTextHeight + (FMarginHeight shl 1)) ) then
      ClientHeight := FRenderer.GetTextHeight + (FMarginHeight shl 1)
    else
    begin
      TmpRect := ClientRect;
      InflateRect(TmpRect,-FMarginWidth,-FMarginHeight);
      // Adjust Root start point relative to control's canvas.
      FNodeTree.Root.StartingPoint := Point(TmpRect.Left, TmpRect.Top);  // Bianconi #2
      // VisualCLX: most be done after the bitmap is drawn.
    end;
  end;
end;

procedure TJvCustomLinkLabel.Resize;
begin
  inherited Resize;
// Bianconi -> ClientRect.Bottom - FMarginHeight
// MarginHeight is applied on Top and Bottom values, exactly as MarginWidth
//  FRect := Rect(ClientRect.Left + FMarginWidth, ClientRect.Top + FMarginHeight,
//    ClientRect.Right - FMarginWidth, ClientRect.Bottom - FMarginHeight);
// end of Bianconi
end;

procedure TJvCustomLinkLabel.SetAutoHeight(const Value: Boolean);
begin
  if FAutoHeight <> Value then
  begin
    FAutoHeight := Value;
    Invalidate;
  end;
end;

procedure TJvCustomLinkLabel.SetText(const Value: UnicodeString);

  function ReplaceHTMLLineBreaks(const AString: UnicodeString): UnicodeString;
  begin
    // replaces linebreaks
    Result := LinkLabelStringReplace(AString, '<br/>', '<br>', [rfReplaceAll, rfIgnoreCase]);
    Result := LinkLabelStringReplace(Result, sLineBreak, '<br>', [rfReplaceAll, rfIgnoreCase]);
  end;

  function ReplaceEntities(const AString: UnicodeString): UnicodeString;
  var
    s: UnicodeString;
  begin
    s := AString;
    if Pos('&', s) > 0 then
    begin
      s := LinkLabelStringReplace(s, '&amp;', '&&', [rfIgnoreCase, rfReplaceAll]);
      s := LinkLabelStringReplace(s, '&quot;', '"', [rfIgnoreCase, rfReplaceAll]);
      s := LinkLabelStringReplace(s, '&sect;', '$', [rfIgnoreCase, rfReplaceAll]);
      s := LinkLabelStringReplace(s, '&permil;', '‰', [rfIgnoreCase, rfReplaceAll]);
      s := LinkLabelStringReplace(s, '&reg;', '®', [rfIgnoreCase, rfReplaceAll]);
      s := LinkLabelStringReplace(s, '&copy;', '©', [rfIgnoreCase, rfReplaceAll]);
      s := LinkLabelStringReplace(s, '&para;', '¶', [rfIgnoreCase, rfReplaceAll]);
      s := LinkLabelStringReplace(s, '&trade;', '™', [rfIgnoreCase, rfReplaceAll]);
      s := LinkLabelStringReplace(s, '&euro;', '€', [rfIgnoreCase, rfReplaceAll]);
    end;
    Result := s;
  end;
  
begin
  if Value <> FCaption then
  begin
    Text.Clear;
    FCaption := ReplaceHTMLLineBreaks(ReplaceEntities(Value));    
    Text.Add(FCaption);

    FActiveLinkNode := nil; // We're about to free the tree containing the node it's pointing to
    FNodeTree.Free;
    ResetNodeCount;
    FNodeTree := FParser.Parse(FCaption);
    SynchronizeRootAndFont;
    Invalidate;
    DoCaptionChanged;
  end;
end;

procedure TJvCustomLinkLabel.SetLinkColor(const Value: TColor);
begin
  if Value <> GetLinkColor then
  begin
    FRenderer.LinkColor := Value;
    Invalidate;
  end;
end;

procedure TJvCustomLinkLabel.SetLinkColorClicked(const Value: TColor);
begin
  if Value <> GetLinkColorClicked then
    FRenderer.LinkColorClicked := Value;
end;

procedure TJvCustomLinkLabel.SetLinkColorHot(const Value: TColor);
begin
  FRenderer.LinkColorHot := Value;
end;

procedure TJvCustomLinkLabel.SetLinkStyle(const Value: TFontStyles);
begin
  if Value <> GetLinkStyle then
  begin
    FRenderer.LinkStyle := Value;
    Invalidate;
  end;
end;

// Bianconi
function TJvCustomLinkLabel.GetLinkCursor: TCursor;
begin
  Result := FLinkCursor;
end;

// Bianconi
procedure TJvCustomLinkLabel.SetLinkCursor(AValue: TCursor);
begin
  FLinkCursor := AValue;
end;

procedure TJvCustomLinkLabel.SetMarginHeight(const Value: Integer);
begin
  if FMarginHeight <> Value then
  begin
    FMarginHeight := Value;
    Resize;
    Invalidate;
  end;
end;

procedure TJvCustomLinkLabel.SetMarginWidth(const Value: Integer);
begin
  if FMarginWidth <> Value then
  begin
    FMarginWidth := Value;
    Resize;
    Invalidate;
  end;
end;

function TJvCustomLinkLabel.GetStrings: TLinkLabelStrings;
begin
  Result := FText;
end;

procedure TJvCustomLinkLabel.SetStrings(const Value: TLinkLabelStrings);
begin
  FText.Assign(Value);
  SetText(FText.Text);
end;

procedure TJvCustomLinkLabel.SetTransparent(const Value: Boolean);
begin
  if Transparent <> Value then
  begin
    if Value then
      ControlStyle := ControlStyle - [csOpaque]
    else
      ControlStyle := ControlStyle + [csOpaque];
    Invalidate;
  end;
end;

procedure TJvCustomLinkLabel.SynchronizeRootAndFont;
begin
  if Assigned(FNodeTree) then
    with FNodeTree.Root do
    begin
      Styles := Font.Style;
      Color := Font.Color;
    end;
end;

procedure TJvCustomLinkLabel.UpdateDynamicTag(Number: Integer;
  const Source: UnicodeString);
var
  NodeEnum: INodeEnumerator;
  Parser: IParser;
  CurrentNode: TDynamicNode;
begin
  NodeEnum := FNodeTree.GetTopLevelNodeEnumerator(TDynamicNode);
  while NodeEnum.HasNext do
  begin
    CurrentNode := NodeEnum.GetNext as TDynamicNode;
    if CurrentNode.Number = Number then
    begin
      Parser := CreateParser;
      CurrentNode.DestroyChildren;
      Parser.AddSourceTreeToDynamicNode(CurrentNode, Source);
      Repaint;
      Exit;
    end;
  end;

  raise ELinkLabelError.CreateRes(@RsETagNotFound);
end;

end.