1705 lines
42 KiB
ObjectPascal
1705 lines
42 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport v4.0 }
|
|
{ Graphic routines }
|
|
{ }
|
|
{ Copyright (c) 1998-2011 }
|
|
{ by Alexander Tzyganenko, }
|
|
{ Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit FMX.frxGraphicUtils;
|
|
|
|
interface
|
|
|
|
{$I fmx.inc}
|
|
{$I frx.inc}
|
|
|
|
uses
|
|
System.SysUtils, System.Classes, System.UITypes, System.UIConsts, System.StrUtils,
|
|
System.WideStrings, System.Types, System.Variants, System.Generics.Collections,
|
|
System.Math, FMX.Types, FMX.Forms,
|
|
FMX.frxFMX, FMX.frxClass
|
|
{$IFDEF DELPHI19}
|
|
, FMX.Graphics
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI20}
|
|
, System.Math.Vectors
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI28}
|
|
, FMX.BaseTypeAliases
|
|
{$ENDIF};
|
|
|
|
type
|
|
TBaseLine = (Normal, Subscript, Superscript);
|
|
|
|
TStyleDescriptor = record
|
|
FontStyle: TFontStyles;
|
|
Color: TAlphaColor;
|
|
BaseLine: TBaseLine;
|
|
end;
|
|
|
|
TParagraph = class;
|
|
TLine = class;
|
|
TWord = class;
|
|
TRun = class;
|
|
|
|
TSubStyle = (ssNormal, ssSubscript, ssSuperscript);
|
|
|
|
TfrxHTMLTag = class(TObject)
|
|
public
|
|
Position: Integer;
|
|
Size: Integer;
|
|
AddY: Integer;
|
|
Style: TFontStyles;
|
|
Color: TAlphaColor;
|
|
Default: Boolean;
|
|
Small: Boolean;
|
|
DontWRAP: Boolean;
|
|
SubType: TSubStyle;
|
|
procedure Assign(Tag: TfrxHTMLTag);
|
|
end;
|
|
|
|
TfrxHTMLTags = class(TObject)
|
|
private
|
|
FItems: TList;
|
|
procedure Add(Tag: TfrxHTMLTag);
|
|
function GetItems(Index: Integer): TfrxHTMLTag;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
function Count: Integer;
|
|
property Items[Index: Integer]: TfrxHTMLTag read GetItems; default;
|
|
end;
|
|
|
|
TfrxHTMLTagsList = class(TObject)
|
|
private
|
|
FAllowTags: Boolean;
|
|
FAddY: Integer;
|
|
FColor: Integer;
|
|
FDefColor: LongInt;
|
|
FDefSize: Integer;
|
|
FDefStyle: TFontStyles;
|
|
FItems: TList;
|
|
FPosition: Integer;
|
|
FSize: Integer;
|
|
FStyle: TFontStyles;
|
|
FDontWRAP: Boolean;
|
|
FSubStyle: TSubStyle;
|
|
procedure NewLine;
|
|
function Add: TfrxHTMLTag;
|
|
function GetItems(Index: Integer): TfrxHTMLTags;
|
|
function GetPrevTag: TfrxHTMLTag;
|
|
protected
|
|
procedure Wrap(TagsCount: Integer; AddBreak: Boolean);
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Clear;
|
|
procedure SetDefaults(DefColor: TColor; DefSize: Integer;
|
|
DefStyle: TFontStyles);
|
|
procedure ExpandHTMLTags(var s: WideString);
|
|
function Count: Integer;
|
|
property AllowTags: Boolean read FAllowTags write FAllowTags;
|
|
property Items[Index: Integer]: TfrxHTMLTags read GetItems; default;
|
|
property Position: Integer read FPosition write FPosition;
|
|
end;
|
|
|
|
TAdvancedTextRenderer = class
|
|
private
|
|
FParagraphs: TList<TParagraph>;
|
|
FText: String;
|
|
FCanvas: TCanvas;
|
|
FFont: TfrxFont;
|
|
FDisplayRect: TRectF;
|
|
FHorzAlign: TfrxHAlign;
|
|
FVertAlign: TfrxVAlign;
|
|
FLineHeight: Single;
|
|
FFontLineHeight: Single;
|
|
FAngle: Integer;
|
|
FForceJustify: Boolean;
|
|
FWysiwyg: Boolean;
|
|
FHtmlTags: Boolean;
|
|
FWordWrap: Boolean;
|
|
FRightToLeft: Boolean;
|
|
FPDFMode: Boolean;
|
|
FSpaceWidth: Single;
|
|
FSymbolWidth: Single;
|
|
FScaleFactor: Single;
|
|
FFastRender: TfrxFastCanvasLayer;
|
|
procedure SplitToParagraphs(const text: String);
|
|
procedure AdjustParagraphLines;
|
|
public
|
|
constructor Create(aCanvas: TCanvas; const aText: String; aFont: TfrxFont; rect: TRectF;
|
|
aHorzAlign: TfrxHAlign; aVertAlign: TfrxVAlign; aLineHeight: Single; aAngle: Integer;
|
|
aWordWrap: Boolean; aForceJustify: Boolean; aHtmlTags: Boolean; aPdfMode: Boolean; aScaLeFactor: Single);
|
|
destructor Destroy; override;
|
|
function CalcWidth: Single;
|
|
function MeasureTextWidth(const aText: String): Single;
|
|
function CalcHeight: Single; overload;
|
|
function CalcHeight(var charsFit: Integer; var style: TStyleDescriptor): Single; overload;
|
|
function GetTabPosition(pos: Single): Single;
|
|
procedure Draw;
|
|
property Paragraphs: TList<TParagraph> read FParagraphs;
|
|
property Canvas: TCanvas read FCanvas;
|
|
property Font: TfrxFont read FFont;
|
|
property DisplayRect: TRectF read FDisplayRect;
|
|
property HorzAlign: TfrxHAlign read FHorzAlign;
|
|
property VertAlign: TfrxVAlign read FVertAlign;
|
|
property LineHeight: Single read FLineHeight;
|
|
property FontLineHeight: Single read FFontLineHeight;
|
|
property Angle: Integer read FAngle;
|
|
property ForceJustify: Boolean read FForceJustify;
|
|
property Wysiwyg: Boolean read FWysiwyg;
|
|
property HtmlTags: Boolean read FHtmlTags;
|
|
property WordWrap: Boolean read FWordWrap;
|
|
property RightToLeft: Boolean read FRightToLeft;
|
|
property PDFMode: Boolean read FPDFMode;
|
|
property SpaceWidth: Single read FSpaceWidth;
|
|
property SymbolWidth: Single read FSymbolWidth;
|
|
end;
|
|
|
|
TParagraph = class
|
|
private
|
|
FLines: TList<TLine>;
|
|
FRenderer: TAdvancedTextRenderer;
|
|
FText: String;
|
|
FOriginalCharIndex: Integer;
|
|
public
|
|
constructor Create(const text: String; renderer: TAdvancedTextRenderer; originalCharIndex: Integer);
|
|
destructor Destroy; override;
|
|
function IsLast: Boolean;
|
|
function IsEmpty: Boolean;
|
|
function WrapLines(style: TStyleDescriptor): TStyleDescriptor;
|
|
procedure AlignLines(forceJustify: Boolean);
|
|
procedure Draw;
|
|
property Lines: TList<TLine> read FLines;
|
|
property Renderer: TAdvancedTextRenderer read FRenderer;
|
|
end;
|
|
|
|
TLine = class
|
|
private
|
|
FWords: TList<TWord>;
|
|
FParagraph: TParagraph;
|
|
FTop: Single;
|
|
FWidth: Single;
|
|
FOriginalCharIndex: Integer;
|
|
FUnderlines: TList<TRectF>;
|
|
FStrikeouts: TList<TRectF>;
|
|
function GetStyle: TStyleDescriptor;
|
|
function GetRenderer: TAdvancedTextRenderer;
|
|
function GetLeft: Single;
|
|
procedure PrepareUnderlines(list: TList<TRectF>; style: TFontStyle);
|
|
function GetText: String;
|
|
public
|
|
constructor Create(paragraph: TParagraph; originalCharIndex: Integer);
|
|
destructor Destroy; override;
|
|
function IsLast: Boolean;
|
|
procedure AlignWords(align: TfrxHAlign);
|
|
procedure MakeUnderlines;
|
|
procedure Draw;
|
|
property Words: TList<TWord> read FWords;
|
|
property Left: Single read GetLeft;
|
|
property Top: Single read FTop write FTop;
|
|
property Width: Single read FWidth;
|
|
property Text: String read GetText;
|
|
property OriginalCharIndex: Integer read FOriginalCharIndex;
|
|
property Renderer: TAdvancedTextRenderer read GetRenderer;
|
|
property Style: TStyleDescriptor read GetStyle;
|
|
property Underlines: TList<TRectF> read FUnderlines;
|
|
property Strikeouts: TList<TRectF> read FStrikeouts;
|
|
end;
|
|
|
|
TWord = class
|
|
private
|
|
FRuns: TList<TRun>;
|
|
FLeft: Single;
|
|
FWidth: Single;
|
|
FLine: TLine;
|
|
function GetWidth: Single;
|
|
function GetTop: Single;
|
|
function GetRenderer: TAdvancedTextRenderer;
|
|
function GetText: String;
|
|
public
|
|
constructor Create(aLine: TLine);
|
|
destructor Destroy; override;
|
|
procedure AdjustRuns;
|
|
procedure SetLine(aLine: TLine);
|
|
procedure Draw;
|
|
property Left: Single read FLeft write FLeft;
|
|
property Width: Single read GetWidth;
|
|
property Top: Single read GetTop;
|
|
property Text: String read GetText;
|
|
property Renderer: TAdvancedTextRenderer read GetRenderer;
|
|
property Runs: TList<TRun> read FRuns;
|
|
end;
|
|
|
|
TTab = class(TWord);
|
|
|
|
TRun = class
|
|
private
|
|
FText: String;
|
|
FStyle: TStyleDescriptor;
|
|
FWord: TWord;
|
|
FLeft: Single;
|
|
FWidth: Single;
|
|
function GetRenderer: TAdvancedTextRenderer;
|
|
function GetTop: Single;
|
|
function GetFont(disableUnderlinesStrikeouts: Boolean): TfrxFont; overload;
|
|
public
|
|
constructor Create(const aText: String; aStyle: TStyleDescriptor; aWord: TWord);
|
|
function GetFont: TfrxFont; overload;
|
|
procedure Draw;
|
|
property Text: String read FText;
|
|
property Style: TStyleDescriptor read FStyle;
|
|
property Renderer: TAdvancedTextRenderer read GetRenderer;
|
|
property Left: Single read FLeft write FLeft;
|
|
property Top: Single read GetTop;
|
|
property Width: Single read FWidth;
|
|
end;
|
|
|
|
implementation
|
|
{ TStyleDescriptor routines }
|
|
|
|
function StyleDescriptor(FontStyle: TFontStyles; Color: TAlphaColor; BaseLine: TBaseLine): TStyleDescriptor;
|
|
begin
|
|
Result.FontStyle := FontStyle;
|
|
Result.Color := Color;
|
|
Result.BaseLine := BaseLine;
|
|
end;
|
|
|
|
function NullStyle: TStyleDescriptor;
|
|
begin
|
|
Result.FontStyle := [];
|
|
Result.Color := 0;
|
|
Result.BaseLine := TBaseLine.Normal;
|
|
end;
|
|
|
|
function StyleDescriptorToString(style: TStyleDescriptor): String;
|
|
begin
|
|
Result := '';
|
|
|
|
if fsBold in style.FontStyle then
|
|
Result := Result + '<b>';
|
|
if fsItalic in style.FontStyle then
|
|
Result := Result + '<i>';
|
|
if fsUnderline in style.FontStyle then
|
|
Result := Result + '<u>';
|
|
if fsStrikeout in style.FontStyle then
|
|
Result := Result + '<strike>';
|
|
if style.BaseLine = TBaseLine.Subscript then
|
|
Result := Result + '<sub>';
|
|
if style.BaseLine = TBaseLine.Superscript then
|
|
Result := Result + '<sup>';
|
|
|
|
Result := Result + '<font color="' + AlphaColorToString(style.Color) + '">';
|
|
end;
|
|
|
|
function AdjY(Value, Thickness: Single): Single;
|
|
begin
|
|
Result := Round(Value);
|
|
if (Trunc(Thickness) mod 2) = 1 then
|
|
Result := Result + 0.5;
|
|
end;
|
|
|
|
{ TfrxHTMLTag }
|
|
|
|
procedure TfrxHTMLTag.Assign(Tag: TfrxHTMLTag);
|
|
begin
|
|
Position := Tag.Position;
|
|
Size := Tag.Size;
|
|
AddY := Tag.AddY;
|
|
Style := Tag.Style;
|
|
Color := Tag.Color;
|
|
Default := Tag.Default;
|
|
Small := Tag.Small;
|
|
Self.SubType := Tag.SubType;
|
|
end;
|
|
|
|
|
|
{ TfrxHTMLTags }
|
|
|
|
constructor TfrxHTMLTags.Create;
|
|
begin
|
|
FItems := TList.Create;
|
|
end;
|
|
|
|
destructor TfrxHTMLTags.Destroy;
|
|
begin
|
|
Clear;
|
|
FItems.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxHTMLTags.Clear;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FItems.Count - 1 do
|
|
TfrxHTMLTag(FItems[i]).Free;
|
|
FItems.Clear;
|
|
end;
|
|
|
|
function TfrxHTMLTags.GetItems(Index: Integer): TfrxHTMLTag;
|
|
begin
|
|
Result := TfrxHTMLTag(FItems[Index]);
|
|
end;
|
|
|
|
function TfrxHTMLTags.Count: Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
procedure TfrxHTMLTags.Add(Tag: TfrxHTMLTag);
|
|
begin
|
|
FItems.Add(Tag);
|
|
end;
|
|
|
|
|
|
{ TfrxHTMLTagsList }
|
|
|
|
constructor TfrxHTMLTagsList.Create;
|
|
begin
|
|
FItems := TList.Create;
|
|
FAllowTags := True;
|
|
end;
|
|
|
|
destructor TfrxHTMLTagsList.Destroy;
|
|
begin
|
|
Clear;
|
|
FItems.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxHTMLTagsList.Clear;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to FItems.Count - 1 do
|
|
TfrxHTMLTags(FItems[i]).Free;
|
|
FItems.Clear;
|
|
end;
|
|
|
|
procedure TfrxHTMLTagsList.NewLine;
|
|
begin
|
|
if Count <> 0 then
|
|
FItems.Add(TfrxHTMLTags.Create);
|
|
end;
|
|
|
|
procedure TfrxHTMLTagsList.Wrap(TagsCount: Integer; AddBreak: Boolean);
|
|
var
|
|
i: Integer;
|
|
Line, OldLine: TfrxHTMLTags;
|
|
NewTag: TfrxHTMLTag;
|
|
begin
|
|
OldLine := Items[Count - 1];
|
|
if OldLine.Count <= TagsCount then
|
|
Exit;
|
|
|
|
NewLine;
|
|
Line := Items[Count - 1];
|
|
for i := TagsCount to OldLine.Count - 1 do
|
|
Line.Add(OldLine[i]);
|
|
OldLine.FItems.Count := TagsCount;
|
|
if AddBreak then
|
|
begin
|
|
NewTag := TfrxHTMLTag.Create;
|
|
OldLine.FItems.Add(NewTag);
|
|
NewTag.Assign(TfrxHTMLTag(OldLine.FItems[TagsCount - 1]))
|
|
end
|
|
else if Line[0].Default then
|
|
Line[0].Assign(OldLine[TagsCount - 1]);
|
|
end;
|
|
|
|
function TfrxHTMLTagsList.Count: Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
function TfrxHTMLTagsList.GetItems(Index: Integer): TfrxHTMLTags;
|
|
begin
|
|
Result := TfrxHTMLTags(FItems[Index]);
|
|
end;
|
|
|
|
function TfrxHTMLTagsList.Add: TfrxHTMLTag;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result := TfrxHTMLTag.Create;
|
|
i := Count - 1;
|
|
if i = -1 then
|
|
begin
|
|
FItems.Add(TfrxHTMLTags.Create);
|
|
i := 0;
|
|
end;
|
|
Items[i].Add(Result);
|
|
end;
|
|
|
|
function TfrxHTMLTagsList.GetPrevTag: TfrxHTMLTag;
|
|
var
|
|
Tags: TfrxHTMLTags;
|
|
begin
|
|
Result := nil;
|
|
Tags := Items[Count - 1];
|
|
if Tags.Count > 1 then
|
|
Result := Tags[Tags.Count - 2]
|
|
else if Count > 1 then
|
|
begin
|
|
Tags := Items[Count - 2];
|
|
Result := Tags[Tags.Count - 1];
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxHTMLTagsList.SetDefaults(DefColor: TColor; DefSize: Integer;
|
|
DefStyle: TFontStyles);
|
|
begin
|
|
FDefColor := DefColor;
|
|
FDefSize := DefSize;
|
|
FDefStyle := DefStyle;
|
|
FAddY := 0;
|
|
FColor := FDefColor;
|
|
FSize := FDefSize;
|
|
FStyle := FDefStyle;
|
|
FDontWRAP := False;
|
|
FPosition := 1;
|
|
Self.FSubStyle := ssNormal;
|
|
Clear;
|
|
end;
|
|
|
|
procedure TfrxHTMLTagsList.ExpandHTMLTags(var s: WideString);
|
|
var
|
|
i, j, j1: Integer;
|
|
b: Boolean;
|
|
cl: WideString;
|
|
|
|
procedure AddTag;
|
|
var
|
|
Tag, PrevTag: TfrxHTMLTag;
|
|
begin
|
|
Tag := Add;
|
|
Tag.Position := FPosition; // this will help us to get position in the original text
|
|
Tag.Size := FSize;
|
|
Tag.Style := FStyle;
|
|
Tag.Color := FColor;
|
|
Tag.AddY := FAddY;
|
|
Tag.DontWRAP := FDontWRAP;
|
|
Tag.SubType := Self.FSubStyle;
|
|
// when "Default" changes, we need to set Font.Style, Size and Color
|
|
if FAllowTags then
|
|
begin
|
|
PrevTag := GetPrevTag;
|
|
if PrevTag <> nil then
|
|
Tag.Default := (FStyle = PrevTag.Style) and
|
|
(Cardinal(FColor) = PrevTag.Color) and
|
|
(FSize = PrevTag.Size) and (FAddY = PrevTag.AddY) and (FDontWRAP = PrevTag.DontWRAP)
|
|
else
|
|
Tag.Default := (FStyle = FDefStyle) and (FColor = FDefColor) and (FSize = FDefSize);
|
|
end
|
|
else
|
|
Tag.Default := True;
|
|
Tag.Small := FSize <> FDefSize;
|
|
end;
|
|
|
|
begin
|
|
i := 1;
|
|
if Length(s) = 0 then Exit;
|
|
|
|
while i <= Length(s) do
|
|
begin
|
|
b := True;
|
|
|
|
if FAllowTags then
|
|
if s[i] = '<' then
|
|
begin
|
|
|
|
// <b>, <u>, <i> tags
|
|
if (i + 2 <= Length(s)) and (s[i + 2] = '>') then
|
|
begin
|
|
case s[i + 1] of
|
|
'b','B': FStyle := FStyle + [fsBold];
|
|
'i','I': FStyle := FStyle + [fsItalic];
|
|
'u','U': FStyle := FStyle + [fsUnderline];
|
|
else
|
|
b := False;
|
|
end;
|
|
if b then
|
|
begin
|
|
System.Delete(s, i, 3);
|
|
Inc(FPosition, 3);
|
|
continue;
|
|
end;
|
|
end
|
|
|
|
// <sub>, <sup> tags
|
|
else if (i + 4 <= Length(s)) and (s[i + 4] = '>') then
|
|
begin
|
|
if Pos('SUB>', AnsiUpperCase(s)) = i + 1 then
|
|
begin
|
|
FSize := Round(FDefSize / 1.5);
|
|
FAddY := 1;
|
|
b := True;
|
|
Self.FSubStyle := ssSubscript;
|
|
end
|
|
else if Pos('SUP>', AnsiUpperCase(s)) = i + 1 then
|
|
begin
|
|
FSize := Round(FDefSize / 1.5);
|
|
FAddY := 0;
|
|
b := True;
|
|
Self.FSubStyle := ssSuperscript;
|
|
end;
|
|
if b then
|
|
begin
|
|
System.Delete(s, i, 5);
|
|
Inc(FPosition, 5);
|
|
continue;
|
|
end;
|
|
end
|
|
|
|
// <sub>, <sup> tags
|
|
else if (i + 5 <= Length(s)) and (s[i + 5] = '>') then
|
|
begin
|
|
if (Pos('/SUB>', AnsiUpperCase(s)) = i + 1) or (Pos('/SUP>', AnsiUpperCase(s)) = i + 1) then
|
|
begin
|
|
FSize := FDefSize;
|
|
FAddY := 0;
|
|
b := True;
|
|
Self.FSubStyle := ssNormal;
|
|
end;
|
|
if b then
|
|
begin
|
|
System.Delete(s, i, 6);
|
|
Inc(FPosition, 6);
|
|
continue;
|
|
end;
|
|
end
|
|
|
|
|
|
else if (i + 7 <= Length(s)) and ((s[i + 1] = 'n') or (s[i + 1] = 'N')) then
|
|
begin
|
|
if Pos('NOWRAP>', AnsiUpperCase(s)) = i + 1 then
|
|
begin
|
|
FDontWRAP := True;
|
|
System.Delete(s, i, 8);
|
|
Inc(FPosition, 8);
|
|
continue;
|
|
end;
|
|
end
|
|
|
|
// <strike> tag
|
|
else if (i + 1 <= Length(s)) and ((s[i + 1] = 's') or (s[i + 1] = 'S')) then
|
|
begin
|
|
if Pos('STRIKE>', AnsiUpperCase(s)) = i + 1 then
|
|
begin
|
|
FStyle := FStyle + [fsStrikeOut];
|
|
System.Delete(s, i, 8);
|
|
Inc(FPosition, 8);
|
|
continue;
|
|
end;
|
|
end
|
|
|
|
// </b>, </u>, </i>, </strike>, </font>, </sub>, </sup> tags
|
|
else if (i + 1 <= Length(s)) and (s[i + 1] = '/') then
|
|
begin
|
|
if (i + 3 <= Length(s)) and (s[i + 3] = '>') then
|
|
begin
|
|
case s[i + 2] of
|
|
'b','B': FStyle := FStyle - [fsBold];
|
|
'i','I': FStyle := FStyle - [fsItalic];
|
|
'u','U': FStyle := FStyle - [fsUnderline];
|
|
else
|
|
b := False;
|
|
end;
|
|
if b then
|
|
begin
|
|
System.Delete(s, i, 4);
|
|
Inc(FPosition, 4);
|
|
continue;
|
|
end;
|
|
end
|
|
else if (Pos('STRIKE>', AnsiUpperCase(s)) = i + 2) then
|
|
begin
|
|
FStyle := FStyle - [fsStrikeOut];
|
|
System.Delete(s, i, 9);
|
|
Inc(FPosition, 9);
|
|
continue;
|
|
end
|
|
else if (Pos('NOWRAP>', AnsiUpperCase(s)) = i + 2) then
|
|
begin
|
|
FDontWRAP := False;
|
|
System.Delete(s, i, 9);
|
|
Inc(FPosition, 9);
|
|
continue;
|
|
end
|
|
else if Pos('FONT>', AnsiUpperCase(s)) = i + 2 then
|
|
begin
|
|
FColor := FDefColor;
|
|
System.Delete(s, i, 7);
|
|
Inc(FPosition, 7);
|
|
continue;
|
|
end
|
|
else if (Pos('SUB>', AnsiUpperCase(s)) = i + 2) or
|
|
(Pos('SUP>', AnsiUpperCase(s)) = i + 2) then
|
|
begin
|
|
FSize := FDefSize;
|
|
FAddY := 0;
|
|
System.Delete(s, i, 6);
|
|
Inc(FPosition, 6);
|
|
continue;
|
|
end
|
|
end
|
|
|
|
// <font color = ...> tag
|
|
else if Pos('FONT COLOR', AnsiUpperCase(s)) = i + 1 then
|
|
begin
|
|
j := i + 11;
|
|
while (j <= Length(s)) and (s[j] <> '=') do
|
|
Inc(j);
|
|
Inc(j);
|
|
while (j <= Length(s)) and (s[j] = ' ') do
|
|
Inc(j);
|
|
j1 := j;
|
|
while (j <= Length(s)) and (s[j] <> '>') do
|
|
Inc(j);
|
|
|
|
cl := Copy(s, j1, j - j1);
|
|
if cl <> '' then
|
|
begin
|
|
if (Length(cl) > 3) and (cl[1] = '"') and (cl[2] = '#') and
|
|
(cl[Length(cl)] = '"') then
|
|
begin
|
|
cl := '$' + Copy(cl, 3, Length(cl) - 3);
|
|
FColor := StrToInt(cl);
|
|
FColor := (FColor and $000000FF) div 65536 +
|
|
(FColor and $00FF0000) * 65536 +
|
|
(FColor and $0000FF00);
|
|
System.Delete(s, i, j - i + 1);
|
|
Inc(FPosition, j - i + 1);
|
|
continue;
|
|
end
|
|
else if IdentToAlphaColor('cl' + cl, FColor) then
|
|
begin
|
|
System.Delete(s, i, j - i + 1);
|
|
Inc(FPosition, j - i + 1);
|
|
continue;
|
|
end;
|
|
end;
|
|
end
|
|
end;
|
|
|
|
AddTag;
|
|
Inc(i);
|
|
Inc(FPosition);
|
|
end;
|
|
|
|
if Length(s) = 0 then
|
|
begin
|
|
AddTag;
|
|
s := ' ';
|
|
end;
|
|
end;
|
|
|
|
{ TAdvancedTextRenderer }
|
|
|
|
function TAdvancedTextRenderer.MeasureTextWidth(const aText: String): Single;
|
|
var
|
|
r: TRectF;
|
|
begin
|
|
r := RectF(0, 0, 10000, 10000);
|
|
if FFastRender <> nil then
|
|
FFastRender.MeasureText(r, aText, False, [], TTextAlign.taLeading, TTextAlign.taLeading)
|
|
else
|
|
Canvas.MeasureText(r, aText, False, [], TTextAlign.taLeading, TTextAlign.taLeading);
|
|
Result := r.Width;
|
|
end;
|
|
|
|
procedure TAdvancedTextRenderer.SplitToParagraphs(const text: String);
|
|
var
|
|
style: TStyleDescriptor;
|
|
lines: TStringDynArray;
|
|
line: String;
|
|
i, lineLength, originalCharIndex: Integer;
|
|
paragraph: TParagraph;
|
|
begin
|
|
style := StyleDescriptor(Font.Style, Font.Color, TBaseLine.Normal);
|
|
lines := SplitString(text, #10);
|
|
originalCharIndex := 0;
|
|
|
|
for i := 0 to Length(lines) - 1 do
|
|
begin
|
|
line := lines[i];
|
|
lineLength := Length(line);
|
|
if (lineLength > 0) and (line[lineLength] = #13) then
|
|
Delete(line, lineLength, 1);
|
|
|
|
paragraph := TParagraph.Create(line, self, originalCharIndex);
|
|
FParagraphs.Add(paragraph);
|
|
style := paragraph.WrapLines(style);
|
|
|
|
Inc(originalCharIndex, lineLength + 1);
|
|
end;
|
|
|
|
// skip empty paragraphs at the end
|
|
for i := FParagraphs.Count - 1 downto 0 do
|
|
begin
|
|
if FParagraphs[i].IsEmpty then
|
|
begin
|
|
FParagraphs[i].Free;
|
|
FParagraphs.Delete(i);
|
|
end
|
|
else
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
procedure TAdvancedTextRenderer.AdjustParagraphLines;
|
|
var
|
|
i: Integer;
|
|
height, offsetY: Single;
|
|
paragraph: TParagraph;
|
|
line: TLine;
|
|
begin
|
|
// calculate text height
|
|
height := 0;
|
|
for paragraph in Paragraphs do
|
|
height := height + paragraph.Lines.Count * LineHeight;
|
|
|
|
// calculate Y offset
|
|
offsetY := DisplayRect.Top;
|
|
if VertAlign = vaCenter then
|
|
offsetY := offsetY + (DisplayRect.Height - height) / 2
|
|
else if VertAlign = vaBottom then
|
|
offsetY := offsetY + (DisplayRect.Height - height) - 1;
|
|
|
|
for i := 0 to Paragraphs.Count - 1 do
|
|
begin
|
|
paragraph := Paragraphs[i];
|
|
paragraph.AlignLines((i = Paragraphs.Count - 1) and ForceJustify);
|
|
|
|
// adjust line tops
|
|
for line in paragraph.Lines do
|
|
begin
|
|
line.Top := offsetY;
|
|
line.MakeUnderlines;
|
|
offsetY := offsetY + LineHeight;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TAdvancedTextRenderer.Draw;
|
|
var
|
|
state: TCanvasSaveState;
|
|
m, OldM: TMatrix;
|
|
paragraph: TParagraph;
|
|
begin
|
|
// set clipping
|
|
// avoid bug under win platform, after state restore matrix has unexpected values
|
|
OldM := Canvas.Matrix;
|
|
State := Canvas.SaveState;
|
|
|
|
try
|
|
{ increase bounds for 2 pixels }
|
|
{ increase Top for 1 * Scale (preview or print) pixels for subscripts }
|
|
Canvas.IntersectClipRect(RectF(DisplayRect.Left, DisplayRect.Top - 1 * FScaleFactor, DisplayRect.Right + 2, DisplayRect.Bottom));
|
|
|
|
if Angle <> 0 then
|
|
begin
|
|
m := CreateRotationMatrix(-DegToRad(Angle));
|
|
// offset
|
|
m.m31 := OldM.m31 + DisplayRect.Left + DisplayRect.Width / 2;
|
|
m.m32 := OldM.m32 + DisplayRect.Top + DisplayRect.Height / 2;
|
|
Canvas.SetMatrix(m);
|
|
end;
|
|
|
|
for paragraph in Paragraphs do
|
|
paragraph.Draw;
|
|
|
|
finally
|
|
// restore clipping
|
|
Canvas.RestoreState(state);
|
|
Canvas.SetMatrix(OldM);
|
|
end;
|
|
end;
|
|
|
|
function TAdvancedTextRenderer.CalcHeight: Single;
|
|
var
|
|
charsFit: Integer;
|
|
style: TStyleDescriptor;
|
|
begin
|
|
Result := CalcHeight(charsFit, style);
|
|
end;
|
|
|
|
function TAdvancedTextRenderer.CalcHeight(var charsFit: Integer; var style: TStyleDescriptor): Single;
|
|
var
|
|
i, j: Integer;
|
|
height, displayHeight: Single;
|
|
line: TLine;
|
|
begin
|
|
charsFit := 0;
|
|
style := NullStyle;
|
|
height := 0;
|
|
displayHeight := DisplayRect.Height;
|
|
if LineHeight > displayHeight then
|
|
begin
|
|
Result := 0;
|
|
Exit;
|
|
end;
|
|
|
|
for i := 0 to Paragraphs.Count - 1 do
|
|
begin
|
|
for j := 0 to Paragraphs[i].Lines.Count - 1 do
|
|
begin
|
|
line := Paragraphs[i].Lines[j];
|
|
height := height + LineHeight;
|
|
if (charsFit = 0) and (height > displayHeight) then
|
|
begin
|
|
charsFit := line.OriginalCharIndex;
|
|
if HtmlTags then
|
|
style := line.Style;
|
|
height := height - LineHeight;
|
|
break;
|
|
end;
|
|
end;
|
|
if (charsFit <> 0) then break;
|
|
end;
|
|
|
|
if charsFit = 0 then
|
|
charsFit := Length(FText);
|
|
Result := height ;
|
|
end;
|
|
|
|
function TAdvancedTextRenderer.CalcWidth: Single;
|
|
var
|
|
paragraph: TParagraph;
|
|
line: TLine;
|
|
width: Single;
|
|
begin
|
|
width := 0;
|
|
|
|
for paragraph in Paragraphs do
|
|
for line in paragraph.Lines do
|
|
begin
|
|
if width < line.Width then
|
|
width := line.Width;
|
|
end;
|
|
|
|
Result := width + FSpaceWidth;
|
|
end;
|
|
|
|
function TAdvancedTextRenderer.GetTabPosition(pos: Single): Single;
|
|
var
|
|
tabOffset, tabSize: Single;
|
|
tabPosition: Integer;
|
|
begin
|
|
tabOffset := 0;
|
|
tabSize := 64;
|
|
tabPosition := Trunc((pos - tabOffset) / tabSize);
|
|
if pos < tabOffset then
|
|
Result := tabOffset
|
|
else
|
|
Result := (tabPosition + 1) * tabSize + tabOffset;
|
|
end;
|
|
|
|
constructor TAdvancedTextRenderer.Create(aCanvas: TCanvas; const aText: String;
|
|
aFont: TfrxFont; rect: TRectF; aHorzAlign: TfrxHAlign; aVertAlign: TfrxVAlign;
|
|
aLineHeight: Single; aAngle: Integer; aWordWrap: Boolean; aForceJustify: Boolean;
|
|
aHtmlTags: Boolean; aPdfMode: Boolean; aScaLeFactor: Single);
|
|
begin
|
|
if aCanvas is TfrxFastCanvasLayer then
|
|
begin
|
|
FFastRender := TfrxFastCanvasLayer(aCanvas);
|
|
FCanvas := FFastRender.Canvas;
|
|
end
|
|
else
|
|
FCanvas := aCanvas;
|
|
FScaleFactor := aScaLeFactor;
|
|
if SameValue(FScaleFactor, 0, 0.09) then
|
|
FScaleFactor := 0.1;
|
|
FParagraphs := TList<TParagraph>.Create;
|
|
FText := aText;
|
|
FFont := aFont;
|
|
FDisplayRect := rect;
|
|
FHorzAlign := aHorzAlign;
|
|
FVertAlign := aVertAlign;
|
|
FLineHeight := aLineHeight;
|
|
FFontLineHeight := aFont.GetHeight(FCanvas) + 2;
|
|
if FLineHeight = 0 then
|
|
FLineHeight := FFontLineHeight
|
|
else
|
|
FFontLineHeight := FLineHeight;
|
|
FAngle := aAngle;
|
|
FWordWrap := aWordWrap;
|
|
FForceJustify := aForceJustify;
|
|
FHtmlTags := aHtmlTags;
|
|
FPDFMode := aPdfMode;
|
|
aFont.AssignToCanvas(FCanvas);
|
|
{$IFDEF DELPHI25}
|
|
{$IFDEF MSWINDOWS}
|
|
// workaround for Tokyo - DoRenderLayout now has MeasureString call and calculates one space symbol incorrect
|
|
FSpaceWidth := Round(MeasureTextWidth(' ') / 5 );
|
|
{$ELSE}
|
|
FSpaceWidth := MeasureTextWidth(' ');
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
FSpaceWidth := MeasureTextWidth(' ');
|
|
{$ENDIF}
|
|
if Canvas.ClassName = 'TCanvasGdiPlus' then
|
|
FSpaceWidth := FSpaceWidth - FScaleFactor;
|
|
FSymbolWidth := MeasureTextWidth('W');
|
|
if Angle <> 0 then
|
|
begin
|
|
// shift displayrect
|
|
FDisplayRect.Left := -rect.Width / 2;
|
|
FDisplayRect.Top := -rect.Height / 2;
|
|
FDisplayRect.Right := FDisplayRect.Left + rect.Width;
|
|
FDisplayRect.Bottom := FDisplayRect.Top + rect.Height;
|
|
|
|
// rotate displayrect if angle is 90 or 270
|
|
if ((Angle >= 90) and (Angle < 180)) or ((Angle >= 270) and (Angle < 360)) then
|
|
FDisplayRect := RectF(DisplayRect.Top, DisplayRect.Left, DisplayRect.Bottom, DisplayRect.Right);
|
|
end;
|
|
|
|
SplitToParagraphs(aText);
|
|
AdjustParagraphLines;
|
|
|
|
// restore original values
|
|
FDisplayRect := rect;
|
|
end;
|
|
|
|
destructor TAdvancedTextRenderer.Destroy;
|
|
var
|
|
paragraph: TParagraph;
|
|
begin
|
|
for paragraph in Paragraphs do
|
|
paragraph.Free;
|
|
Paragraphs.Free;
|
|
inherited;
|
|
end;
|
|
|
|
|
|
{ TParagraph }
|
|
|
|
function TParagraph.IsLast: Boolean;
|
|
begin
|
|
Result := FRenderer.Paragraphs[FRenderer.Paragraphs.Count - 1] = self;
|
|
end;
|
|
|
|
function TParagraph.IsEmpty: Boolean;
|
|
begin
|
|
Result := FText = '';
|
|
end;
|
|
|
|
function TParagraph.WrapLines(style: TStyleDescriptor): TStyleDescriptor;
|
|
var
|
|
line: TLine;
|
|
aWord: TWord;
|
|
text, currentWord, tag, colorName: String;
|
|
width, WLineWidth: Single;
|
|
skipSpace, match, isLastWord: Boolean;
|
|
i, originalCharIndex, istart, iend: Integer;
|
|
newStyle: TStyleDescriptor;
|
|
begin
|
|
line := TLine.Create(self, FOriginalCharIndex);
|
|
FLines.Add(line);
|
|
aWord := TWord.Create(line);
|
|
line.Words.Add(aWord);
|
|
WLineWidth := 0;
|
|
text := FText;
|
|
currentWord := '';
|
|
width := 0;
|
|
skipSpace := True;
|
|
originalCharIndex := FOriginalCharIndex;
|
|
i := 1;
|
|
while i <= Length(text) do
|
|
begin
|
|
if Renderer.HtmlTags and (text[i] = '<') then
|
|
begin
|
|
// probably html tag
|
|
newStyle := style;
|
|
tag := '';
|
|
match := False;
|
|
|
|
// <b>, <i>, <u>
|
|
if i + 3-1 <= Length(text) then
|
|
begin
|
|
match := True;
|
|
tag := LowerCase(Copy(text, i, 3));
|
|
if tag = '<b>' then
|
|
newStyle.FontStyle := newStyle.FontStyle + [fsBold]
|
|
else if tag = '<i>' then
|
|
newStyle.FontStyle := newStyle.FontStyle + [fsItalic]
|
|
else if tag = '<u>' then
|
|
newStyle.FontStyle := newStyle.FontStyle + [fsUnderline]
|
|
else
|
|
match := False;
|
|
|
|
if match then
|
|
Inc(i, 3);
|
|
end;
|
|
|
|
// </b>, </i>, </u>
|
|
if not match and (i + 4-1 <= Length(text)) and (text[i + 1] = '/') then
|
|
begin
|
|
match := True;
|
|
tag := LowerCase(Copy(text, i, 4));
|
|
if tag = '</b>' then
|
|
newStyle.FontStyle := newStyle.FontStyle - [fsBold]
|
|
else if tag = '</i>' then
|
|
newStyle.FontStyle := newStyle.FontStyle - [fsItalic]
|
|
else if tag = '</u>' then
|
|
newStyle.FontStyle := newStyle.FontStyle - [fsUnderline]
|
|
else
|
|
match := False;
|
|
|
|
if match then
|
|
Inc(i, 4);
|
|
end;
|
|
|
|
// <sub>, <sup>
|
|
if not match and (i + 5-1 <= Length(text)) then
|
|
begin
|
|
match := True;
|
|
tag := LowerCase(Copy(text, i, 5));
|
|
if tag = '<sub>' then
|
|
newStyle.BaseLine := TBaseLine.Subscript
|
|
else if tag = '<sup>' then
|
|
newStyle.BaseLine := TBaseLine.Superscript
|
|
else
|
|
match := False;
|
|
|
|
if match then
|
|
Inc(i, 5);
|
|
end;
|
|
|
|
// </sub>, </sup>
|
|
if not match and (i + 6-1 <= Length(text)) and (text[i + 1] = '/') then
|
|
begin
|
|
match := True;
|
|
tag := LowerCase(Copy(text, i, 6));
|
|
if (tag = '</sub>') or (tag = '</sup>') then
|
|
newStyle.BaseLine := TBaseLine.Normal
|
|
else
|
|
match := False;
|
|
|
|
if match then
|
|
Inc(i, 6);
|
|
end;
|
|
|
|
// <strike>
|
|
if not match and (i + 8-1 <= Length(text)) then
|
|
begin
|
|
tag := LowerCase(Copy(text, i, 8));
|
|
if tag = '<strike>' then
|
|
begin
|
|
newStyle.FontStyle := newStyle.FontStyle + [fsStrikeout];
|
|
match := True;
|
|
Inc(i, 8);
|
|
end;
|
|
end;
|
|
|
|
// </strike>
|
|
if not match and (i + 9-1 <= Length(text)) then
|
|
begin
|
|
tag := LowerCase(Copy(text, i, 9));
|
|
if tag = '</strike>' then
|
|
begin
|
|
newStyle.FontStyle := newStyle.FontStyle - [fsStrikeout];
|
|
match := True;
|
|
Inc(i, 9);
|
|
end;
|
|
end;
|
|
|
|
// <font color
|
|
if not match and (i + 11-1 < Length(text)) then
|
|
begin
|
|
tag := LowerCase(Copy(text, i, 11));
|
|
if tag = '<font color' then
|
|
begin
|
|
istart := i + 11;
|
|
while (istart <= Length(text)) and (text[istart] <> '=') do
|
|
Inc(istart);
|
|
Inc(istart);
|
|
while (istart <= Length(text)) and (text[istart] = ' ') do
|
|
Inc(istart);
|
|
iend := istart;
|
|
while (iend <= Length(text)) and (text[iend] <> '>') do
|
|
Inc(iend);
|
|
|
|
if iend <= Length(text) then
|
|
begin
|
|
colorName := Copy(text, istart, iend - istart);
|
|
if (colorName[1] = '"') and (colorName[Length(colorName)] = '"') then
|
|
colorName := Copy(colorName, 2, Length(colorName) - 2);
|
|
newStyle.Color := StringToAlphaColor(colorName);
|
|
i := iend + 1;
|
|
match := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// </font>
|
|
if not match and (i + 7-1 <= Length(text)) then
|
|
begin
|
|
tag := LowerCase(Copy(text, i, 7));
|
|
if tag = '</font>' then
|
|
begin
|
|
newStyle.Color := Renderer.Font.Color;
|
|
match := True;
|
|
Inc(i, 7);
|
|
end;
|
|
end;
|
|
|
|
if match then
|
|
begin
|
|
// finish the word
|
|
if currentWord <> '' then
|
|
aWord.Runs.Add(TRun.Create(currentWord, style, aWord));
|
|
|
|
currentWord := '';
|
|
style := newStyle;
|
|
|
|
if i >= Length(text) then
|
|
begin
|
|
// check width
|
|
width := width + aWord.Width + Renderer.SpaceWidth;
|
|
if width > Trunc(Renderer.DisplayRect.Width - 0.5) then
|
|
begin
|
|
// line is too long, make a new line
|
|
if line.Words.Count > 1 then
|
|
begin
|
|
// if line has several words, delete the last word from the current line
|
|
line.Words.Delete(line.Words.Count - 1);
|
|
// make new line
|
|
line := TLine.Create(self, originalCharIndex);
|
|
// and add word to it
|
|
line.Words.Add(aWord);
|
|
aWord.SetLine(line);
|
|
FLines.Add(line);
|
|
end;
|
|
end;
|
|
end;
|
|
continue;
|
|
end;
|
|
end;
|
|
|
|
if (text[i] = ' ') or (text[i] = #9) or (i = Length(text)) or (WLineWidth > 0) then
|
|
begin
|
|
// finish the last word
|
|
isLastWord := i = Length(text);
|
|
if isLastWord then
|
|
begin
|
|
currentWord := currentWord + text[i];
|
|
skipSpace := False;
|
|
end;
|
|
|
|
if text[i] = #9 then
|
|
skipSpace := False;
|
|
|
|
// space
|
|
if skipSpace then
|
|
currentWord := currentWord + text[i]
|
|
else
|
|
begin
|
|
// finish the word
|
|
if currentWord <> '' then
|
|
aWord.Runs.Add(TRun.Create(currentWord, style, aWord));
|
|
|
|
// check width
|
|
width := width + aWord.Width + Renderer.SpaceWidth;
|
|
// we need addition space witdth to avoid exeeds of bounds with different scale
|
|
if (width > Trunc(Renderer.DisplayRect.Width - 0.5)) or (WLineWidth > 0) then
|
|
begin
|
|
WLineWidth := 0;
|
|
// line is too long, make a new line
|
|
width := 0;
|
|
if line.Words.Count > 1 then
|
|
begin
|
|
// if line has several words, delete the last word from the current line
|
|
line.Words.Delete(line.Words.Count - 1);
|
|
// make new line
|
|
line := TLine.Create(self, originalCharIndex);
|
|
// and add word to it
|
|
line.Words.Add(aWord);
|
|
aWord.SetLine(line);
|
|
width := width + aWord.Width + Renderer.SpaceWidth;
|
|
end
|
|
else
|
|
line := TLine.Create(self, FOriginalCharIndex + i + 1);
|
|
FLines.Add(line);
|
|
end;
|
|
|
|
// TAB symbol
|
|
if text[i] = #9 then
|
|
begin
|
|
if currentWord = '' then
|
|
line.Words.Delete(line.Words.Count - 1);
|
|
aWord := TTab.Create(line);
|
|
line.Words.Add(aWord);
|
|
// adjust width
|
|
width := Renderer.GetTabPosition(width);
|
|
end;
|
|
|
|
if not isLastWord then
|
|
begin
|
|
aWord := TWord.Create(line);
|
|
line.Words.Add(aWord);
|
|
currentWord := '';
|
|
originalCharIndex := FOriginalCharIndex + i + 1;
|
|
skipSpace := True;
|
|
WLineWidth := 0;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
// symbol
|
|
currentWord := currentWord + text[i];
|
|
skipSpace := False;
|
|
// word wrap - do something better than call measure text every time
|
|
// TODO
|
|
// use aproximate width first
|
|
if FRenderer.WordWrap and (Length(currentWord) * renderer.SymbolWidth >=
|
|
Trunc(renderer.DisplayRect.Width - 0.5)) then
|
|
begin
|
|
while (Renderer.MeasureTextWidth(currentWord) >
|
|
Trunc(renderer.DisplayRect.Width - 0.5)) and (Length(currentWord) > 1) do
|
|
begin
|
|
Dec(i);
|
|
Delete(currentWord, Length(currentWord), 1);
|
|
WLineWidth := 1; // used as flag
|
|
end;
|
|
if (WLineWidth = 1) or (Length(currentWord) = 1) then
|
|
begin
|
|
Dec(i, 1);
|
|
WLineWidth := Renderer.MeasureTextWidth(currentWord);
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
Inc(i);
|
|
end;
|
|
|
|
Result := style;
|
|
end;
|
|
|
|
procedure TParagraph.AlignLines(forceJustify: Boolean);
|
|
var
|
|
i: Integer;
|
|
align: TfrxHAlign;
|
|
begin
|
|
for i := 0 to Lines.Count - 1 do
|
|
begin
|
|
align := Renderer.HorzAlign;
|
|
if (align = TfrxHAlign.haBlock) and (i = Lines.Count - 1) and not forceJustify then
|
|
align := TfrxHAlign.haLeft;
|
|
Lines[i].AlignWords(align);
|
|
end;
|
|
end;
|
|
|
|
procedure TParagraph.Draw;
|
|
var
|
|
line: TLine;
|
|
begin
|
|
for line in Lines do
|
|
line.Draw;
|
|
end;
|
|
|
|
constructor TParagraph.Create(const text: String; renderer: TAdvancedTextRenderer; originalCharIndex: Integer);
|
|
begin
|
|
FLines := TList<TLine>.Create;
|
|
FText := text;
|
|
FRenderer := renderer;
|
|
FOriginalCharIndex := originalCharIndex;
|
|
end;
|
|
|
|
destructor TParagraph.Destroy;
|
|
var
|
|
line: TLine;
|
|
begin
|
|
for line in Lines do
|
|
line.Free;
|
|
Lines.Free;
|
|
inherited;
|
|
end;
|
|
|
|
|
|
{ TLine }
|
|
|
|
function TLine.GetLeft: Single;
|
|
begin
|
|
if Words.Count > 0 then
|
|
Result := Words[0].Left
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TLine.GetRenderer: TAdvancedTextRenderer;
|
|
begin
|
|
Result := FParagraph.Renderer;
|
|
end;
|
|
|
|
function TLine.GetStyle: TStyleDescriptor;
|
|
begin
|
|
Result := NullStyle;
|
|
if Words.Count > 0 then
|
|
if Words[0].Runs.Count > 0 then
|
|
Result := Words[0].Runs[0].Style;
|
|
end;
|
|
|
|
function TLine.GetText: String;
|
|
var
|
|
word: TWord;
|
|
begin
|
|
Result := '';
|
|
for word in Words do
|
|
begin
|
|
if Result <> '' then
|
|
Result := Result + ' ';
|
|
Result := Result + word.Text;
|
|
end;
|
|
end;
|
|
|
|
function TLine.IsLast: Boolean;
|
|
begin
|
|
Result := FParagraph.Lines[FParagraph.Lines.Count - 1] = self;
|
|
end;
|
|
|
|
procedure TLine.PrepareUnderlines(list: TList<TRectF>; style: TFontStyle);
|
|
var
|
|
left, right: Single;
|
|
styleOn: Boolean;
|
|
aWord: TWord;
|
|
run: TRun;
|
|
fnt: TfrxFont;
|
|
begin
|
|
list.Clear;
|
|
if Words.Count = 0 then
|
|
Exit;
|
|
|
|
left := 0;
|
|
right := 0;
|
|
styleOn := False;
|
|
|
|
for aWord in Words do
|
|
begin
|
|
for run in aWord.Runs do
|
|
begin
|
|
fnt := run.GetFont;
|
|
if style in fnt.Style then
|
|
begin
|
|
if not styleOn then
|
|
begin
|
|
styleOn := True;
|
|
left := run.Left;
|
|
end;
|
|
right := run.Left + run.Width;
|
|
end;
|
|
if not (style in fnt.Style) and styleOn then
|
|
begin
|
|
styleOn := False;
|
|
list.Add(RectF(left, Top, right, Top));
|
|
end;
|
|
fnt.Free;
|
|
end;
|
|
end;
|
|
// close the style
|
|
if styleOn then
|
|
list.Add(RectF(left, Top, right, Top));
|
|
end;
|
|
|
|
procedure TLine.AlignWords(align: TfrxHAlign);
|
|
var
|
|
left, rectWidth, delta, curDelta: Single;
|
|
i: Integer;
|
|
aWord: TWord;
|
|
begin
|
|
FWidth := 0;
|
|
left := 0;
|
|
i := 0;
|
|
while i < Words.Count do
|
|
begin
|
|
aWord := Words[i];
|
|
aWord.Left := left;
|
|
|
|
if aWord is TTab then
|
|
begin
|
|
left := Renderer.GetTabPosition(left);
|
|
// remove tab
|
|
Words.Delete(i);
|
|
aWord.Free;
|
|
Dec(i);
|
|
end
|
|
else
|
|
left := left + aWord.Width + Renderer.SpaceWidth;
|
|
Inc(i);
|
|
end;
|
|
|
|
FWidth := left;
|
|
rectWidth := Renderer.DisplayRect.Width;
|
|
if align = TfrxHAlign.haBlock then
|
|
begin
|
|
if Words.Count > 1 then
|
|
begin
|
|
delta := (rectWidth - FWidth) / (Words.Count - 1);
|
|
curDelta := delta;
|
|
for i := 1 to Words.Count - 1 do
|
|
begin
|
|
FWords[i].Left := FWords[i].Left + curDelta;
|
|
curDelta := curDelta + delta;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
delta := 0;
|
|
if align = TfrxHAlign.haCenter then
|
|
delta := (rectWidth - FWidth) / 2
|
|
else if align = TfrxHAlign.haRight then
|
|
delta := rectWidth - (FWidth - Renderer.SpaceWidth);
|
|
for aWord in Words do
|
|
aWord.Left := aWord.Left + delta;
|
|
end;
|
|
|
|
// adjust X offset
|
|
for aWord in Words do
|
|
begin
|
|
if Renderer.RightToLeft then
|
|
aWord.Left := Renderer.DisplayRect.Right - aWord.Left
|
|
else
|
|
aWord.Left := aWord.Left + Renderer.DisplayRect.Left;
|
|
aWord.AdjustRuns;
|
|
if Renderer.RightToLeft and Renderer.PDFMode then
|
|
aWord.Left := aWord.Left - aWord.Width;
|
|
end;
|
|
end;
|
|
|
|
procedure TLine.MakeUnderlines;
|
|
begin
|
|
PrepareUnderlines(FUnderlines, TFontStyle.fsUnderline);
|
|
PrepareUnderlines(FStrikeouts, TFontStyle.fsStrikeout);
|
|
end;
|
|
|
|
procedure TLine.Draw;
|
|
var
|
|
aWord: TWord;
|
|
h, w, th: Single;
|
|
rect: TRectF;
|
|
begin
|
|
for aWord in Words do
|
|
aWord.Draw;
|
|
|
|
if (Underlines.Count > 0) or (Strikeouts.Count > 0) then
|
|
begin
|
|
h := Renderer.FontLineHeight;
|
|
w := h * 0.1; // to match char X offset
|
|
// invert offset in case of rtl
|
|
if Renderer.RightToLeft then
|
|
w := -w;
|
|
th := Round(Renderer.Font.Size * 0.1);
|
|
{$IFDEF Delphi25}
|
|
Renderer.Canvas.Stroke.Thickness := th;
|
|
{$ELSE}
|
|
Renderer.Canvas.StrokeThickness := th;
|
|
{$ENDIF}
|
|
Renderer.Canvas.Stroke.Color := Renderer.Font.Color;
|
|
|
|
// emulate underline & strikeout
|
|
for rect in Underlines do
|
|
Renderer.Canvas.DrawLine(
|
|
PointF(rect.Left + w, AdjY(rect.Top + h - w, th)), PointF(rect.Right + w, AdjY(rect.Top + h - w, th)), 1);
|
|
|
|
h := h / 2;
|
|
for rect in Strikeouts do
|
|
Renderer.Canvas.DrawLine(
|
|
PointF(rect.Left + w, AdjY(rect.Top + h, th)), PointF(rect.Right + w, AdjY(rect.Top + h, th)), 1);
|
|
end;
|
|
end;
|
|
|
|
constructor TLine.Create(paragraph: TParagraph; originalCharIndex: Integer);
|
|
begin
|
|
FWords := TList<TWord>.Create;
|
|
FParagraph := paragraph;
|
|
FOriginalCharIndex := originalCharIndex;
|
|
FUnderlines := TList<TRectF>.Create;
|
|
FStrikeouts := TList<TRectF>.Create;
|
|
end;
|
|
|
|
destructor TLine.Destroy;
|
|
var
|
|
aWord: TWord;
|
|
begin
|
|
for aWord in Words do
|
|
aWord.Free;
|
|
Words.Free;
|
|
Underlines.Free;
|
|
Strikeouts.Free;
|
|
inherited;
|
|
end;
|
|
|
|
|
|
{ TWord }
|
|
|
|
function TWord.GetText: String;
|
|
var
|
|
run: TRun;
|
|
begin
|
|
Result := '';
|
|
for run in Runs do
|
|
begin
|
|
Result := Result + run.Text;
|
|
end;
|
|
end;
|
|
|
|
function TWord.GetTop: Single;
|
|
begin
|
|
Result := FLine.Top;
|
|
end;
|
|
|
|
function TWord.GetRenderer: TAdvancedTextRenderer;
|
|
begin
|
|
Result := FLine.Renderer;
|
|
end;
|
|
|
|
function TWord.GetWidth: Single;
|
|
var
|
|
run: TRun;
|
|
begin
|
|
if FWidth = -1 then
|
|
begin
|
|
FWidth := 0;
|
|
for run in Runs do
|
|
FWidth := FWidth + run.Width;
|
|
end;
|
|
Result := FWidth;
|
|
end;
|
|
|
|
procedure TWord.AdjustRuns;
|
|
var
|
|
aLeft: Single;
|
|
run: TRun;
|
|
begin
|
|
aLeft := Left;
|
|
for run in Runs do
|
|
begin
|
|
run.Left := aLeft;
|
|
|
|
if Renderer.RightToLeft then
|
|
begin
|
|
aLeft := aLeft - run.Width;
|
|
if Renderer.PDFMode then
|
|
run.Left := run.Left - run.Width;
|
|
end
|
|
else
|
|
aLeft := aLeft + run.Width;
|
|
end;
|
|
end;
|
|
|
|
procedure TWord.SetLine(aLine: TLine);
|
|
begin
|
|
FLine := aLine;
|
|
end;
|
|
|
|
procedure TWord.Draw;
|
|
var
|
|
run: TRun;
|
|
begin
|
|
for run in Runs do
|
|
run.Draw;
|
|
end;
|
|
|
|
constructor TWord.Create(aLine: TLine);
|
|
begin
|
|
FRuns := TList<TRun>.Create;
|
|
FLine := aLine;
|
|
FWidth := -1;
|
|
end;
|
|
|
|
destructor TWord.Destroy;
|
|
var
|
|
run: TRun;
|
|
begin
|
|
for run in Runs do
|
|
run.Free;
|
|
FRuns.Free;
|
|
inherited;
|
|
end;
|
|
|
|
|
|
{ TRun }
|
|
|
|
function TRun.GetRenderer: TAdvancedTextRenderer;
|
|
begin
|
|
Result := FWord.Renderer;
|
|
end;
|
|
|
|
function TRun.GetTop: Single;
|
|
var
|
|
baseLine: Single;
|
|
begin
|
|
baseLine := 0;
|
|
if Style.BaseLine = TBaseLine.Subscript then
|
|
baseLine := baseLine + Renderer.FontLineHeight * 0.45
|
|
else if Style.BaseLine = TBaseLine.Superscript then
|
|
baseLine := baseLine - Renderer.FontLineHeight * 0.15;
|
|
Result := FWord.Top + baseLine;
|
|
end;
|
|
|
|
function TRun.GetFont(disableUnderlinesStrikeouts: Boolean): TfrxFont;
|
|
var
|
|
fontSize: Single;
|
|
fontStyle: TFontStyles;
|
|
begin
|
|
fontSize := Renderer.Font.Size;
|
|
if Style.BaseLine <> TBaseLine.Normal then
|
|
fontSize := fontSize * 0.6;
|
|
|
|
fontStyle := Style.FontStyle;
|
|
if disableUnderlinesStrikeouts then
|
|
fontStyle := fontStyle - [fsUnderline, fsStrikeout];
|
|
|
|
Result := TfrxFont.Create;
|
|
Result.Name := Renderer.Font.Name;
|
|
Result.Color := Style.Color;
|
|
Result.Size := fontSize;
|
|
Result.Style := fontStyle;
|
|
end;
|
|
|
|
function TRun.GetFont: TfrxFont;
|
|
begin
|
|
Result := GetFont(false);
|
|
end;
|
|
|
|
procedure TRun.Draw;
|
|
var
|
|
font: TfrxFont;
|
|
begin
|
|
font := GetFont(True);
|
|
font.AssignToCanvas(Renderer.Canvas);
|
|
|
|
|
|
if Renderer.FFastRender <> nil then
|
|
Renderer.FFastRender.FillText(RectF(Left, Top, Left + 10000, Top + 10000), FText, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading)
|
|
else
|
|
Renderer.Canvas.FillText(RectF(Left, Top, Left + 10000, Top + 10000), FText, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
|
|
font.Free;
|
|
end;
|
|
|
|
constructor TRun.Create(const aText: String; aStyle: TStyleDescriptor; aWord: TWord);
|
|
var
|
|
font: TfrxFont;
|
|
begin
|
|
FText := aText;
|
|
FStyle := aStyle;
|
|
FWord := aWord;
|
|
|
|
font := GetFont;
|
|
font.AssignToCanvas(Renderer.Canvas);
|
|
FWidth := Renderer.MeasureTextWidth(aText);
|
|
font.Free;
|
|
end;
|
|
|
|
end.
|