{ ------------------------------------------------------------- }
{ Purpose : Next Standard 6                                     }
{ By      : Bojan Nikolic                                       }
{ For     : BergSoft                                            }
{ ------------------------------------------------------------- }
{ Copyright (C) BergSoft.net 2019. All Rights Reserved.         }
{ ------------------------------------------------------------- }
{$I NxSuite6.inc}

unit NxHTML6;

interface

uses
  { Standard }
  Classes, Types, Messages, Windows, Graphics,
  {$IFDEF UI_TYPES}UITypes,{$ENDIF}
  { Controls }
  Controls, StdCtrls, ExtCtrls, Forms, ImgList, WinInet,
  { Next Standard 6 }
  NxTypes6, NxClasses6, NxConsts6, NxGraphics6, NxEdit6;

type
  TNxStylesSheet6 = class;

  INxHTML = interface
    ['{DBB3FA83-A00E-4D38-865A-CD87947658CC}']
    procedure DoLinkClick(Href: WideString);
    function GetStylesSheet: TNxStylesSheet6;
    procedure SetStylesSheet(const Value: TNxStylesSheet6);
    property StylesSheet: TNxStylesSheet6 read GetStylesSheet write SetStylesSheet;
  end;

  PNxCSSStyle = ^TNxCSSStyle;
  TNxCSSStyle = record
    BackgroundColor: TColor;
    Color: TColor;
    Display: TNxDisplay;
    FontFamily: WideString;
    FontSize: TNxFontSize;
    FontStyle: TNxFontStyle;
    FontWeight: TNxFontWeight;
    PositionX: string;
    PositionY: string;
    Size: TSize;
    TextAlign: TNxTextAlign;
    TextDecoration: TNxTextDecoration;
    TextTransform: TNxTextTransform;
    VerticalAlign: TNxVerticalAlign;
  end;

  PNxTagParam = ^TNxTagParam;
  TNxTagParam = record
    Name: string;
    Next: PNxTagParam;
    Previous: PNxTagParam;
    Value: WideString;
  end;

  TNxHTMLTag = record
    Params: PNxTagParam;
    Kind: TNxTagKind;
  end;

  PNxStackItem = ^TNxStackItem;
  TNxStackItem = record
    Tag: TNxHTMLTag;
    Content: WideString;
    Next: PNxStackItem;
    Position: TPoint;
    Size: TSize;
    Snapshot: TNxCanvasSnapshot;
    Url: WideString;
  end;

  { TNxPaintStyle6 }

  TNxPaintStyle6 = class(TPersistent)
  private
    FBackgroundColor: TColor;
    FColor: TColor;
    FFontSize: Integer;
    FOnChange: TNotifyEvent;
    FTextDecoration: TNxTextDecoration;
    FTextTransform: TNxTextTransform;
    { Property Accessors }
    procedure SetBackgroundColor(const Value: TColor);
    procedure SetColor(const Value: TColor);
    procedure SetFontSize(const Value: Integer);
    procedure SetTextDecoration(const Value: TNxTextDecoration);
    procedure SetTextTransform(const Value: TNxTextTransform);
  protected
    procedure DoChange;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    class function TransformText(S: WideString; Value: TNxTextTransform): WideString;

    procedure Decorate(Font: TFont);
    procedure FillRect(Canvas: TCanvas; const Rect: TRect);
    function HasBackground: Boolean;
  published
    { Properties }
    property BackgroundColor: TColor read FBackgroundColor write SetBackgroundColor;
    property Color: TColor read FColor write SetColor;
    property FontSize: Integer read FFontSize write SetFontSize;
    property TextDecoration: TNxTextDecoration read FTextDecoration write SetTextDecoration default tdNone;
    property TextTransform: TNxTextTransform read FTextTransform write SetTextTransform default ttNone;
    { Events }
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  { TNxCSSRule }

  TNxSelectorKind = (skID, skTag, skClass);

  TNxCSSRule = class(TCollectionItem)
  private
    { Property Fields }
    FBackgroundColor: string;
    FColor: string;
    FFontFamily: WideString;
    FFontSize: TNxFontSize;
    FFontStyle: TNxFontStyle;
    FFontWeight: TNxFontWeight;
    FName: WideString;
    FSelector: TNxSelectorKind;
    FTextAlign: TNxTextAlign;
    FTextDecoration: TNxTextDecoration;
    { Property Accessors }
    procedure SetFontFamily(const Value: WideString);
  public
    constructor Create(Collection: TCollection); override;
    { Methods }
    procedure AssignToStyle(var Dest: TNxCSSStyle);
  published
    { Properties }
    property BackgroundColor: string read FBackgroundColor write FBackgroundColor;
    property Color: string read FColor write FColor;
    property FontFamily: WideString read FFontFamily write SetFontFamily;
    property FontSize: TNxFontSize read FFontSize write FFontSize;
    property FontStyle: TNxFontStyle read FFontStyle write FFontStyle default fyInherit;
    property FontWeight: TNxFontWeight read FFontWeight write FFontWeight default fwInherit;
    property Name: WideString read FName write FName;
    property Selector: TNxSelectorKind read FSelector write FSelector default skTag;
    property TextAlign: TNxTextAlign read FTextAlign write FTextAlign default taInherit;
    property TextDecoration: TNxTextDecoration read FTextDecoration write FTextDecoration default tdInherit;
  end;

  { TNxCSSRules }

  TNxCSSRules = class(TCollection)
  private
    FOwner: TPersistent;
    function GetItem(Index: Integer): TNxCSSRule;
    procedure SetItem(Index: Integer; const Value: TNxCSSRule);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TPersistent);
    { Methods }
    function Add: TNxCSSRule;
    property Items[Index: Integer]: TNxCSSRule read GetItem write SetItem; default;
  end;

  { TNxStylesSheet6 }

  TNxStylesSheet6 = class(TComponent)
  private
    FRules: TNxCSSRules;
    { Property Accessors }
    function GetParam(Tag: TNxHTMLTag; Kind: TNxParamKind): WideString;
    procedure SetRules(const Value: TNxCSSRules);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AssignStyle(Tag: TNxHTMLTag; var Style: TNxCSSStyle);
    { Properties }
    property Param[Tag: TNxHTMLTag; Kind: TNxParamKind]: WideString read GetParam;
  published
    property Rules: TNxCSSRules read FRules write SetRules;
  end;

  TNxTagParsingState = (psContent,
    psTagOpening,
    psTagClosing,
    psParamReading);

  TNxParamParsingState = (psNameReading,
    psValueReading);

  { TNxHTMLView }

  TNxLinkHitEvent = procedure (Sender: TObject; Href: WideString) of object;

  TNxProcHTMLOperation = set of (hoPaint, hoCalc, hoHitTest);

  TNxHTMLView = class
  private
    FBestSize: TSize;
    FCanvas: TCanvas;
    FDefaultStyle: TNxCSSStyle;
    FHitHref: WideString;
    FHitLocation: TPoint;
    FHTML: WideString;
    FImages: TImageList;
    FListBox: TListBox;
    FOnLinkHit: TNxLinkHitEvent;
    FOperation: TNxProcHTMLOperation;
    FStyleSheet: TNxStylesSheet6;
    { Property Accessors }
    function GetParam(Tag: TNxHTMLTag; Kind: TNxParamKind): WideString;
    function GetStyle(Tag: TNxHTMLTag): TNxCSSStyle;
    procedure SetStyleSheet(const Value: TNxStylesSheet6);
    procedure SetHTML(const Value: WideString);
  protected
    function CanHaveChildren(TagKind: TNxTagKind): Boolean;
    { Event Handlers }
    procedure DoLinkHit(Href: WideString); dynamic;
    { Paint }
    procedure PaintImage(Canvas: TCanvas; ImageRect: TRect; Src: WideString);
    procedure PaintText(Canvas: TCanvas; TextRect: TRect; Text: WideString);
  public
    constructor Create;
    destructor Destroy; override;
    procedure PaintTo(Canvas: TCanvas; Dest: TRect);
    { Properties }
    property BestSize: TSize read FBestSize;
    property DefaultStyle: TNxCSSStyle read FDefaultStyle write FDefaultStyle;
    property HitLocation: TPoint read FHitLocation write FHitLocation;
    property HitHref: WideString read FHitHref;
    property HTML: WideString read FHTML write SetHTML;
    property Images: TImageList read FImages write FImages;
    property Operation: TNxProcHTMLOperation read FOperation write FOperation;
    property Param[Tag: TNxHTMLTag; Kind: TNxParamKind]: WideString read GetParam;
    property Style[Tag: TNxHTMLTag]: TNxCSSStyle read GetStyle;
    property StyleSheet: TNxStylesSheet6 read FStyleSheet write SetStyleSheet;
    property ListBox: TListBox read FListBox write FListBox;
    { Events }
    property OnLinkHit: TNxLinkHitEvent read FOnLinkHit write FOnLinkHit;
  end;

  function AlignmentToTextAlign(Value: TAlignment): TNxTextAlign;

  function FontSizeToInt(Value: TNxFontSize; Size: Integer): Integer;
  function SizeToPixels(Value: string; LineHeight: Integer): Integer;
  function ParamToStr(Value: TNxParamKind): string;
  function TagToStr(Value: TNxTagKind): string;

  function StrToParam(const Value: string): TNxParamKind;
  function StrToTag(const Value: string): TNxTagKind;
  function StrToTextAlign(const Value: string): TNxTextAlign;

implementation

uses
  { Standard }
  SysUtils, StrUtils, TypInfo, Dialogs, Math,
  { Next Standard 6 }
  NxTypInfo6;

function AlignmentToTextAlign(Value: TAlignment): TNxTextAlign;
begin
  case Value of
    taLeftJustify: Result := taLeft;
    taRightJustify: Result := taRight;
    else Result := taCenter;
  end;
end;

function FontSizeToInt(Value: TNxFontSize; Size: Integer): Integer;
begin
  if Value = EmptyStr then Result := Size
  else Result := StrToIntDef(Value, 0);
end;

function SizeToPixels(Value: string; LineHeight: Integer): Integer;
var
  RealValue: string;
begin
  { Default }
  Result := 0;
  if Value <> '' then
  begin
    if Pos('%', Value) <> -1 then
    begin
      RealValue := LeftStr(Value, Pos('%', Value) - 1);

      Result := Round(LineHeight * (StrToIntDef(RealValue, 0) / 100));
    end;
    if Pos('em', Value) <> -1 then
    begin

    end;
    if Pos('px', Value) <> -1 then
    begin

    end;
  end;
end;

function ParamToStr(Value: TNxParamKind): string;
begin
  case Value of
    tpClass: Result := 'class';
    tpId: Result := 'id';
    tpAlign: Result := 'align';
    tpHref: Result := 'href';
  end;
end;

function TagToStr(Value: TNxTagKind): string;
begin
  case Value of
    tgA: Result := 'a';
    tgB: Result := 'b';
    tgBr: Result := 'br';
    tgDiv: Result := 'div';
    tgEm: Result := 'em';
    tgH1: Result := 'h1';
    tgH2: Result := 'h2';
    tgH3: Result := 'h3';
    tgHtml: Result := 'html';
    tgI: Result := 'i';
    tgImg: Result := 'img';
    tgP: Result := 'p';
    tgS: Result := 's';
    tgSpan: Result := 'span';
    tgStrong: Result := 'strong';
    tgSub: Result := 'sub';
    tgSup: Result := 'sup';
    tgU: Result := 'u';
  end;
end;

function StrToParam(const Value: string): TNxParamKind;
var
  S: WideString;
begin
  S := LowerCase(Value);
  if S = 'class' then Result := tpClass
  else if S = 'id' then Result := tpId
  else if S = 'align' then Result := tpAlign
  else if S = 'href' then Result := tpHref
  else Result := tpUndefined;
end;

function StrToTag(const Value: string): TNxTagKind;
var
  S: WideString;
begin
  S := LowerCase(Value);
  if S = 'a' then Result := tgA
  else if S = 'br' then Result := tgBr
  else if S = 'div' then Result := tgDiv
  else if S = 'em' then Result := tgEm
  else if S = 'h1' then Result := tgH1
  else if S = 'h2' then Result := tgH2
  else if S = 'h3' then Result := tgH3
  else if S = 'img' then Result := tgImg
  else if S = 'p' then Result := tgP
  else if S = 's' then Result := tgS
  else if S = 'span' then Result := tgSpan
  else if S = 'strong' then Result := tgStrong
  else if S = 'sub' then Result := tgSub
  else if S = 'sup' then Result := tgSup
  else if S = 'b' then Result := tgB
  else if S = 'i' then Result := tgI
  else if S = 'u' then Result := tgU
  else Result := tgUndefined;
end;

function StrToTextAlign(const Value: string): TNxTextAlign;
var
  S: WideString;
begin
  S := LowerCase(Value);
  if S = 'left' then Result := taLeft
  else if S = 'center' then Result := taCenter
  else if S = 'right' then Result := taRight
  else Result := taInherit;
end;

procedure AddParam(Tag: TNxHTMLTag; Param: PNxTagParam);
begin
  if Tag.Params <> nil then
  begin
    Param^.Previous := Tag.Params;
  end;

  Tag.Params := Param;
end;

function CreateParam(Param: TNxParamKind): PNxTagParam;
begin
  New(Result);

  Result^.Name := EmptyStr;
  Result^.Value := EmptyStr;
  Result^.Next := nil;
  Result^.Previous := nil;
end;

procedure DisposeParams(Param: PNxTagParam);
var
  T: PNxTagParam;
begin
  while Param <> nil do
  begin
    T := Param;

    Param := Param.Previous;

    Dispose(T);
  end;
end;

{ TNxPaintStyle6 }

constructor TNxPaintStyle6.Create;
begin
  FBackgroundColor := clNone;
  FColor := clNone;
  FFontSize := 8;
  FTextDecoration := tdNone;
  FTextTransform := ttNone;
end;

procedure TNxPaintStyle6.Decorate(Font: TFont);
begin
  Font.Style := [];

  if FTextDecoration = tdUnderline then Font.Style := Font.Style + [fsUnderline];
  if FTextDecoration = tdLineTrough then Font.Style := Font.Style + [fsStrikeOut];

  if FFontSize <> 0 then Font.Size := FFontSize;
  if FColor <> clNone then Font.Color := FColor;
end;

destructor TNxPaintStyle6.Destroy;
begin
  inherited;
end;

procedure TNxPaintStyle6.DoChange;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TNxPaintStyle6.FillRect(Canvas: TCanvas; const Rect: TRect);
begin
  if BackgroundColor <> clNone then
  begin
    Canvas.Brush.Color := BackgroundColor;
    Canvas.FillRect(Rect);
  end;
end;

function TNxPaintStyle6.HasBackground: Boolean;
begin
  Result := BackgroundColor <> clNone;
end;

procedure TNxPaintStyle6.SetBackgroundColor(const Value: TColor);
begin
  if Value <> FBackgroundColor then
  begin
    FBackgroundColor := Value;
    DoChange;
  end;
end;

procedure TNxPaintStyle6.SetColor(const Value: TColor);
begin
  if Value <> FColor then
  begin
    FColor := Value;
    DoChange;
  end;
end;

procedure TNxPaintStyle6.SetFontSize(const Value: Integer);
begin
  if Value <> FFontSize then
  begin
    FFontSize := Value;
    DoChange;
  end;
end;

procedure TNxPaintStyle6.SetTextDecoration(const Value: TNxTextDecoration);
begin
  if Value <> FTextDecoration then
  begin
    FTextDecoration := Value;
    DoChange;
  end;
end;

procedure TNxPaintStyle6.SetTextTransform(const Value: TNxTextTransform);
begin
  if Value <> FTextTransform then
  begin
    FTextTransform := Value;
    DoChange;
  end;
end;

class function TNxPaintStyle6.TransformText(S: WideString;
  Value: TNxTextTransform): WideString;
begin
  case Value of
    ttNone: Result := S;
    ttUpperCase: Result := UpperCase(S);
    ttLowerCase: Result := LowerCase(S);
    ttCapitalize: if Length(S) > 0 then Result := UpperCase(S[1]);
  end;
end;

{ TNxCSSRule }

procedure TNxCSSRule.AssignToStyle(var Dest: TNxCSSStyle);
begin
  Dest.BackgroundColor := StrToColor(BackgroundColor);
  Dest.Color := StrToColor(Color);
  Dest.FontFamily := FontFamily;
  Dest.FontSize := FontSize;
  Dest.FontStyle := FontStyle;
  Dest.FontWeight := FontWeight;
  Dest.TextAlign := TextAlign;
  Dest.TextDecoration := TextDecoration;
end;

constructor TNxCSSRule.Create(Collection: TCollection);
begin
  inherited;
  FBackgroundColor := EmptyStr;
  FColor := '';
  FFontFamily := '';
  FFontSize := '';
  FFontStyle := fyInherit;
  FFontWeight := fwInherit;
  FSelector := skTag;
  FTextAlign := taInherit;
  FTextDecoration := tdInherit;
end;

procedure TNxCSSRule.SetFontFamily(const Value: WideString);
begin
  if Value <> FFontFamily then
  begin
    FFontFamily := Value;
    { TODO: Notify }
  end;
end;

{ TNxCSSRules }

function TNxCSSRules.Add: TNxCSSRule;
begin
  Result := TNxCSSRule(inherited Add);
end;

constructor TNxCSSRules.Create(AOwner: TPersistent);
begin
  inherited Create(TNxCSSRule);
  FOwner := AOwner;
end;

function TNxCSSRules.GetItem(Index: Integer): TNxCSSRule;
begin
  Result := TNxCSSRule(inherited GetItem(Index));
end;

function TNxCSSRules.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

procedure TNxCSSRules.SetItem(Index: Integer; const Value: TNxCSSRule);
begin
  inherited SetItem(Index, Value);
end;

{ TNxStylesSheet6 }

procedure TNxStylesSheet6.AssignStyle(Tag: TNxHTMLTag; var Style: TNxCSSStyle);
var
  i: Integer;
begin
  for i := 0 to Pred(Rules.Count) do
  begin
    if Rules[i].Name <> '' then
    begin
      case Rules[i].Selector of
        skID:
          if Rules[i].Name = Param[Tag, tpId] then
          begin
            Rules[i].AssignToStyle(Style);
          end;
        skTag:
          if StrToTag(Rules[i].Name) = Tag.Kind then
          begin
            Rules[i].AssignToStyle(Style);
          end;
        skClass:
          if Rules[i].Name = Param[Tag, tpClass] then
          begin
            Rules[i].AssignToStyle(Style);
          end;
      end;
    end;
  end;
end;

constructor TNxStylesSheet6.Create(AOwner: TComponent);
begin
  inherited;
  FRules := TNxCSSRules.Create(Self);
end;

destructor TNxStylesSheet6.Destroy;
begin
  FRules.Free;
  inherited;
end;

function TNxStylesSheet6.GetParam(Tag: TNxHTMLTag; Kind: TNxParamKind): WideString;
var
  P: PNxTagParam;
begin
  P := Tag.Params;
  while P <> nil do
  begin
    if StrToParam(P^.Name) = Kind then
    begin
      Result := P^.Value;
      Exit;
    end;
    P := P.Previous;
  end;
end;

procedure TNxStylesSheet6.SetRules(const Value: TNxCSSRules);
begin
  FRules.Assign(Value);
end;

{ TNxHTMLView }

function TNxHTMLView.CanHaveChildren(TagKind: TNxTagKind): Boolean;
begin
  case TagKind of
    tgBr, tgImg: Result := False;
    else Result := True;
  end;
end;

constructor TNxHTMLView.Create;
begin
  FDefaultStyle.Color := clWindowText;
  FDefaultStyle.FontSize := '8';
  FDefaultStyle.TextAlign := taLeft;
  FImages := nil;
  FOperation := [];
end;

destructor TNxHTMLView.Destroy;
begin
  inherited;
end;

procedure TNxHTMLView.DoLinkHit(Href: WideString);
begin
  if Assigned(FOnLinkHit) then FOnLinkHit(Self, Href);
end;

function TNxHTMLView.GetParam(Tag: TNxHTMLTag; Kind: TNxParamKind): WideString;
var
  P: PNxTagParam;
begin
  P := Tag.Params;
  while P <> nil do
  begin
    if StrToParam(P^.Name) = Kind then
    begin
      Result := P^.Value;
      Exit;
    end;
    P := P.Previous;
  end;
end;

function TNxHTMLView.GetStyle(Tag: TNxHTMLTag): TNxCSSStyle;
begin

  with Result do
  begin
    BackgroundColor := clNone;
    PositionX := '';
    PositionY := '';
    TextAlign := taLeft;

    case Tag.Kind of
      tgHtml: FontSize := FDefaultStyle.FontSize;
      tgH1: FontSize := '16';
      tgH2: FontSize := '14';
      tgH3: FontSize := '12';
      else FontSize := '';
    end;

    { color }
    case Tag.Kind of
      tgA: Color := clBlue;
      tgHtml: Color := FDefaultStyle.Color;
      else Color := clNone;
    end;

    { display }
    case Tag.Kind of
      tgA, tgB, tgEm, tgSpan, tgHtml, tgI, tgS, tgStrong, tgSub, tgSup, tgU: Display := dpInline;
      tgDiv, tgH1, tgH2, tgH3, tgP: Display := dpBlock;
      tgImg: Display := dpInlineBlock;
    end;

    { text-align }
    case Tag.Kind of
      tgHtml: TextAlign := FDefaultStyle.TextAlign;
      tgP: TextAlign := StrToTextAlign(Param[Tag, tpAlign]);
      else TextAlign := taInherit;
    end;

    { text-decoration }
    case Tag.Kind of
      tgA: TextDecoration := tdUnderline;
      tgHtml: TextDecoration := tdNone;
      tgS: TextDecoration := tdLineTrough;
      tgU: TextDecoration := tdUnderline;
      else TextDecoration := tdInherit;
    end;

    FontFamily := '';

    { font-weight}
    case Tag.Kind of
      tgB, tgStrong, tgH1, tgH2, tgH3: FontWeight := fwBold;
      tgHtml: FontWeight := fwNormal;
      else FontWeight := fwInherit;
    end;

    { font-style }
    case Tag.Kind of
      tgEm, tgI: FontStyle := fyItalic;
      else FontStyle := fyInherit;
    end;

    { vertical-align }
    case Tag.Kind of
      tgSub: VerticalAlign := vaSub;
      tgSup: VerticalAlign := vaSuper;
      else VerticalAlign := vaBaseline;
    end;

    { position }
    case Tag.Kind of
      tgSub: PositionY := '20%';
      tgSup: PositionY := '-35%';
    end;

  end;

  { Alter styles from Sheet }
  if Assigned(FStyleSheet)
    then FStyleSheet.AssignStyle(Tag, Result);
end;

procedure TNxHTMLView.PaintImage(Canvas: TCanvas; ImageRect: TRect;
  Src: WideString);
var
  Index: Integer;
begin
  if LeftStr(Src, 7) = 'list://' then
  begin
    Index := StrToIntDef(Copy(Src, 8, Length(Src) - 8), -1);
    if Assigned(Images) and InRange(Index, 0, Pred(Images.Count)) then
    begin
      Images.Draw(Canvas, ImageRect.Left, ImageRect.Top, Index);
    end;
  end;
end;

procedure TNxHTMLView.PaintText(Canvas: TCanvas; TextRect: TRect; Text: WideString);
var
  Flags: Integer;
{$IFNDEF UNICODE}
  StringText: string;
{$ENDIF}
begin
  Flags := DT_NOPREFIX
    or DT_EXTERNALLEADING
    or DT_SINGLELINE
    or DT_LEFT
    or DT_BOTTOM
    or DT_NOCLIP;

  { Draw Text }
  with Canvas.Brush do
  begin
    Style := bsClear;
    case UnicodeSupported of
      True: DrawTextW(Canvas.Handle, PWideChar(Text), Length(Text), TextRect, Flags);
      else
      begin
        {$IFDEF UNICODE}
        DrawText(Canvas.Handle, PWideChar(Text), Length(Text), TextRect, Flags);
        {$ELSE}
        StringText := Text;
        DrawText(Canvas.Handle, PAnsiChar(StringText), Length(StringText), TextRect, Flags);
        {$ENDIF}
      end;
    end;
    Style := bsSolid;
  end;
end;

{$WARNINGS OFF}
procedure TNxHTMLView.PaintTo(Canvas: TCanvas; Dest: TRect);
var
  First, Last: PNxStackItem;
  LineSize, BufferSize: TSize;
  TextAlign, PrevAlign: TNxTextAlign;
  LineColor: TColor;

  i: Integer;
  LastDisplay: TNxDisplay;

  BreakItem: PNxStackItem;
  Pos: TPoint;

  procedure DisposeParams(Param: PNxTagParam);
  var
    T: PNxTagParam;
  begin
    while Param <> nil do
    begin
      T := Param;
      Param := Param.Next;

      Dispose(T);
    end;
  end;

  procedure AssignStyle(Style: TNxCSSStyle);
  begin

    with Canvas do
    begin

      { background-color }
      Brush.Color := Style.BackgroundColor;

      { color }
      if Style.Color <> clNone then Font.Color := Style.Color;

      { font-family }
      Font.Name := Style.FontFamily;

      { font-size }
      Font.Size := FontSizeToInt(Style.FontSize, Font.Size);

      { font-weight }
      case Style.FontWeight of
        fwInherit: ;
        fwNormal: Font.Style := Font.Style - [fsBold];
        fwBold: Font.Style := Font.Style + [fsBold];
      end;

      { font-style }
      case Style.FontStyle of
        fyInherit: ;
        fyNormal: Font.Style := Font.Style - [fsItalic];
        fyItalic: Font.Style := Font.Style + [fsItalic];
      end;

      { text-decoration }
      case Style.TextDecoration of
        tdInherit: ;
        tdNone: Font.Style := Font.Style - [fsUnderline];
        tdUnderline: Font.Style := Font.Style + [fsUnderline];
        tdLineTrough: Font.Style := Font.Style + [fsStrikeOut];
      end;

      case Style.VerticalAlign of
        vaSuper, vaSub: Font.Size := Round(FontSizeToInt(Style.FontSize, Font.Size) * 0.75);
      end;

    end;
  end;

  procedure PaintStack(Location: TPoint; StackItem: PNxStackItem);
  var
    TextRect, BlockRect: TRect;
    BackgroundColor: TColor;
    OffsetY: Integer;
  begin
    with StackItem^ do

      case Tag.Kind of
        tgImg:
        begin
          BlockRect := Bounds(Location.X, Location.Y, Size.cx, LineSize.cy);
          if hoPaint in Operation then
          begin
            Canvas.Brush.Color := clRed;
            Canvas.FillRect(BlockRect);
          end;
        end;

        else
        begin
          TextRect := Bounds(Location.X, Location.Y, Size.cx, LineSize.cy);

          OffsetY := StackItem^.Position.Y;

          OffsetRect(TextRect, 0, OffsetY);

          if Tag.Kind = tgA then
            if hoHitTest in Operation then
            begin

              if PtInRect(TextRect, HitLocation) then
              begin
                FHitHref := Url;
              end;

            end;

          BackgroundColor := StackItem^.Snapshot.Brush.Color;

          if BackgroundColor <> clNone then
          begin
            Canvas.Brush.Color := BackgroundColor;
            if hoPaint in Operation then
            begin
              Canvas.FillRect(TextRect);
            end;
          end;

          try
            { Set Snapshot back to Canvas }
            PutCanvasSnapshot(Canvas, Snapshot);

            if hoPaint in Operation then
            begin
              PaintText(Canvas, TextRect, Content);
            end;
          finally

          end;

        end;

      end;
  end;

  procedure BreakLine;
  begin

    Pos.X := Dest.Left;
    Pos.Y := Pos.Y + LineSize.cy;

    { Set to 0, 0 }
    Unset(LineSize);

    BreakItem := nil;
  end;

  procedure OutputLine;
  var
    T: PNxStackItem;
    Done: Boolean;
    LinePos: TPoint;
    Snapshot: TNxCanvasSnapshot;
  begin
    if BufferSize.cy > LineSize.cy then
      LineSize.cy := BufferSize.cy;

    try
      Snapshot := GetCanvasSnapshot(Canvas);

      LinePos := Pos;

      FBestSize.cx := Max(FBestSize.cx, LineSize.cx);
      FBestSize.cy := Max(FBestSize.cy, LinePos.Y + LineSize.cy - Dest.Top);

      case TextAlign of
        taInherit: ;
        taLeft: LinePos := Pos;
        taCenter: LinePos.X := Dest.Left + ((Dest.Right - Dest.Left) div 2 - LineSize.cx div 2);
        taRight: LinePos.X := Dest.Right - LineSize.cx;
      end;

      if LineColor <> clNone then
      begin
        Canvas.Brush.Color := LineColor;
//        Canvas.FillRect(Rect(LinePos.X, LinePos.Y, Dest.Right, LinePos.Y + LineSize.cy));
      end;

      Done := False;

      if Assigned(First)
        and (First^.Content = ' ') then
      begin
        T := First;
        First := First.Next;
        Dispose(T);
      end;

      { Output line & break
        to next line }
      while First <> nil do
      begin

        T := First;

        PaintStack(LinePos, First);

        Inc(LinePos.X, First^.Size.cx);

        if (First = BreakItem) then
        begin
          Done := True;
          BreakItem := nil;
        end;

        First := First.Next;

        Dispose(T);

        if Done then
        begin
          PutCanvasSnapshot(Canvas, Snapshot);
          Exit;
        end;

      end;

    finally
      PutCanvasSnapshot(Canvas, Snapshot);
    end;

    Last := nil;
  end;

  function AddToStack(Content: WideString; Tag: TNxHTMLTag;
    Style: TNxCSSStyle; Snapshoot: TNxCanvasSnapshot;
    BreakAccept: Boolean): PNxStackItem;
  var
    Size: TSize;
  begin
    if Content = '' then
    begin
      Exit;
    end;

    Size := GetTextSize(Canvas, Content, True);

    New(Result);

    Result^.Tag := Tag;
    Result^.Next := nil;
    Result^.Content := Content;
    Result^.Snapshot := Snapshoot;
    Result^.Size := Size;
    Result^.Position := Point(0, 0);

    if Style.PositionY <> '' then
    begin
      Result^.Position.Y := SizeToPixels(Style.PositionY, LineSize.cy);
    end;

    case Tag.Kind of
      tgA: Result^.Url := Param[Tag, tpHref];
    end;

    if First = nil then
    begin
      First := Result;
    end;

    if Last <> nil then
      Last^.Next := Result;

    Last := Result;

    { Required for horz Alignment }
    Inc(BufferSize.cx, Size.cx);

    { Can content fit? }
    if not(Content = ' ')
      and (LineSize.cx + BufferSize.cx > Dest.Right - Dest.Left) then
    begin

      { Text overlow }
      if BufferSize.cx > Dest.Right - Dest.Left then
      begin
        if LineSize.cy = 0 then
          LineSize.cy := Size.cy;

        BreakLine;

        Size.cy := 0;
      end;

      { Flush stack }
      OutputLine;

      { Go-to next line }
      BreakLine;

      LineSize := BufferSize;

      Unset(BufferSize);
    end;

    if Size.cy > BufferSize.cy then
      BufferSize.cy := Size.cy;

    { Breaking is possible }
    if BreakAccept then
    begin
      Inc(LineSize.cx, BufferSize.cx);

      if BufferSize.cy > LineSize.cy then
        LineSize.cy := BufferSize.cy;

      Unset(BufferSize);
    end;

  end;

  procedure NewLine;
  begin
    { Don't break any other word }
    BreakItem := nil;

    if BufferSize.cy > LineSize.cy then
      LineSize.cy := BufferSize.cy;

    Inc(LineSize.cx, BufferSize.cx);

    OutputLine;

    BreakLine;
    Unset(BufferSize);

//    Canvas.Pixels[Pos.X, Pos.Y] := clFuchsia;
  end;

  function ParseParams: PNxTagParam;
  var
    Buffer: WideString;
    State: TNxParamParsingState;
    ParamInBuffer: TNxParamKind;
    T: PNxTagParam;
  begin
    { Default }
    Result := nil;

    State := psNameReading;

    Buffer := EmptyStr;

    while i <= Length(HTML) do
    begin

      if HTML[i] = '=' then
      begin
        ParamInBuffer := StrToParam(Buffer);

        T := Result;

        Result := CreateParam(ParamInBuffer);

        Result.Previous := T;

        Result^.Name := Buffer;
        Buffer := EmptyStr;
      end

      else if HTML[i] = '"' then
      begin
        if State = psValueReading then
        begin
          Result^.Value := Buffer;
          Buffer := EmptyStr;
        end
        else State := psValueReading;
      end

      else if HTML[i] = ' ' then
      begin
        State := psNameReading;
        Buffer := EmptyStr;
      end

      else if HTML[i] = '>' then
      begin
        Exit;
      end

      else Buffer := Buffer + HTML[i];

      { Go-to next }
      Inc(i);
    end;

  end;

  function ParseTag(Kind: TNxTagKind; Params: PNxTagParam): TNxCSSStyle;
  var
    Buffer: WideString;

    Tag: TNxHTMLTag;

    StyleInBuffer: TNxCSSStyle;
    TagKind: TNxTagKind;
    TagParams: PNxTagParam;

    Snapshoot: TNxCanvasSnapshot;

    State: TNxTagParsingState;

    CanBreak: Boolean;
  begin

    { Tag start }

    try
      Tag.Kind := Kind;
      Tag.Params := Params;

      { Obtain style }
      Result := Self.Style[Tag];

      { Block? }

      case Result.Display of
        dpBlock: NewLine;
        dpInline: if LastDisplay = dpBlock then
                  begin
                    // ISSUE

                    //NewLine;
                  end;
      end;

      CanBreak := False;

      if Result.Display = dpBlock then
      begin
//        if Style.BackgroundColor <> clNone then
          LineColor := Result.BackgroundColor;

        PrevAlign := TextAlign;
        TextAlign := Result.TextAlign;
      end;

      { Apply style to Canvas }
      AssignStyle(Result);

      Snapshoot := GetCanvasSnapshot(Canvas);

      { Start }
      State := psContent;
      Buffer := EmptyStr;

      while i <= Length(HTML) do
      begin

        { Closing }
        if HTML[i] = '/' then
        begin
          if State = psTagOpening then
          begin
            State := psTagClosing;
            Buffer := EmptyStr;
          end;
        end

        else if HTML[i] = '<' then
        begin
          if State = psContent then
            AddToStack(Buffer, Tag, Result, Snapshoot, Result.Display = dpBlock);

          { Start reading tag, or params }
          State := psTagOpening;

          Buffer := EmptyStr;
        end

        else if (HTML[i] = '>')
          or ((HTML[i] = ' ') and (State = psTagOpening)) then
        begin
          case State of
            psTagOpening:
              begin
                TagKind := StrToTag(Buffer);

                Buffer := EmptyStr;

                TagParams := nil;

                { Start reading params? }
                if HTML[i] = ' '
                  then TagParams := ParseParams;

                if CanHaveChildren(TagKind) then
                begin
                  try
                    { Parse child tag }
                    StyleInBuffer := ParseTag(TagKind, TagParams);
                  finally

                    if StyleInBuffer.Display = dpBlock then
                    begin
                      CanBreak := True;
                    end;

                    { Set style back }
                    PutCanvasSnapshot(Canvas, Snapshoot);

                    if Result.Display = dpBlock then
                    begin
                    //  if Style.BackgroundColor <> clNone then
                        LineColor := Result.BackgroundColor;

                      //TextAlign := Result.TextAlign;
                    end;

                  end;
                end else
                begin
                  case TagKind of
                    tgBr: NewLine;
                    tgImg:
                    begin

                    end;
                  end;
                end;

                { As child tag is parsed,
                  we need set back style! }

                State := psContent;
              end;
            psTagClosing:
              begin
//                State := psContent;
                Buffer := EmptyStr;

                Break;
              end;
          end;
        end

        else if HTML[i] = ' ' then
        begin
          AddToStack(Buffer, Tag, Result, Snapshoot, False);

          BreakItem := Last;

          AddToStack(HTML[i], Tag, Result, Snapshoot, True);

          Buffer := EmptyStr;
        end

        else
        begin

//          if (State = psContent)
//            and not CharInSet(Char(HTML[i]), [#13, #10]) then
//              if CanBreak then
//              begin
//                NewLine;
//                CanBreak := False;
//                LastDisplay := dpInline;
//              end;

          if not CharInSet(Char(HTML[i]), [#13, #10]) then
          begin
            if (State = psContent) and CanBreak then
            begin
              NewLine;
              CanBreak := False;
              LastDisplay := dpInline;
            end;

            Buffer := Buffer + HTML[i];
          end;

        end;

        { Go-to next }
        Inc(i);
      end;

    finally
      { Tag end }
      AddToStack(Buffer, Tag, Result, Snapshoot, False);

      { Required! }
      if Result.Display = dpBlock then
      begin
        BreakItem := nil;

        NewLine;

        TextAlign := PrevAlign;
      end;

      LastDisplay := Result.Display;

      { Release params }
      DisposeParams(Tag.Params);

    end;

  end;

begin
  FCanvas := Canvas;

  FHitHref := EmptyStr;

  { Clear junk value }
  Unset(LineSize);
  Unset(BufferSize);

  Unset(FBestSize);

  { Unset pointers }
  First := nil;
  Last := nil;
  BreakItem := nil;

  { Start }
  Pos := Dest.TopLeft;
  i := 1;

  LastDisplay := dpInline;

  LineColor := clNone;
  TextAlign := FDefaultStyle.TextAlign;

  { Parse & paint }
  if HTML <> EmptyStr then
  begin
    ParseTag(tgHtml, nil);

    BreakItem := nil;

    Inc(LineSize.cx,  BufferSize.cx);

    if BufferSize.cy > LineSize.cy then
      LineSize.cy := BufferSize.cy;

    OutputLine;
  end;
end;
{$WARNINGS ON}

procedure TNxHTMLView.SetHTML(const Value: WideString);
begin
  FHTML := Trim(Value);
end;

procedure TNxHTMLView.SetStyleSheet(const Value: TNxStylesSheet6);
begin
  FStyleSheet := Value;
end;

end.
