jvlinklabeltexthandler.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: TextHandler.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): ______________________________________.

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:
  This unit, and its supporting types and classes, exist for the sole purpose of
  supporting words broken into different nodes in the tree. These strings are
  rendered correctly, but they are unfortunattreated as different words when
  the time comes to do word-wrapping. This means that one substring of a word
  gets placed on one row, and the others on different rows. Consider this word:

  <B>Te</B>st

  In this case, "Te" would be placed on the first row while "st" would be placed
  on the second row, if we were short on space. The first TJvLinkLabel engine
  did not support this at all, while the second engine supported it most of the
  time, although using a hack.

  One could argue that few would ever want to have something like the above
  rendered, but all current browsers support it, and it _is_ used on the
  Internet to achieve special formatting. The syntax clearly supports words
  with characters styled differently; if the engine didn't support this, it
  would be a technical shortcoming.

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

unit JvLinkLabelTextHandler;

{$I jvcl.inc}

interface

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

type
  ETextHandlerError = class(EJVCLException);

  IStartingPosObserver = interface
    procedure StartingPosUpdated(PosX, PosY: Integer; const Node: TAreaNode);
  end;

  ITextHandler = interface
    function GetPosX: Integer;
    function GetPosY: Integer;
    function GetLineHeight: Integer;
    function GetCanvas: TCanvas;

    procedure TextOut(Node: TStringNode; Style: TFontStyles; Color: TColor);
    procedure DoParagraphBreak;
    procedure DoLineBreak;
    procedure EmptyBuffer;
    function GetTextHeight: Integer;
    function IsPosCurrent: Boolean;
    procedure AddStartingPosObserver(Observer: IStartingPosObserver;
      Node: TAreaNode);

    property PosX: Integer read GetPosX;
    property PosY: Integer read GetPosY;
    property LineHeight: Integer read GetLineHeight;
    property Canvas: TCanvas read GetCanvas;
  end;

  TTextElementList = class;
  TNodeObserverList = class;
  TTextHandler = class(TInterfacedObject, ITextHandler)
  private
    FPosX: Integer;
    FPosY: Integer;
    FList: TTextElementList;
    FRect: TRect;
    FCanvas: TCanvas;
    FLineHeight: Integer;
    FObservers: TNodeObserverList;
    function GetPosX: Integer;
    function GetPosY: Integer;
    function GetLineHeight: Integer;
    function GetCanvas: TCanvas;
  public
    constructor Create(const Rect: TRect; InitialX, InitialY: Integer;
      const Canvas: TCanvas);
    destructor Destroy; override;
    procedure TextOut(Node: TStringNode; Style: TFontStyles; Color: TColor);
    procedure DoParagraphBreak;
    procedure DoLineBreak;
    procedure EmptyBuffer;
    function GetTextHeight: Integer;
    function IsPosCurrent: Boolean;
    procedure AddStartingPosObserver(Observer: IStartingPosObserver;
      Node: TAreaNode);
  end;

  TParentTextElement = class(TObject)
  end;

  TStringElement = class(TParentTextElement)
  private
    FNode: TStringNode;
    FStyle: TFontStyles;
    FColor: TColor;
  public
    constructor Create(const Node: TStringNode; Style: TFontStyles; Color: TColor);
    function BeginsWithSpace: Boolean;
    function EndsWithSpace: Boolean;
    property Node: TStringNode read FNode;
    property Style: TFontStyles read FStyle;
    property Color: TColor read FColor;
  end;

  TActionElement = class(TParentTextElement)
  private
    FActionType: TActionType;
  public
    constructor Create(ActionType: TActionType);
    property ActionType: TActionType read FActionType;
  end;

  TTextElementList = class(TObject)
  private
    FList: TList;
    function Get(Index: Integer): TParentTextElement;
    function GetCount: Integer;
  protected
    procedure Clear;
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddStringElement(const Node: TStringNode; Style: TFontStyles; Color: TColor);
    procedure AddParagraphBreak;
    procedure AddLineBreak;
    property Items[Index: Integer]: TParentTextElement read Get; default;
    property Count: Integer read GetCount;
  end;

  PNodeObserver = ^TNodeObserver;
  TNodeObserver = record
    Observer: IStartingPosObserver;
    ParentNode: TAreaNode;
    FirstStringNode: TStringNode;
  end;

  TNodeObserverList = class(TOwnerPointerList)
  private
    function Get(Index: Integer): PNodeObserver;
    procedure Put(Index: Integer; const Value: PNodeObserver);
  public
    procedure AddObserver(Observer: IStartingPosObserver; ParentNode: TAreaNode;
      FirstStringNode: TStringNode);
    procedure RemoveObserver(Item: PNodeObserver);
    function IndexOfStringNode(Node: TStringNode): Integer;
    property Items[Index: Integer]: PNodeObserver read Get write Put; default;
  end;

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

implementation

uses
  JvResources;

//=== { TWordEnumerator } ====================================================

const
  Space = ' ';

type
  IWordEnumerator = interface
    procedure SetText(const Text: string);
    function GetText: string;
    function GetCount: Integer;

    function PopNext: string;
    function PeekNext: string;
    function HasNext: Boolean;
    procedure Reset;
    property Text: string read GetText write SetText;
    property Count: Integer read GetCount;
  end;

  TWordEnumerator = class(TInterfacedObject, IWordEnumerator)
  private
    FPos: Integer;
    FText: string;
    FCount: Integer;
    procedure SetText(const Text: string);
    function GetText: string;
    function GetNext(const IncrementPos: Boolean): string;
    function GetCount: Integer;
  public
    constructor Create(const Text: string);
    function PopNext: string;
    function PeekNext: string;
    function HasNext: Boolean;
    procedure Reset;
  end;

constructor TWordEnumerator.Create(const Text: string);
begin
  inherited Create;
  Reset;
  SetText(Text);
end;

function TWordEnumerator.GetCount: Integer;
begin
  Result := FCount;
end;

function TWordEnumerator.GetNext(const IncrementPos: Boolean): string;
var
  StartPos: Integer;
  EndPos: Integer;
begin
  if not HasNext then
    raise ETextHandlerError.CreateRes(@RsENoMoreWords);

  StartPos := FPos;
  EndPos := FPos;
  while (EndPos <= Length(FText)) and (FText[EndPos] <> Space) do
    Inc(EndPos);
  Inc(EndPos);
  Result := Copy(FText, StartPos, EndPos - StartPos);

  if IncrementPos then
  begin
    FPos := EndPos;
    Inc(FCount);
  end;
end;

function TWordEnumerator.GetText: string;
begin
  Result := FText;
end;

function TWordEnumerator.HasNext: Boolean;
begin
  Result := FPos <= Length(FText);
end;

function TWordEnumerator.PeekNext: string;
begin
  Result := GetNext(False);
end;

function TWordEnumerator.PopNext: string;
begin
  Result := GetNext(True);
end;

procedure TWordEnumerator.Reset;
begin
  FPos := 1;
  FCount := 0;
end;

procedure TWordEnumerator.SetText(const Text: string);
begin
  FText := Text;
  FCount := 0;
end;

//=== { TTextElementList } ===================================================

constructor TTextElementList.Create;
begin
  inherited Create;
  FList := TList.Create;
end;

destructor TTextElementList.Destroy;
begin
  Clear;
  FList.Free;
  inherited Destroy;
end;

procedure TTextElementList.AddLineBreak;
begin
  FList.Add(TActionElement.Create(atLineBreak));
end;

procedure TTextElementList.AddParagraphBreak;
begin
  FList.Add(TActionElement.Create(atParagraphBreak));
end;

procedure TTextElementList.AddStringElement(const Node: TStringNode;
  Style: TFontStyles; Color: TColor);
begin
  FList.Add(TStringElement.Create(Node, Style, Color));
end;

procedure TTextElementList.Clear;
var
  I: Integer;
begin
  for I := 0 to FList.Count - 1 do
    Get(I).Free;
  FList.Clear;
end;

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

function TTextElementList.GetCount: Integer;
begin
  Result := FList.Count;
end;

//=== { TTextHandler } =======================================================

constructor TTextHandler.Create(const Rect: TRect; InitialX, InitialY: Integer;
  const Canvas: TCanvas);
var
  TempFontStyle: TFontStyles;
const
  // (rom) i have seen other letter combinations elsewhere
  // Bianconi #2
  // MaximumHeightString = 'fg';
  MaximumHeightString = 'Yy';
begin
  inherited Create;
  FRect := Rect;
  FPosX := InitialX;
  FPosY := InitialY;
  FCanvas := Canvas;

  { TextHeight returns slightly different values depending on whether fsBold is
    in Canvas.Font.Style. This is not acceptable, as it's important that
    FLineHeight stays constant between TTextHandler instances. Thus we set
    Canvas.Font.Style to [] before calculating the line height. }
  TempFontStyle := Canvas.Font.Style;
  Canvas.Font.Style := [];
  try
    FLineHeight := Canvas.TextHeight(MaximumHeightString);
  finally
    Canvas.Font.Style := TempFontStyle;
  end;

  FList := TTextElementList.Create;
  FObservers := TNodeObserverList.Create;
end;

destructor TTextHandler.Destroy;
begin
  FObservers.Free;
  FList.Free;
  inherited Destroy;
end;