{**********************************************}
{   Html Text mini-parser.                     }
{   Copyright (c) 2004-2020 by Steema Software }
{   All Rights Reserved                        }
{**********************************************}
unit TeeHtml;
{$I TeeDefs.inc}

interface

uses
  {$IFNDEF LINUX}
  {$IFNDEF FMX}
  Windows,
  {$ENDIF}
  {$ENDIF}
  Classes, SysUtils,

  {$IFDEF FMX}
  FMX.Types, System.UITypes,

  {$IFDEF FMX_DEBUG}
  TeCanvas
  {$ELSE}
  FMXTee.Canvas
  {$ENDIF}

  {$ELSE}

  {$IFDEF D16}
  System.UITypes,
  {$ENDIF}

  Graphics,

  {$IFDEF D17}
  VCLTee.TeCanvas
  {$ELSE} 
  TeCanvas
  {$ENDIF}
  {$ENDIF}

  {$IFDEF D16}
  , System.Types
  {$ENDIF}
  ;

type
  TSize=packed record
    Width  : Integer;
    Height : Integer;
  end;

  // Duplicated from TeCanvas unit, to avoid dependency on TeeHMTL everywhere:
  TCoordinate={$IFDEF FMX}Single{$ELSE}Integer{$ENDIF};

// Used by TTeeCanvas class at TeCanvas.pas unit.
procedure HtmlTextOut(const ACanvas:TTeeCanvas; const x,y:TCoordinate; Text:String);

Function HtmlMultiLineTextHeight(const ACanvas:TTeeCanvas; S:String; out NumLines:Integer):Integer;
function HtmlTextExtent(const ACanvas:TTeeCanvas; const Text:String):TSize;

{$IFNDEF D6}
function TryStrToInt(const S: string; var Value: Integer): Boolean;
{$ENDIF}

// Pseudo-Internal hooks
var
  GraphicFileExtension : function(const FileExtension:String):TGraphic;
  GraphicDownload : function(const URL:String; Stream:TStream):Integer;

implementation

{$IFDEF FMX}
uses
  System.UIConsts;
{$ENDIF}

{$IFDEF LCL}
uses
  LCLType;
{$ENDIF}

const
  CRLF=#$D#$A;

var State,
    StateFont : TStringList;

//type
//  HtmlParserException=class(Exception);

{$IFDEF FMX}
function TeeStr(const Value:Single):String; overload;
begin
  result:=FormatFloat('0.##',Value);
end;
{$ENDIF}

function TeeStr(const Value:Integer):String; overload;
begin
  result:=IntToStr(Value);
end;

{ returns number of sections in St string separated by ";" }
Function HtmlNumFields(St:String):Integer;
var i : Integer;
begin
  result:=0;

  repeat
    i:=Pos('=',St);
    if i>0 then
    begin
      Delete(St,1,i);
      Inc(result);
    end;
  until i=0;
end;

procedure HtmlField(s:String; Index:Integer; out left,right:String);
var i,i2,num : Integer;
begin
  left:='';
  right:='';
  num:=0;

  repeat
    i:=Pos('=',s);
    if i>0 then
    begin
      left:=Trim(Copy(s,1,i-1));
      Delete(S,1,i);
      Inc(num);

      if num=Index then
      begin
        i:=Pos('=',s);
        if i=0 then right:=Trim(s)
        else
        begin
          Dec(i);
          while Copy(s,i,1)<>' ' do Dec(i);
          right:=Trim(Copy(s,1,i-1));
          i:=0;
        end;
      end
      else
      begin
        i2:=Pos('=',s);

        if i2=0 then s:=''
        else
        begin
          Dec(i2);
          while Copy(s,i2,1)<>' ' do Dec(i2);
          Delete(s,1,i2);
        end;
      end;
    end;
  until i=0;
end;

procedure PushState(const s:String);
begin
  State.Add(s);
end;

procedure PushFont(const s:String);
begin
  StateFont.Add(s);
end;

function PopState:String;
begin
  if State.Count=0 then result:=''
  else
  begin
    result:=State.Strings[State.Count-1];
    State.Delete(State.Count-1);
  end;
end;

function PopFont:String;
begin
  if StateFont.Count=0 then result:=''
  else
  begin
    result:=StateFont.Strings[StateFont.Count-1];
    StateFont.Delete(StateFont.Count-1);
  end;
end;

function StripQuotes(const S:String):String;
var L : Integer;
begin
  result:=Trim(S);

  if (result[1]='"') or (result[1]='''') then
     Delete(result,1,1);

  L:=Length(result);

  if (result[L]='"') or (result[L]='''') then
     Delete(result,L,1);
end;

// Converts S to double, trimming it, striping quotes and double-quotes, if any:
function HTMLStrToFloat(const S:String):Double;
begin
  result:=StrToFloat(StripQuotes(S));
end;

// Converts S to double, trimming it, striping quotes and double-quotes, if any:
function HTMLStrToInt(const S:String; Default:Integer):Integer;
begin
  result:=StrToIntDef(StripQuotes(S),Default);
end;

function InternalHtmlText(const ACanvas:TTeeCanvas; x,y:TCoordinate; Text:String; Display:Boolean):TSize;

 function GetToken(var st:String):String;
 var i : Integer;
 begin
   i:=Pos('<',st);
   if i=0 then
   begin
     result:=st;
     st:='';
   end
   else
   if i>1 then
   begin
     result:=Copy(st,1,i-1);
     Delete(st,1,i-1);
   end
   else
   begin
     Delete(st,1,1);
     i:=Pos('>',st);

     if i=0 then
     begin
       result:=st;
       st:='';
     end
     else
     begin
       result:='<'+Copy(st,1,i);
       Delete(st,1,i);
     end;
   end;
 end;

var
  PushedFont:Boolean;

  procedure PushCurrentFont;

    Function FontWeight:String;
    begin
      if {$IFDEF FMX}TFontStyle.{$ENDIF}fsBold in ACanvas.Font.Style then
         result:='BOLD' else result:='';

      if {$IFDEF FMX}TFontStyle.{$ENDIF}fsItalic in ACanvas.Font.Style then
         if result='' then result:='ITALIC' else result:=result+', ITALIC';

      if {$IFDEF FMX}TFontStyle.{$ENDIF}fsUnderline in ACanvas.Font.Style then
         if result='' then result:='UNDERLINE' else result:=result+', UNDERLINE';

      if {$IFDEF FMX}TFontStyle.{$ENDIF}fsStrikeout in ACanvas.Font.Style then
         if result='' then result:='STRIKE' else result:=result+', STRIKE';

      if result='' then result:='NORMAL';
    end;

  begin
    PushFont('<FONT size='+TeeStr(ACanvas.Font.Size)+' name='+
      ACanvas.Font.{$IFDEF FMX}Family{$ELSE}Name{$ENDIF}+
      ' color='+
      IntToStr(ACanvas.{$IFDEF FMX}Brush{$ELSE}Font{$ENDIF}.Color)+
      ' weight='+FontWeight+'>');

    PushedFont:=True;
  end;

  {$IFNDEF FMX}
  Function HexToColor(S:String):TColor;
  begin
    S:=Trim(S);

    if Copy(s,1,1)='#' then
       result:={$IFDEF FMX}MakeColor{$ELSE}{$IFDEF USEWINDOWS}RGB{$ELSE}RGBToColor{$ENDIF}{$ENDIF}(StrToInt('$'+Copy(s,2,2)),
                   StrToInt('$'+Copy(s,4,2)),
                   StrToInt('$'+Copy(s,6,2)))
    else
      // clTeeColor, can't use TeEngine unit here to avoid circular
      {$IFDEF D6}
      result:=TColor(clDefault);
      {$ELSE}
      result:=TColor($20000000);
      {$ENDIF}
  end;
  {$ENDIF}

  function HtmlToColor(s:String):{$IFDEF FMX}TAlphaColor{$ELSE}TColor{$ENDIF};
  begin
    s:=Trim(UpperCase(s));

    if Copy(s,1,1)='"' then
       Delete(s,1,1);

    if Copy(s,Length(s),1)='"' then
       Delete(s,Length(s),1);

    {$IFDEF FMX}
    result:=StringToAlphaColor(s);
    {$ELSE}
    if s='BLACK' then result:=clBlack else
    if s='RED' then result:=clRed else
    if s='BLUE' then result:=clBlue else
    if s='YELLOW' then result:=clYellow else
    if s='WHITE' then result:=clWhite else
    if s='GREEN' then result:=clGreen else
    if s='LIME' then result:=clLime else

    if Copy(s,1,1)='#' then
       result:=HexToColor(s)
    else
    begin
      if not IdentToColor(S, Longint(Result)) then
         if not TryStrToInt(s,Integer(result)) then
            result:={$IFDEF FMX}TAlphaColors.Black{$ELSE}clBlack{$ENDIF};
    end;
    {$ENDIF}
  end;

  // <font name="Arial" family="Arial" size=+4 weight=bold color=#12285c  >
  procedure ProcessFont(s:String);
  var t,i:Integer;
      tmpSize, Left, Right:String;
  begin
    Delete(s,1,6);
    Delete(s,Length(s),1);

    i:=HtmlNumFields(s);
    for t:=1 to i do
    begin
      HtmlField(s,t,left,right);

      left:=UpperCase(left);

      if (left='NAME') or (left='FAMILY') then
         ACanvas.Font.{$IFDEF FMX}Family{$ELSE}Name{$ENDIF}:=right
      else
      if left='SIZE' then
      begin
        tmpSize:=Copy(right,1,1);

        if (tmpSize='+') or (tmpSize='-') then
           ACanvas.Font.SizeFloat:=ACanvas.Font.SizeFloat+HTMLStrToFloat(right)
        else
           ACanvas.Font.SizeFloat:=HTMLStrToFloat(right)
      end
      else
      if left='COLOR' then
         ACanvas.{$IFDEF FMX}Brush{$ELSE}Font{$ENDIF}.Color:=HtmlToColor(right)
      else
      if left='WEIGHT' then
      begin
        right:=UpperCase(Right);

        if right='BOLD' then
           ACanvas.Font.Style:=[{$IFDEF FMX}TFontStyle.{$ENDIF}fsBold] else
        if right='ITALIC' then
           ACanvas.Font.Style:=[{$IFDEF FMX}TFontStyle.{$ENDIF}fsItalic] else
        if right='NORMAL' then
           ACanvas.Font.Style:=[] else
        if right='STRIKE' then
           ACanvas.Font.Style:=[{$IFDEF FMX}TFontStyle.{$ENDIF}fsStrikeOut] else
        if right='UNDERLINE' then
           ACanvas.Font.Style:=[{$IFDEF FMX}TFontStyle.{$ENDIF}fsUnderline]
        else
          raise Exception.Create('Unknown field in FONT WEIGHT='+right);
      end
      else
          raise Exception.Create('Unknown field in FONT: '+left);
    end;
  end;

var
  OldX : TCoordinate;
  IsCenter : Boolean;
  MaxSizeY : Integer;

  function DoStringReplace(const S, OldPattern, NewPattern: string): string;
  var
    SearchStr, Patt, NewStr: string;
    Offset: Integer;
  begin
    SearchStr := S;
    Patt := OldPattern;
    NewStr := S;
    Result := '';

    while SearchStr <> '' do
    begin
      Offset := Pos(Patt, SearchStr);
      if Offset = 0 then
      begin
        Result := Result + NewStr;
        Break;
      end;

      Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
      NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
      SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
    end;
  end;

  procedure OutputText(tmp:String);
  var HasReturn : Boolean;
      tmpSize : TPointFloat;
  begin
    // Pending: more special characters
    tmp:=DoStringReplace(tmp,'&lt;','<');
    tmp:=DoStringReplace(tmp,'&gt;','>');
    tmp:=DoStringReplace(tmp,'&amp;','&');
    tmp:=DoStringReplace(tmp,'&quot;','"');

    HasReturn:=Copy(tmp,Length(tmp)-1,2)=CRLF;
    if HasReturn then
       Delete(tmp,Length(tmp)-1,2);

    if tmp<>'' then
    begin
      tmpSize:=ACanvas.TextSize(tmp);

      if IsCenter then
      begin
        {$IFDEF FMX}
        x:=(ACanvas.Bounds.Left+ACanvas.Bounds.Right) *0.5;
        x:=x-tmpSize.X*0.5;
        {$ELSE}
        x:=(ACanvas.Bounds.Left+ACanvas.Bounds.Right) div 2;
        x:=x-(Round(tmpSize.X) div 2);
        {$ENDIF};
      end;

      if MaxSizeY=0 then
      begin
        MaxSizeY:=ACanvas.FontHeight;
        //        Inc(y,MaxSizeY);  review?
      end
      else
      // Vertical bottom alignment:
      if tmpSize.Y<MaxSizeY then
         y:=y+MaxSizeY-{$IFNDEF FMX}Round{$ENDIF}(tmpSize.Y)-1;

      if Display then
         ACanvas.TextOut(x,y,tmp);

      x:=x+{$IFNDEF FMX}Round{$ENDIF}(tmpSize.X);

      if x>result.Width then
         result.Width:={$IFDEF FMX}Round{$ENDIF}(x);

      if tmpSize.Y>MaxSizeY then
         MaxSizeY:=Round(tmpSize.Y)-1;

      if MaxSizeY>result.Height then
         result.Height:=MaxSizeY;
    end;

    if HasReturn then
    begin
      MaxSizeY:=0;
      x:=OldX;
    end;
  end;

  procedure SetBackFont;
  begin
    ProcessFont(PopFont)
  end;

  procedure ImageNotFound(x,y,Width,Height:Integer);
  begin
    if Width=0 then Width:=40;
    if Height=0 then Height:=40;

    with ACanvas do
    begin
      Pen.Style:=psSolid;
      Pen.Color:={$IFDEF FMX}TAlphaColors.Red{$ELSE}clRed{$ENDIF};
      Pen.Width:=1;
      Brush.{$IFDEF FMX}Kind{$ELSE}Style{$ENDIF}:=bsSolid;
      Brush.Color:={$IFDEF FMX}TAlphaColors.White{$ELSE}clWhite{$ENDIF};
      Rectangle(x,y,x+Width,y+Height);

      MoveTo(x,y);
      LineTo(x+Width-1,y+Height-1);
      MoveTo(x,y+Height-1);
      LineTo(x+Width-1,y);
    end;
  end;

  procedure DoImage(tmpU:String);

    function RemoveQuotes(const S:String):String;
    var l : Integer;
    begin
      result:=S;
      if Copy(result,1,1)='"' then
         Delete(result,1,1);
      l:=Length(result);
      if Copy(result,l,1)='"' then
         Delete(result,l,1);
    end;

  var i,t,
      tmpW,
      tmpH  : Integer;
      tmpURL,
      Left,
      Right : String;
      {$IFDEF URLDEBUG}
      tmpSt : TStringList;
      {$ENDIF}
      tmpS  : TMemoryStream;
      g     : TGraphic;
      tmpOk : Integer;
  begin
    tmpW:=0;
    tmpH:=0;
    tmpURL:='';

    Delete(tmpU,1,5);

    if Copy(tmpU,1,2)=CRLF then
       Delete(tmpU,1,2);

    if Copy(tmpU,Length(tmpU),1)='>' then
       Delete(tmpU,Length(tmpU),1);

    i:=HtmlNumFields(tmpU);
    for t:=1 to i do
    begin
      HtmlField(tmpU,t,left,right);
      left:=UpperCase(left);
      if left='WIDTH' then tmpW:=HTMLStrToInt(Right,0) else
      if left='HEIGHT' then tmpH:=HTMLStrToInt(Right,0) else
      if left='SRC' then tmpURL:=Right; // more img attribs ?
    end;

    if tmpURL<>'' then
    begin
      tmpURL:=RemoveQuotes(Trim(tmpURL));

      tmpS:=TMemoryStream.Create;
      try
        left:=UpperCase(ExtractFileExt(tmpURL));

        g:=GraphicFileExtension(Left);

        if not Assigned(g) then
        begin
          ImageNotFound({$IFDEF FMX}Round{$ENDIF}(x),
                        {$IFDEF FMX}Round{$ENDIF}(y),tmpW,tmpH);
          exit;
        end;

        try
          tmpOk:=GraphicDownload(tmpURL,tmpS);

          if (tmpOk=0) and (tmpS.Size>0) then
          begin
            tmpS.Position:=0;

            try
              {$IFDEF URLDEBUG}
              tmpSt:=TStringList.Create;
              tmpSt.LoadFromStream(tmpS);
              {$ENDIF}

              g.LoadFromStream(tmpS);

              {$IFDEF URLDEBUG}
              tmpSt.Free;
              {$ENDIF}

              if tmpW=0 then tmpW:=g.Width;
              if tmpH=0 then tmpH:=g.Height;

              if (tmpW<>g.Width) or (tmpH<>g.Height) then
              begin
                 if ((x>0) and (y>0)) then  // Review ?
                 begin
                   if IsCenter then
                   begin
                     ACanvas.StretchDraw(TeeRect(x-(tmpW div 2),y,x+(tmpW div 2),y+tmpH),g)
                   end
                   else begin
                     ACanvas.StretchDraw(TeeRect(x,y,x+tmpW,y+tmpH),g)
                   end;
                 end;
              end
              else
                 ACanvas.Draw({$IFDEF FMX}Round{$ENDIF}(x),
                              {$IFDEF FMX}Round{$ENDIF}(y),g);

              x:=x+tmpW;
              y:=y+tmpH-10; // 10?
              MaxSizeY:=tmpH;

              if tmpW>result.Width then
                 result.Width:=tmpW;

              if tmpH>result.Height then
                 result.Height:=tmpH;
            except
              on Exception do
                 ImageNotFound({$IFDEF FMX}Round{$ENDIF}(x),
                               {$IFDEF FMX}Round{$ENDIF}(y),tmpW,tmpH);
            end;
          end
          else
            ImageNotFound({$IFDEF FMX}Round{$ENDIF}(x),
                          {$IFDEF FMX}Round{$ENDIF}(y),tmpW,tmpH);
        finally
          g.Free;
        end;
      finally
        tmpS.Free;
      end;
    end;
  end;

  function IsHeaderEndTag(const S:String):Boolean;
  begin
    result:=(S='</H1>') or (S='</H2>') or (S='</H3>') or
            (S='</H4>') or(S='</H5>') or (S='</H6>');
  end;

var
  IsLastFont : Boolean;

  procedure DoToken(tmp:String);

    procedure NewSize(const ASize:TCoordinate);
    begin
      PushCurrentFont;
      ACanvas.Font.Size:=ASize;
    end;

  var tmpU,tmpS : String;
  begin
    PushedFont:=False;

    if Copy(tmp,1,2)=CRLF then
    begin
      y:=y+ACanvas.FontHeight;
      x:=OldX;
      MaxSizeY:=0;

      Delete(tmp,1,2);
    end;

    if tmp='' then exit;

    tmpU:=UpperCase(tmp);

    if (tmpU='<BR>') or (tmpU='<P>') then  // Paragraphs here !!
    begin
      x:=OldX;
      MaxSizeY:=0;  // "y" will be incremented later.
      y:=y+ACanvas.FontHeight; //ACanvas.Font.Size+2);
      inc(Result.Height, ACanvas.FontHeight + 2); //ACanvas.Font.Size+2);
    end
    else
    if tmpU='<BIG>' then
    begin
      NewSize(ACanvas.Font.Size+2);
      y:=y-4;
    end
    else
    if tmpU='<SMALL>' then
    begin
      NewSize(ACanvas.Font.Size-2);
      y:=y-1;
    end
    else
    if tmpU='</BIG>' then
    begin
      SetBackFont;
      y:=y+2;
    end
    else
    if tmpU='</SMALL>' then
    begin
      SetBackFont;
      y:=y-2;
    end
    else
    if tmpU='</SUB>' then
    begin
      SetBackFont;
      y:=y-ACanvas.FontHeight;
    end
    else
    if tmpU='<SUB>' then
    begin
      NewSize(ACanvas.Font.Size {$IFDEF FMX}*0.5{$ELSE}div 2{$ENDIF});
      y:=y+ACanvas.FontHeight;
    end
    else
    if (tmpU='</SUPER>') or (tmpU='</SUP>') then
    begin
      SetBackFont;
      y:=y+(ACanvas.FontHeight div 2);
    end
    else
    if (tmpU='<SUPER>') or (tmpU='<SUP>') then
    begin
      NewSize(ACanvas.Font.Size {$IFDEF FMX}*0.5{$ELSE}div 2{$ENDIF});
      y:=y-(ACanvas.FontHeight div 2);
    end
    else
    if tmpU='<H1>' then NewSize(48) else
    if tmpU='<H2>' then NewSize(36) else
    if tmpU='<H3>' then NewSize(24) else
    if tmpU='<H4>' then NewSize(18) else
    if tmpU='<H5>' then NewSize(12) else
    if tmpU='<H6>' then NewSize(8) else

//      if tmpU='<BLINK>' then ...
//      else
    if tmpU='<PRE>' then
    begin
      PushCurrentFont;
      ProcessFont('<FONT NAME="COURIER NEW">');
    end
    else
    if tmpU='<CENTER>' then
       IsCenter:=True
    else
    if (tmpU='<B>') or (tmpU='<BOLD>') or (tmpU='<STRONG>') then
    begin
      ACanvas.Font.Style:=ACanvas.Font.Style+[{$IFDEF FMX}TFontStyle.{$ENDIF}fsBold];
      PushState(tmpU);
    end
    else
    if tmpU='<I>' then
    begin
      ACanvas.Font.Style:=ACanvas.Font.Style+[{$IFDEF FMX}TFontStyle.{$ENDIF}fsItalic];
      PushState(tmpU);
    end
    else
    if tmpU='<U>' then
    begin
      ACanvas.Font.Style:=ACanvas.Font.Style+[{$IFDEF FMX}TFontStyle.{$ENDIF}fsUnderline];
      PushState(tmpU);
    end
    else
    if tmpU='<STRIKE>' then
    begin
      ACanvas.Font.Style:=ACanvas.Font.Style+[{$IFDEF FMX}TFontStyle.{$ENDIF}fsStrikeOut];
      PushState(tmpU);
    end
    else
    if Copy(tmpU,1,5)='<IMG ' then DoImage(tmp)
    else
    if (tmpU='</B>') or (tmpU='</BOLD>') or (tmpU='</STRONG>') then
       ACanvas.Font.Style:=ACanvas.Font.Style-[{$IFDEF FMX}TFontStyle.{$ENDIF}fsBold]
    else
    if tmpU='</I>' then
       ACanvas.Font.Style:=ACanvas.Font.Style-[{$IFDEF FMX}TFontStyle.{$ENDIF}fsItalic]
    else
    if tmpU='</U>' then
       ACanvas.Font.Style:=ACanvas.Font.Style-[{$IFDEF FMX}TFontStyle.{$ENDIF}fsUnderline]
    else
    if tmpU='</STRIKE>' then
       ACanvas.Font.Style:=ACanvas.Font.Style-[{$IFDEF FMX}TFontStyle.{$ENDIF}fsStrikeOut]
    else
    if IsHeaderEndTag(tmpU) then
       SetBackFont
    else
    if Copy(tmpU,1,6)='</FONT' then
       SetBackFont // ProcessFont(tmpU)
    else
    if tmpU='</PRE>' then SetBackFont
    else
    if tmpU='</CENTER>' then IsCenter:=False
    else
    if Copy(tmpU,1,6)='<FONT ' then
    begin
      PushCurrentFont;
      ProcessFont(tmpU);
    end
    else
    if tmpU='</>' then
    begin
      if IsLastFont then
         SetBackFont
      else
      begin
        tmpS:=PopState;
        Delete(tmpS,1,1);
        DoToken('</'+tmpS);
      end;
    end
    else
    if tmpU='<HR>' then
    begin
      x:=OldX;

      with ACanvas.Pen do
      begin
        Style:=psSolid;
        Width:=1;
        Color:={$IFDEF FMX}claDarkGray{$ELSE}clDkGray{$ENDIF};
      end;

      ACanvas.DoHorizLine({$IFDEF FMX}Round{$ENDIF}(x),
                          {$IFDEF FMX}Round{$ENDIF}(x)+100,
                          {$IFDEF FMX}Round{$ENDIF}(y));  // 100 ?
      y:=y+ACanvas.FontHeight;
    end
    else
    begin
      OutputText(tmp);
      Exit;
    end;

    IsLastFont:=PushedFont;
  end;

var tmp : String;
begin
  result.Width:=0;
  result.Height:=0;

  OldX:=X;
  IsCenter:=False;
  MaxSizeY:=ACanvas.FontHeight;

  repeat
    tmp:=GetToken(Text);

    if tmp<>'' then
       DoToken(tmp);

  until tmp='';
end;

function StringContains(const SubStr,S:String):Integer; {$IFDEF D9}inline;{$ENDIF}
begin
  result:={$IFDEF D14}Pos{$ELSE}AnsiPos{$ENDIF}(SubStr,S);
end;

{ This function returns the longest height in pixels for a given "S" string.
  It also considers multi-line strings, returning in the NumLines
  parameter the count of lines. }
Function HtmlMultiLineTextHeight(const ACanvas:TTeeCanvas; S:String; out NumLines:Integer):Integer;
var i : Integer;
begin
  result:=0;
  NumLines:=0;

  i:=StringContains(#13,s);

  while i>0 do
  begin
    Inc(result,HtmlTextExtent(ACanvas,Copy(s,1,i-1)).Height);

    Inc(NumLines);
    Delete(s,1,i);
    i:=StringContains(#13,s);
  end;

  if s<>'' then
  begin
    Inc(result,HtmlTextExtent(ACanvas,s).Height);
    Inc(NumLines);
  end;
end;

function HtmlTextExtent(const ACanvas:TTeeCanvas; const Text:String):TSize;
begin
  result:=InternalHtmlText(ACanvas,0,0,Text,False);
end;

procedure HtmlTextOut(const ACanvas:TTeeCanvas; const x,y:TCoordinate; Text:String);
var tmpW : Integer;
    Old  : Integer;
begin
  if (ACanvas.TextAlign=TA_CENTER) or (ACanvas.TextAlign=TA_RIGHT) then
  begin
    tmpW:=InternalHtmlText(ACanvas,0,0,Text,False).Width;

    if ACanvas.TextAlign=TA_CENTER then
       tmpW:=tmpW div 2;

    Old:=ACanvas.TextAlign;
    ACanvas.TextAlign:=TA_LEFT;

    InternalHtmlText(ACanvas,x-tmpW,y,Text,True);

    ACanvas.TextAlign:=Old;
  end
  else
    InternalHtmlText(ACanvas,x,y,Text,True);
end;

{$IFNDEF D6}
function TryStrToInt(const S: string; var Value: Integer): Boolean;
var
  E: Integer;
begin
  Val(S, Value, E);
  Result := E = 0;
end;
{$ENDIF}

initialization
  State:=TStringList.Create;
  StateFont:=TStringList.Create;
finalization
  StateFont.Free;
  State.Free;
end.
