unit DzHTMLText;

Controls, Classes, Messages, Graphics, Types, FGL, LCLIntf

Vcl.Controls, System.Classes, Winapi.Messages,

System.Generics.Collections, Vcl.Graphics, System.Types

{$ENDIF};

{$IFDEF FPC}

TObjectList<T> = class(TFPGObjectList<T>);

TList<T> = class(TFPGList<T>);

{$ENDIF}

{DHWord is an object to each word. Will be used to paint event.

TDHWord = class

private

Rect: TRect;

Text: String;

Group: Integer; //group number

{The group is isolated at each line or tabulation to delimit text align area}

Align: TAlignment;

Font: TFont;

BColor: TColor; //background color

Link: Boolean; //is a link

LinkID: Integer; //link number

{The link number is created sequentially, when reading text links

Space: Boolean; //is an space

Hover: Boolean; //the mouse is over the link

public

constructor Create;

destructor Destroy; override;

end;

TDHWordList = class(TObjectList<TDHWord>)

private

procedure Add(Rect: TRect; Text: String; Group: Integer; Align: TAlignment;

Font: TFont; BColor: TColor; Link: Boolean; LinkID: Integer; Space: Boolean);

{$IFDEF FPC}reintroduce;{$ENDIF}

end;

TDzHTMLText = class;

TDHKindStyleLinkProp = (tslpNormal, tslpHover); //kind of link style

{DHStyleLinkProp is a sub-property used at Object Inspector that contains

TDHStyleLinkProp = class(TPersistent)

private

Lb: TDzHTMLText; //owner

Kind: TDHKindStyleLinkProp;

FFontColor: TColor;

FBackColor: TColor;

FUnderline: Boolean;

procedure SetFontColor(const Value: TColor);

procedure SetBackColor(const Value: TColor);

procedure SetUnderline(const Value: Boolean);

function GetDefaultFontColor: TColor;

function GetStoredFontColor: Boolean;

procedure SetPropsToCanvas(C: TCanvas); //method to use at paint event

function GetStored: Boolean; //GetStored general to use at owner

protected

function GetOwner: TPersistent; override;

public

constructor Create(xLb: TDzHTMLText; xKind: TDHKindStyleLinkProp);

procedure Assign(Source: TPersistent); override;

published

property FontColor: TColor read FFontColor write SetFontColor stored GetStoredFontColor;

property BackColor: TColor read FBackColor write SetBackColor default clNone;

property Underline: Boolean read FUnderline write SetUnderline default False;

end;

TDHLinkData = class

private

FTarget: String;

FText: String;

public

property Target: String read FTarget;

property Text: String read FText;

end;

TDHLinkDataList = class(TObjectList<TDHLinkData>);

TDHEvLink = procedure(Sender: TObject; LinkID: Integer; LinkData: TDHLinkData) of object;

TDHEvLinkClick = procedure(Sender: TObject; LinkID: Integer; LinkData: TDHLinkData; var Handled: Boolean) of object;

TDzHTMLText = class(TGraphicControl)

private

FAbout: String;

LWords: TDHWordList; //word list to paint event

LLinkData: TDHLinkDataList; //list of links info

FText: String;

FAutoWidth: Boolean;

FAutoHeight: Boolean;

FMaxWidth: Integer; //max width when using AutoWidth

//FTransparent: Boolean; //not used because of flickering

FAutoOpenLink: Boolean; //link auto-open with ShellExecute

FLines: Integer; //read-only

FTextWidth: Integer; //read-only

FTextHeight: Integer; //read-only

FStyleLinkNormal, FStyleLinkHover: TDHStyleLinkProp;

FOnLinkEnter, FOnLinkLeave: TDHEvLink;

FOnLinkClick, FOnLinkRightClick: TDHEvLinkClick;

FIsLinkHover: Boolean; //if has a selected link

FSelectedLinkID: Integer; //selected link ID

NoCursorChange: Boolean; //lock CursorChange event

DefaultCursor: TCursor; //default cursor when not over a link

procedure SetText(const Value: String);

procedure SetAutoHeight(const Value: Boolean);

procedure SetAutoWidth(const Value: Boolean);

procedure SetMaxWidth(const Value: Integer);

function GetStoredStyleLink(const Index: Integer): Boolean;

procedure SetStyleLink(const Index: Integer; const Value: TDHStyleLinkProp);

procedure DoPaint;

procedure Rebuild; //rebuild words

procedure BuildAndPaint; //rebuild and repaint

procedure CheckMouse(X, Y: Integer);

procedure SetCursorWithoutChange(C: TCursor); //check links by mouse position

//procedure SetTransparent(const Value: Boolean);

protected

procedure Loaded; override;

procedure Paint; override;

procedure Click; override;

procedure Resize; override;

procedure CMColorchanged(var Message: TMessage); message CM_COLORCHANGED;

procedure CMFontchanged(var Message: TMessage); message CM_FONTCHANGED;

procedure MouseMove(Shift: TShiftState; X: Integer; Y: Integer); override;

procedure CMMouseleave(var Message: TMessage); message CM_MOUSELEAVE;

procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;

Y: Integer); override;

procedure CMCursorchanged(var Message: TMessage); message CM_CURSORCHANGED;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

property IsLinkHover: Boolean read FIsLinkHover;

property SelectedLinkID: Integer read FSelectedLinkID;

function GetLinkData(LinkID: Integer): TDHLinkData; //get data by link id

function GetSelectedLinkData: TDHLinkData; //get data of selected link

published

property Align;

property Anchors;

property Color;

property Font;

property ParentColor;

property ParentFont;

property ParentShowHint;

property PopupMenu;

property ShowHint;

property Visible;

property OnClick;

property OnDblClick;

property OnDragDrop;

property OnDragOver;

property OnEndDock;

property OnEndDrag;

{$IFDEF DCC}

property OnGesture;

property OnMouseActivate;

{$ENDIF}

property OnMouseDown;

property OnMouseEnter;

property OnMouseLeave;

property OnMouseMove;

property OnMouseUp;

property OnResize;

property OnStartDock;

property OnStartDrag;

property Text: String read FText write SetText;

//property Transparent: Boolean read FTransparent write SetTransparent default False;

property AutoWidth: Boolean read FAutoWidth write SetAutoWidth default False;

property AutoHeight: Boolean read FAutoHeight write SetAutoHeight default False;

property MaxWidth: Integer read FMaxWidth write SetMaxWidth default 0;

property StyleLinkNormal: TDHStyleLinkProp index 1 read FStyleLinkNormal write SetStyleLink stored GetStoredStyleLink;

property StyleLinkHover: TDHStyleLinkProp index 2 read FStyleLinkHover write SetStyleLink stored GetStoredStyleLink;

property Lines: Integer read FLines;

property TextWidth: Integer read FTextWidth;

property TextHeight: Integer read FTextHeight;

property OnLinkEnter: TDHEvLink read FOnLinkEnter write FOnLinkEnter;

property OnLinkLeave: TDHEvLink read FOnLinkLeave write FOnLinkLeave;

property OnLinkClick: TDHEvLinkClick read FOnLinkClick write FOnLinkClick;

property OnLinkRightClick: TDHEvLinkClick read FOnLinkRightClick write FOnLinkRightClick;

property AutoOpenLink: Boolean read FAutoOpenLink write FAutoOpenLink default True;

property About: String read FAbout;

end;

procedure Register;

{$IFDEF MSWINDOWS}Windows, {$ENDIF}SysUtils, LResources

System.SysUtils, System.UITypes, Winapi.Windows, Winapi.ShellAPI

{$ENDIF};

procedure Register;

{$IFDEF FPC}{$I DzHTMLText.lrs}{$ENDIF}

RegisterComponents('Digao', [TDzHTMLText]);

end;

constructor TDHWord.Create;

inherited;

Font := TFont.Create;

end;

destructor TDHWord.Destroy;

Font.Free;

inherited;

end;

procedure TDHWordList.Add(Rect: TRect; Text: String; Group: Integer; Align: TAlignment;

Font: TFont; BColor: TColor; Link: Boolean; LinkID: Integer; Space: Boolean);

var W: TDHWord;

W := TDHWord.Create;

inherited Add(W);

W.Rect := Rect;

W.Text := Text;

W.Group := Group;

W.Align := Align;

W.Font.Assign(Font);

W.BColor := BColor;

W.Link := Link;

W.LinkID := LinkID;

W.Space := Space;

end;

constructor TDzHTMLText.Create(AOwner: TComponent);

inherited;

ControlStyle := ControlStyle + [csOpaque];

//Warning! The use of transparency in the component causes flickering

FAbout := 'Digao Dalpiaz / Version 1.1';

FStyleLinkNormal := TDHStyleLinkProp.Create(Self, tslpNormal);

FStyleLinkHover := TDHStyleLinkProp.Create(Self, tslpHover);

LWords := TDHWordList.Create;

LLinkData := TDHLinkDataList.Create;

FAutoOpenLink := True;

FSelectedLinkID := -1;

DefaultCursor := Cursor;

{$IFDEF FPC}

//Lazarus object starts too small

Width := 200;

Height := 100;

{$ENDIF}

end;

destructor TDzHTMLText.Destroy;

FStyleLinkNormal.Free;

FStyleLinkHover.Free;

LWords.Free;

LLinkData.Free;

inherited;

end;

procedure TDzHTMLText.Loaded;

{Warning! When a component is inserted at design-time, the Loaded

inherited;

Rebuild;

end;

procedure TDzHTMLText.BuildAndPaint;

//Rebuild words and repaint

Rebuild;

Invalidate;

end;

procedure TDzHTMLText.SetAutoHeight(const Value: Boolean);

if Value<>FAutoHeight then

begin

FAutoHeight := Value;

if Value then Rebuild;

end;

end;

procedure TDzHTMLText.SetAutoWidth(const Value: Boolean);

if Value<>FAutoWidth then

begin

FAutoWidth := Value;

if Value then Rebuild;

end;

end;

procedure TDzHTMLText.SetMaxWidth(const Value: Integer);

if Value<>FMaxWidth then

begin

FMaxWidth := Value;

Rebuild;

end;

end;

procedure TDzHTMLText.SetText(const Value: String);

if Value<>FText then

begin

FText := Value;

BuildAndPaint;

end;

end;

procedure TDzHTMLText.CMColorchanged(var Message: TMessage);

{$IFDEF FPC}if Message.Result=0 then {};{$ENDIF} //avoid unused var warning

Invalidate;

end;

procedure TDzHTMLText.CMFontchanged(var Message: TMessage);

{$IFDEF FPC}if Message.Result=0 then {};{$ENDIF} //avoid unused var warning

BuildAndPaint;

end;

procedure TDzHTMLText.Resize;

//on component creating, there is no parent and the resize is fired,

//so, the canvas is not present at this moment.

if HasParent then

Rebuild;

inherited;

end;

procedure TDzHTMLText.Paint;

inherited;

DoPaint;

end;

procedure TDzHTMLText.DoPaint;

var W: TDHWord;

B: {$IFDEF DCC}Vcl.{$ENDIF}Graphics.TBitmap;

//Using internal bitmap as a buffer to reduce flickering

B := {$IFDEF DCC}Vcl.{$ENDIF}Graphics.TBitmap.Create;

try

B.SetSize(Width, Height);

//if not FTransparent then

//begin

{$IFDEF FPC}

if (Color=clDefault) and (ParentColor) then B.Canvas.Brush.Color := GetColorresolvingParent else

{$ENDIF}

B.Canvas.Brush.Color := Color;

B.Canvas.FillRect(ClientRect);

//end;

if csDesigning in ComponentState then

begin

B.Canvas.Pen.Style := psDot;

B.Canvas.Pen.Color := clBtnShadow;

B.Canvas.Brush.Style := bsClear;

B.Canvas.Rectangle(ClientRect);

end;

for W in LWords do

begin

B.Canvas.Font.Assign(W.Font);

if W.BColor<>clNone then

B.Canvas.Brush.Color := W.BColor

else

B.Canvas.Brush.Style := bsClear;

if W.Link then

begin

if W.Hover then //selected

FStyleLinkHover.SetPropsToCanvas(B.Canvas)

else

FStyleLinkNormal.SetPropsToCanvas(B.Canvas);

end;

DrawText(B.Canvas.Handle,

{$IFDEF FPC}PChar({$ENDIF}W.Text{$IFDEF FPC}){$ENDIF},

-1, W.Rect, DT_NOCLIP or DT_NOPREFIX);

{Using DrawText, because TextOut has not clip option, which causes

end;

Canvas.Draw(0, 0, B); //to reduce flickering

finally

B.Free;

end;

end;

function TDzHTMLText.GetLinkData(LinkID: Integer): TDHLinkData;

Result := LLinkData[LinkID];

end;

function TDzHTMLText.GetSelectedLinkData: TDHLinkData;

Result := LLinkData[FSelectedLinkID];

end;

procedure TDzHTMLText.CMCursorchanged(var Message: TMessage);

{$IFDEF FPC}if Message.Result=0 then {};{$ENDIF} //avoid unused var warning

if NoCursorChange then Exit;

DefaultCursor := Cursor; //save default cursor to when link not selected

end;

procedure TDzHTMLText.SetCursorWithoutChange(C: TCursor);

//Set cursor, but without fire cursor change event

NoCursorChange := True;

try

Cursor := C;

finally

NoCursorChange := False;

end;

end;

procedure TDzHTMLText.CheckMouse(X, Y: Integer);

var FoundHover, HasChange, Old: Boolean;

LinkID: Integer;

W: TDHWord;

FoundHover := False;

HasChange := False;

LinkID := -1;

//find the first word, if there is any

for W in LWords do

if W.Link then

begin

if W.Rect.Contains({$IFDEF FPC}Types.{$ENDIF}Point(X, Y)) then //selected

begin

FoundHover := True; //found word of a link selected

LinkID := W.LinkID;

Break;

end;

end;

//set as selected all the words of same link, and unselect another links

for W in LWords do

if W.Link then

begin

Old := W.Hover;

W.Hover := (W.LinkID = LinkID);

if Old<>W.Hover then HasChange := True; //changed

end;

if HasChange then //there is any change

begin

if FoundHover then //enter the link

begin

SetCursorWithoutChange(crHandPoint); //set HandPoint cursor

FIsLinkHover := True;

FSelectedLinkID := LinkID;

if Assigned(FOnLinkEnter) then

FOnLinkEnter(Self, LinkID, LLinkData[LinkID]);

end else

begin //leave the link

SetCursorWithoutChange(DefaultCursor); //back to default cursor

FIsLinkHover := False;

LinkID := FSelectedLinkID; //save to use on OnLinkLeave event

FSelectedLinkID := -1;

if Assigned(FOnLinkLeave) then

FOnLinkLeave(Self, LinkID, LLinkData[LinkID]);

end;

Invalidate;

end;

end;

procedure TDzHTMLText.Click;

var Handled: Boolean;

aTarget: String;

if FIsLinkHover then

begin

Handled := False;

if Assigned(FOnLinkClick) then

FOnLinkClick(Self, FSelectedLinkID, LLinkData[FSelectedLinkID], Handled);

if FAutoOpenLink and not Handled then

begin

aTarget := LLinkData[FSelectedLinkID].FTarget;

{$IFDEF MSWINDOWS}

ShellExecute(0, '', PChar(aTarget), '', '', 0);

{$ELSE}

if aTarget.StartsWith('http://', True)

or aTarget.StartsWith('https://', True)

or aTarget.StartsWith('www.', True)

then

OpenURL(aTarget)

else

OpenDocument(aTarget);

{$ENDIF}

end;

end;

inherited;

end;

procedure TDzHTMLText.MouseUp(Button: TMouseButton; Shift: TShiftState; X,

Y: Integer);

var Handled: Boolean;

if Button = mbRight then

if IsLinkHover then

if Assigned(FOnLinkRightClick) then

begin

Handled := False;

FOnLinkRightClick(Self, FSelectedLinkID, LLinkData[FSelectedLinkID], Handled);

end;

inherited;

end;

procedure TDzHTMLText.MouseMove(Shift: TShiftState; X, Y: Integer);

CheckMouse(X, Y);

inherited;

end;

procedure TDzHTMLText.CMMouseleave(var Message: TMessage);

//Mouse leaves the component

CheckMouse(-1, -1);

inherited;

end;

TTokenKind = (

ttInvalid,

ttBold, ttItalic, ttUnderline, ttStrike,

ttFontName, ttFontSize, ttFontColor, ttBackColor,

ttTab, ttTabF, ttSpace,

ttBreak, ttText, ttLink,

ttAlignLeft, ttAlignCenter, ttAlignRight);

TToken = class

Kind: TTokenKind;

TagClose: Boolean;

Text: String;

Value: Integer;

end;

TListToken = class(TObjectList<TToken>)

function GetLinkText(IEnd: Integer): String;

end;

TBuilder = class

private

Lb: TDzHTMLText;

L: TListToken;

LGroupBound: TList<Integer>; //bounds list of the group

{The list of created with the X position of limit where the group ends

CalcWidth, CalcHeight: Integer; //width and height to set at component when using auto

function ProcessTag(Tag: String): Boolean;

procedure AddToken(aKind: TTokenKind; aTagClose: Boolean = False; aText: String = ''; aValue: Integer = 0);

procedure BuildTokens; //create list of tokens

procedure BuildWords; //create list of words

procedure CheckAligns; //realign words

public

constructor Create;

destructor Destroy; override;

end;

constructor TBuilder.Create;

inherited;

L := TListToken.Create;

LGroupBound := TList<Integer>.Create;

end;

destructor TBuilder.Destroy;

L.Free;

LGroupBound.Free;

inherited;

end;

procedure TDzHTMLText.Rebuild;

var B: TBuilder;

if csLoading in ComponentState then Exit;

LWords.Clear; //clean old words

LLinkData.Clear; //clean old links

B := TBuilder.Create;

try

B.Lb := Self;

B.BuildTokens;

B.BuildWords;

B.CheckAligns;

FTextWidth := B.CalcWidth;

FTextHeight := B.CalcHeight;

if FAutoWidth then Width := B.CalcWidth;

if FAutoHeight then Height := B.CalcHeight;

finally

B.Free;

end;

end;

function ReplaceForcedChars(A: String): String;

//Allow tag characters at text

A := StringReplace(A, '&lt;', '<', [rfReplaceAll]);

A := StringReplace(A, '&gt;', '>', [rfReplaceAll]);

Result := A;

end;

function ParamToColor(A: String): TColor;

if A.StartsWith('$') then Insert('00', A, 2);

{At HTML, is used Hexadecimal color code with 6 digits, the same used at

try

Result := StringToColor(A);

except

Result := clNone;

end;

end;

procedure TBuilder.AddToken(aKind: TTokenKind; aTagClose: Boolean = False; aText: String = ''; aValue: Integer = 0);

var T: TToken;

T := TToken.Create;

T.Kind := aKind;

T.TagClose := aTagClose;

T.Text := aText;

T.Value := aValue;

L.Add(T);

end;

function TBuilder.ProcessTag(Tag: String): Boolean;

var TOff, TOn, HasPar: Boolean;

Kind: TTokenKind;

Value: Integer;

A, Par: String;

I: Integer;

//Result=True means valid tag

Result := False;

A := Tag;

TOff := False;

if A.StartsWith('/') then //closing tag

begin

TOff := True;

Delete(A, 1, 1);

end;

TOn := not TOff;

HasPar := False;

Par := '';

I := Pos(':', A); //find parameter

if I>0 then //has parameter

begin

HasPar := True;

Par := A;

Delete(Par, 1, I);

//Par := Copy(A, I+1, Length(A)-I);

A := Copy(A, 1, I-1);

end;

if TOff and HasPar then Exit; //tag closing with parameter

Value := 0;

A := UpperCase(A);

if (A='BR') and TOn and not HasPar then //LINE BREAK

begin

AddToken(ttBreak);

Result := True;

end else

if (A='B') and not HasPar then //BOLD

begin

AddToken(ttBold, TOff);

Result := True;

end else

if (A='I') and not HasPar then //ITALIC

begin

AddToken(ttItalic, TOff);

Result := True;

end else

if (A='U') and not HasPar then //UNDERLINE

begin

AddToken(ttUnderline, TOff);

Result := True;

end else

if (A='S') and not HasPar then //STRIKEOUT

begin

AddToken(ttStrike, TOff);

Result := True;

end else

if A='FN' then //FONT NAME

begin

if TOn and (Par='') then Exit;

AddToken(ttFontName, TOff, Par);

Result := True;

end else

if A='FS' then //FONT SIZE

begin

if TOn then

begin

Value := StrToIntDef(Par, 0);

if Value<=0 then Exit;

end;

AddToken(ttFontSize, TOff, '', Value);

Result := True;

end else

if A='FC' then //FONT COLOR

begin

if TOn then

begin

Value := ParamToColor(Par);

if Value=clNone then Exit;

end;

AddToken(ttFontColor, TOff, '', Value);

Result := True;

end else

if A='BC' then //BACKGROUND COLOR

begin

if TOn then

begin

Value := ParamToColor(Par);

if Value=clNone then Exit;

end;

AddToken(ttBackColor, TOff, '', Value);

Result := True;

end else

if A='A' then //LINK

begin

if TOn and HasPar and (Par='') then Exit;

AddToken(ttLink, TOff, Par);

Result := True;

end else

if (A='L') and not HasPar then //ALIGN LEFT

begin

AddToken(ttAlignLeft, TOff);

Result := True;

end else

if (A='C') and not HasPar then //ALIGN CENTER

begin

AddToken(ttAlignCenter, TOff);

Result := True;

end else

if (A='R') and not HasPar then //ALIGN RIGHT

begin

AddToken(ttAlignRight, TOff);

Result := True;

end else

if ((A='T') or (A='TF')) and TOn then //TAB

begin

Value := StrToIntDef(Par, 0);

if Value<=0 then Exit;

Kind := ttTab;

if A='TF' then Kind := ttTabF;

AddToken(Kind, TOff, '', Value);

Result := True;

end;

end;

procedure TBuilder.BuildTokens;

var Text, A: String;

CharIni: Char;

I, Jump: Integer;

Text := StringReplace(Lb.FText, #13#10, '<BR>', [rfReplaceAll]);

while Text<>'' do

begin

A := Text;

CharIni := A[1];

if CharIni = '<' then //starts with tag opening

begin

Delete(A, 1, 1);

I := Pos('>', A); //find tag closing

if I>0 then

begin

A := Copy(A, 1, I-1);

if not ProcessTag(A) then AddToken(ttInvalid);

Jump := 1+Length(A)+1;

end else

begin

//losted tag opening

AddToken(ttInvalid);

Jump := 1;

end;

end else

if CharIni = '>' then

begin

//losted tag closing

AddToken(ttInvalid);

Jump := 1;

end else

if CharIni = ' ' then //space

begin

AddToken(ttSpace, False, ' ');

Jump := 1;

end else

if CharInSet(CharIni, ['/','\']) then

begin

//this is to break line when using paths

AddToken(ttText, False, CharIni);

Jump := 1;

end else

begin //all the rest is text

I := A.IndexOfAny([' ','<','>','/','\'])+1; //warning: 0-based function!!!

if I=0 then I := Length(A)+1;

Dec(I);

A := Copy(A, 1, I);

AddToken(ttText, False, ReplaceForcedChars(A));

Jump := I;

end;

Delete(Text, 1, Jump);

end;

end;

TListStack<T> = class(TList<T>)

procedure AddOrDel(Token: TToken; const XValue: T);

end;

procedure TListStack<T>.AddOrDel(Token: TToken; const XValue: T);

if Token.TagClose then

begin

if Count>1 then

Delete(Count-1);

end else

Add(XValue);

end;

procedure TBuilder.BuildWords;

var C: TCanvas;

X, Y, HighW, HighH, LineCount: Integer;

LastTabF: Boolean; //last tabulation was TabF (with break align)

LastTabF_X: Integer;

procedure DoLineBreak;

begin

if HighH=0 then HighH := C.TextHeight(' '); //line without content

Inc(Y, HighH); //inc biggest height of the line

HighH := 0; //clear line height

if X>HighW then HighW := X; //store width of biggest line

X := 0; //carriage return :)

if LastTabF then X := LastTabF_X; //last line breaks with TabF

LGroupBound.Add(Lb.Width); //add line bound to use in group align

Inc(LineCount);

end;

T: TToken;

I: Integer;

Ex: TSize; FS: TFontStyles; PreWidth: Integer;

LinkOn: Boolean;

LinkID: Integer;

BackColor: TColor;

Align: TAlignment;

LBold: TListStack<Boolean>;

LItalic: TListStack<Boolean>;

LUnderline: TListStack<Boolean>;

LStrike: TListStack<Boolean>;

LFontName: TListStack<String>;

LFontSize: TListStack<Integer>;

LFontColor: TListStack<TColor>;

LBackColor: TListStack<TColor>;

LAlign: TListStack<TAlignment>;

LinkData: TDHLinkData;

vBool: Boolean; //Required for Lazarus

C := Lb.Canvas;

C.Font.Assign(Lb.Font);

BackColor := clNone;

Align := taLeftJustify;