* Improved algorithm

src/base/fresnel.textlayouter.pas

@@ -1,20 +1,16 @@
-unit Fresnel.TextLayouter;
+unit Fresnel.TextLayouter;
 
 {$mode objfpc}
 {$H+}
 {$modeswitch advancedrecords}
 
-{$IF FPC_FULLVERSION>30300}
-  {$DEFINE HasTObjectToString}
-{$ENDIF}
-
 interface
 
 uses
 {$IFDEF FPC_DOTTEDUNITS}
   System.Classes, System.SysUtils, System.Types, System.Contnrs, fpImage, System.UITypes;
 {$ELSE}
-  Classes, SysUtils, Fresnel.Classes, Contnrs, fpImage, System.UITypes;
+  Classes, SysUtils, Types, Contnrs, fpImage, System.UITypes;
 {$ENDIF}
 
 Const
@@ -22,8 +18,8 @@ Const
 
 Type
   {$IF SIZEOF(CHAR)=1}
-  TTextString = String;
-  TFontNameString = String;
+  TTextString = UTF8String;
+  TFontNameString = AnsiString;
   {$ELSE}
   TTextString = UnicodeString;
   TFontNameString = UnicodeString;
@@ -41,7 +37,7 @@ Type
   TOverlappingRangesAction = (oraError,oraFit);
   TCullThreshold = 1..100;
 
-  TTextUnits = TFresnelLength;
+  TTextUnits = single;
 
   { No hyphenation:
 
@@ -81,41 +77,49 @@ Type
     Width, Height : TTextUnits;
     Ascender, Descender : TTextUnits;
   end;
-  TTextPoint = TFresnelPoint;
+  TTextPoint = {$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}Types.TPointF;
 
   TFontAttribute = (faBold,faItalic,faUnderline,faStrikeOut);
   TFontAttributes = set of TFontAttribute;
 
   { TTextFont }
 
-  TTextFont = Class(TPersistent)
+  TTextFont = class (TPersistent)
   private
     FOwner : TPersistent;
-    FAttrs: TFontAttributes;
-    FName: string;
-    FSize: Smallint;
+    FAttrs : TFontAttributes;
+    FName : string;
+    FSize : Smallint;
     FColor : TFPColor;
     function GetColor: TColor;
     procedure SetAttrs(AValue: TFontAttributes);
     procedure SetColor(AValue: TColor);
     procedure SetFPColor(AValue: TFPColor);
-    procedure SetName(AValue: string);
+    procedure SetName(const AValue: String);
     procedure SetSize(AValue: Smallint);
-  Public
+
+  public
+    constructor Create(aOwner : TPersistent); virtual;
+
     procedure Assign(Source: TPersistent); override;
-    Constructor Create(aOwner : TPersistent); virtual;
-    procedure Changed;virtual;
-    Function Clone(aOwner : TPersistent=nil): TTextFont;
-    Property FPColor : TFPColor Read FColor write SetFPColor;
-  Published
+
+    procedure Changed; virtual;
+
+    function Clone(aOwner : TPersistent=nil): TTextFont;
+
+    function IsSameFont(aFont : TTextFont) : Boolean; virtual;
+
+    property FPColor : TFPColor Read FColor write SetFPColor;
+
+  published
     // In name
-    Property Name : TFontNameString Read FName Write SetName;
+    property Name : TFontNameString Read FName Write SetName;
     // In pixels
-    Property Size : Smallint Read FSize write SetSize;
+    property Size : Smallint Read FSize write SetSize;
     // attributes
-    Property Attrs : TFontAttributes read FAttrs Write SetAttrs;
+    property Attrs : TFontAttributes read FAttrs Write SetAttrs;
     // Color. Not needed for calculations, but allows for easier management
-    Property Color : TColor read GetColor Write SetColor;
+    property Color : TColor read GetColor Write SetColor;
   end;
   TTextFontClass = class of TTextFont;
 
@@ -150,13 +154,16 @@ Type
   private
     FLayouter: TTextLayouter;
     FWhiteSpaceWidth : TTextUnits;
+    FLineHeight : TTextUnits;
   public
     Constructor Create(aLayouter : TTextLayouter); virtual;
     // Font size in points.
     Procedure SetFont(const aFontName : TFontNameString; aSize : SmallInt; Attrs : TFontAttributes); virtual; abstract;
     Procedure SetFont(const aFont: TTextFont);
-    Function MeasureText(aText : TTextString) : TTextMeasures; virtual; abstract;
-    Function WhitespaceWidth : TTextUnits;
+    Function MeasureText(const aText : TTextString) : TTextMeasures; virtual; abstract;
+    function MeasureTextWidth(const aText : TTextString) : Single; virtual;
+    function LineHeight : TTextUnits;
+    function WhitespaceWidth : TTextUnits;
     Property Layouter : TTextLayouter Read FLayouter;
 
   end;
@@ -174,7 +181,7 @@ Type
   Public
     Constructor Create(aLayouter : TTextLayouter); override;
     Procedure SetFont(const aFontName : TFontNameString; aSize : SmallInt; aAttrs : TFontAttributes); override;
-    Function MeasureText(aText : TTextString) : TTextMeasures; override;
+    Function MeasureText(const aText : TTextString) : TTextMeasures; override;
     Property CharHeight : TTextUnits Read FHeight Write FHeight;
     Property CharWidth : TTextUnits Read FWidth Write FWidth;
     Property Size : SmallInt Read FSize;
@@ -205,9 +212,7 @@ Type
     // At pos is relative to the text here, zero based
     function Split(atPos : integer) : TTextBlock; virtual;
     procedure Assign(aBlock : TTextBlock); virtual;
-    {$IFDEF HasTObjectToString}
     function ToString : RTLString; override;
-    {$ENDIF}
     Procedure TrimTrailingWhiteSpace;
     // Text for this block. Calculated from offset/len
     Property Text : TTextString Read GetText;
@@ -251,9 +256,7 @@ Type
     destructor destroy; override;
     procedure Assign(Source: TPersistent); override;
     Procedure Changed;
-    {$IFDEF HasTObjectToString}
     function ToString : RTLString; override;
-    {$ENDIF}
   Published
     // Offset is 0 based and is the offset from the first character in the text.
     Property CharOffset : SizeInt Read FCharOffset Write SetCharOffSet;
@@ -283,9 +286,9 @@ Type
     FWidth: TTextUnits;
     FLayouter : TTextLayouter;
     function GetAsPoint: TTextPoint;
-    procedure SetAsPoint(const AValue: TTextPoint);
-    procedure SetHeight(const AValue: TTextUnits);
-    procedure SetWidth(const AValue: TTextUnits);
+    procedure SetAsPoint(AValue: TTextPoint);
+    procedure SetHeight(AValue: TTextUnits);
+    procedure SetWidth(AValue: TTextUnits);
   protected
     procedure Changed; virtual;
     function GetOwner: TPersistent; override;
@@ -347,21 +350,20 @@ Type
     class Function CreateSplitter(aLayouter : TTextLayouter): TTextSplitter; virtual;
     class function CreateRanges(aLayouter: TTextLayouter): TTextRangeList; virtual;
     class function CreateBlock(aLayouter: TTextLayouter; aOffset,aLength : SizeInt) : TTextBlock; virtual;
-    function FindWrapPosition(B: TTextBlock; S: String; var aPos: integer; var CurrPos: TTextPoint): Boolean;
+    function FindWrapPosition(aB: TTextBlock; const aStr: String; var aPos: integer; var aCurrXPos : TTextUnits): Boolean;
     function AddBlock(aOffset, aLength: SizeInt; aFont: TTextFont): TTextBlock; virtual;
     procedure ApplyStretchMode(const ADesiredHeight: TTextUnits); virtual;
-    function WrapBlock(B: TTextBlock; S: String; var Idx: integer; var CurrPos: TTextPoint) : Boolean; virtual;
+    function WrapBlock(aB: TTextBlock; const aStr: String; var aIdx: integer; var aCurrPos: TTextPoint) : Boolean; virtual;
     procedure CullTextHorizontally(B: TTextBlock);
     procedure HandleRanges; virtual;
     procedure HandleNewLines; virtual;
-    // Apply vertical text alignment
+
     procedure ApplyVertTextAlignment;
-    // Apply horizontal text alignment
     procedure ApplyHorzTextAlignment;
-    // Remove text that falls outside bounds vertically.
+
     procedure CullTextOutOfBoundsVertically;
-    // Handle text that falls outside bounds horizontally, depending on WordOverFlow.
     procedure CullTextOutOfBoundsHorizontally;
+
     // Return true if a split occurred.
     function WrapLayout: Boolean; virtual;
     // Return True if there are multiple lines.
@@ -381,9 +383,7 @@ Type
     Procedure Reset;
     // Check if ranges do not overlap.
     procedure CheckRanges;
-    {$IFDEF HasTObjectToString}
     function ToString : RTLString; override;
-    {$ENDIF}
     Property TextBlocks[aIndex : Integer] : TTextBlock Read GetBlock;
     Property TextBlockCount : Integer Read GetBlockCount;
     function Execute : integer; virtual;
@@ -394,8 +394,8 @@ Type
     Function GetMaxRight : TTextUnits;
     Function GetMinTop : TTextUnits;
     Function GetMaxBottom : TTextUnits;
-    Function GetTotalSize : TFresnelPoint;
-    Function GetBoundsRect : TFresnelRect;
+    Function GetTotalSize : TSizeF;
+    Function GetBoundsRect : TRectF;
     // Color of font
     Property FPColor : TFPColor Read GetColor Write SetColor;
   Published
@@ -496,7 +496,7 @@ begin
   Self.TextLen:=AtPos;
   // Reset formatting stuff on new
   Result.ForceNewLine:=False;
-  Result.LayoutPos:=Default(TTextPoint);
+  Result.LayoutPos:=Default(TPointF);
   Result.Size.Width:=0;
   Result.Size.Height:=0;
   Result.Size.Descender:=0;
@@ -516,13 +516,11 @@ begin
   ForceNewLine:=aBlock.ForceNewLine;
 end;
 
-{$IFDEF HasTObjectToString}
 function TTextBlock.ToString: RTLString;
 begin
   Result:=Inherited ToString;
   Result:=Result+Format(': (x: %g, y: %g, w: %g, h:%g) [Off: %d, len: %d]: >>%s<< ',[LayoutPos.X,LayoutPos.Y,Size.Width,Size.Height,TextOffset,TextLen,Text]);
 end;
-{$ENDIF}
 
 procedure TTextBlock.TrimTrailingWhiteSpace;
 
@@ -607,12 +605,10 @@ begin
     TTextLayouter(Collection.Owner).Reset;
 end;
 
-{$IFDEF HasTObjectToString}
 function TTextRange.ToString: RTLString;
 begin
   Result:=Format('[offset %d, len: %d]',[CharOffset,CharLength]);
 end;
-{$ENDIF}
 
 { TTextRangeList }
 
@@ -637,7 +633,7 @@ end;
 
 { TTextLayoutBounds }
 
-procedure TTextLayoutBounds.SetHeight(const AValue: TTextUnits);
+procedure TTextLayoutBounds.SetHeight(AValue: TTextUnits);
 begin
   if FHeight=AValue then Exit;
   FHeight:=AValue;
@@ -646,18 +642,17 @@ end;
 
 function TTextLayoutBounds.GetAsPoint: TTextPoint;
 begin
-  Result.X:=Width;
-  Result.Y:=Height;
+  Result:=PointF(Width,Height);
 end;
 
-procedure TTextLayoutBounds.SetAsPoint(const AValue: TTextPoint);
+procedure TTextLayoutBounds.SetAsPoint(AValue: TTextPoint);
 begin
   FWidth:=aValue.X;
   FHeight:=aValue.Y;
   Changed;
 end;
 
-procedure TTextLayoutBounds.SetWidth(const AValue: TTextUnits);
+procedure TTextLayoutBounds.SetWidth(AValue: TTextUnits);
 begin
   if FWidth=AValue then Exit;
   FWidth:=AValue;
@@ -817,7 +812,22 @@ procedure TTextMeasurer.SetFont(const aFont: TTextFont);
 begin
   With aFont do
     SetFont(Name,Size,Attrs);
-  FWhiteSpaceWidth:=0;
+  FWhiteSpaceWidth := 0;
+  FLineHeight := 0;
+end;
+
+function TTextMeasurer.MeasureTextWidth(const aText: TTextString): Single;
+begin
+  Result := MeasureText(aText).Width;
+end;
+
+// LineHeight
+//
+function TTextMeasurer.LineHeight: TTextUnits;
+begin
+  if FLineHeight = 0 then
+    FLineHeight := MeasureText('Ply|').Height;
+  Result := FLineHeight;
 end;
 
 function TTextMeasurer.WhitespaceWidth: TTextUnits;
@@ -843,7 +853,7 @@ begin
   FAttrs:=aAttrs;
 end;
 
-function TFixedSizeTextMeasurer.MeasureText(aText: TTextString): TTextMeasures;
+function TFixedSizeTextMeasurer.MeasureText(const aText: TTextString): TTextMeasures;
 
 var
   Scale: TTextUnits;
@@ -887,7 +897,7 @@ begin
   Changed;
 end;
 
-procedure TTextFont.SetName(AValue: string);
+procedure TTextFont.SetName(const AValue: string);
 begin
   if FName=AValue then Exit;
   FName:=AValue;
@@ -929,12 +939,21 @@ begin
 end;
 
 function TTextFont.Clone(aOwner : TPersistent): TTextFont;
-
 begin
   Result:=TTextFontClass(Self.ClassType).Create(aOwner);
   Result.Assign(Self);
 end;
 
+// IsSameFont
+//
+function TTextFont.IsSameFont(aFont : TTextFont) : Boolean;
+begin
+  Result :=     (FSize = aFont.FSize)
+            and (FAttrs = aFont.FAttrs)
+            and (FColor = aFont.FColor)
+            and (FName = aFont.FName);
+end;
+
 { TTextLayouter }
 
 procedure TTextLayouter.SetCullTreshold(AValue: TCullThreshold);
@@ -1090,7 +1109,7 @@ begin
   FRanges:=CreateRanges(Self);
   FMeasurer:=CreateMeasurer(Self);
   FSplitter:=CreateSplitter(Self);
-  FLineSpacing:=1.0;
+  FLineSpacing:=0;
   HyphenationChar:='-';
   AllowHyphenation:=False;
 end;
@@ -1134,7 +1153,6 @@ begin
   FBlocks.Clear;
 end;
 
-{$IFDEF HasTObjectToString}
 function TTextLayouter.ToString: RTLString;
 var
   I : Integer;
@@ -1143,7 +1161,6 @@ begin
   For I:=0 to TextBlockCount-1 do
     Result:=Result+TextBlocks[I].ToString+sLineBreak;
 end;
-{$ENDIF}
 
 function TTextLayouter.AddBlock(aOffset,aLength : SizeInt; aFont : TTextFont) : TTextBlock;
 
@@ -1223,202 +1240,219 @@ begin
   Font.FPColor:=aValue;
 end;
 
+// HandleNewLines
+//
 procedure TTextLayouter.HandleNewLines;
-
 var
   i : Integer;
   aPos : sizeInt;
-  SplitPos : TTextSplitPoint;
-  B,BN : TTextBlock;
-
+  splitPos : TTextSplitPoint;
+  B, BN : TTextBlock;
 begin
-  I:=0;
-  While (I<FBlocks.Count) do
-    begin
+  i := 0;
+  while (i < FBlocks.Count) do
+  begin
     B:=FBlocks[i];
-    Repeat
-      SplitPos:=Splitter.GetNextNewLine(Text,1+B.TextOffset);
-      if SplitPos.Offset<>-1 then
-        begin
-        aPos:=Splitpos.offset+Splitpos.whitespace;
-        BN:=B.Split(aPos);
-        BN.ForceNewLine:=True;
-        B.TextLen:=B.TextLen-SplitPos.WhiteSpace;
+    repeat
+      splitPos := Splitter.GetNextNewLine(Text, 1+B.TextOffset);
+      if splitPos.Offset <> -1 then
+      begin
+        aPos := splitPos.offset + splitPos.whitespace;
+        BN := B.Split(aPos);
+        BN.ForceNewLine := True;
+        B.TextLen := B.TextLen - splitPos.WhiteSpace;
         B.TrimTrailingWhiteSpace;
-        inc(I);
+        Inc(I);
         FBlocks.Insert(I,BN);
-        B:=BN;
-        end;
-    until SplitPos.Offset=-1;
+        B := BN;
+      end;
+    until (splitPos.Offset = -1);
     Inc(I);
-    end;
+  end;
 end;
 
+// FindWrapPosition
+//
 // Returns true if the line is full.
-function TTextLayouter.FindWrapPosition(B : TTextBlock; S : String; var aPos : integer; var CurrPos : TTextPoint) : Boolean;
-
+function TTextLayouter.FindWrapPosition(aB : TTextBlock; const aStr : String; var aPos : integer; var aCurrXPos : TTextUnits) : Boolean;
 var
   lSplit : TTextSplitPoint;
   lSize : TTextMeasures;
   wSpace : TTextUnits;
-  BlockWidth: TTextUnits;
-  CurrPart : String;
+  lBlockWidth: TTextUnits;
+  lCurrPart : String;
   maxLen : integer;
   useHyphen : Boolean;
-
 begin
-  maxLen:=Length(S);
-  BlockWidth:=0;
-  UseHyphen:=False;
-  Repeat
-    lSplit:=Splitter.GetNextSplitPoint(S,aPos,UseHyphen);
-    CurrPart:=Copy(S,aPos,lSplit.offset-aPos+1);
+  maxLen := Length(aStr);
+  lBlockWidth := 0;
+  UseHyphen := False;
+  repeat
+    lSplit := Splitter.GetNextSplitPoint(aStr, aPos, UseHyphen);
+    lCurrPart := Copy(aStr, aPos, lSplit.offset - aPos + 1);
     if UseHyphen then
-      CurrPart:=CurrPart+HyphenationChar;
-    lSize:=Measurer.MeasureText(CurrPart);
-    Result:=CurrPos.X+lSize.Width>=Bounds.Width;
-    if not Result then
-      begin
-      // CurrPart still fits on Line, add it
-      BlockWidth:=BlockWidth+lSize.Width;
-      CurrPos.x:=CurrPos.X+lSize.Width;
-      // Update pos for GetNextSplitPoint.
-      aPos:=lSplit.Offset+lSplit.whitespace+1;
-      // Check if the whitespace would flow over:
-      WSpace:=lSplit.whitespace*Measurer.WhitespaceWidth;
-      Result:=(CurrPos.X+WSpace)>=Bounds.Width;
-      if UseHyphen then
-        B.Suffix:=HyphenationChar;
-      if not Result then
-        CurrPos.X:=CurrPos.X+WSpace;
-      end
-    else
-      begin
+      lCurrPart := lCurrPart + HyphenationChar;
+
+    lSize := Measurer.MeasureText(lCurrPart);
+    Result := (aCurrXPos + lSize.Width >= Bounds.Width);
+    if Result then begin
       // Currpart will no longer fit on the line. Attempt splitting, if we were not yet splitting.
-      if (not UseHyphen) and AllowHyphenation then
-        begin
+      if (not UseHyphen) and AllowHyphenation then begin
         Result:=False;
         UseHyphen:=True;
-        end
-      else
+      end else begin
         // One word and it does not fit...
         if aPos=1 then
           aPos:=MaxLen
       end;
+    end else begin
+      // lCurrPart still fits on Line, add it
+      lBlockWidth:=lBlockWidth+lSize.Width;
+      aCurrXPos += lSize.Width;
+      // Update pos for GetNextSplitPoint.
+      aPos := lSplit.Offset + lSplit.whitespace + 1;
+      // Check if the whitespace would flow over:
+      wSpace := lSplit.whitespace * Measurer.WhitespaceWidth;
+      Result := ((aCurrXPos + WSpace) >= Bounds.Width);
+      if UseHyphen then
+        aB.Suffix := HyphenationChar;
+      if not Result then
+        aCurrXPos += wSpace;
+    end;
   until Result or (aPos>=MaxLen);
 end;
 
-function TTextLayouter.WrapBlock(B: TTextBlock; S: String; var Idx: integer; var CurrPos: TTextPoint): Boolean;
-
+// WrapBlock
+//
+function TTextLayouter.WrapBlock(aB: TTextBlock; const aStr: String; var aIdx: integer; var aCurrPos: TTextPoint): Boolean;
 var
-  aPosOffset,aPos,MaxLen: integer;
-  LineFull : Boolean;
-  NB : TTextBlock;
-  T : String;
-
-begin
-  Result:=False;
-  aPos:=1;
-  aPosOffset:=1;
-  maxLen:=Length(S);
+  lPosOffset, lPos, lMaxLen: integer;
+  lLineFull : Boolean;
+  nextBlock : TTextBlock;
+begin
+  Result := False;
+  lPos := 1;
+  lPosOffset := 1;
+  lMaxLen := Length(aStr);
   // We can have multiple lines
-  Repeat
-    B.LayoutPos:=CurrPos;
-    LineFull:=FindWrapPosition(B,S,aPos,CurrPos);
-    // At this point, aPos is the maximum size that will fit.
-    if aPos>=MaxLen then
-      begin
+  repeat
+    aB.LayoutPos := aCurrPos;
+    lLineFull := FindWrapPosition(aB, aStr, lPos, aCurrPos.x);
+
+    // At this point, lPos is the maximum size that will fit.
+    if lPos >= lMaxLen then begin
+
       // Correct size.
-      B.Size:=Measurer.MeasureText(B.Text);
-      end
-    else
+      aB.Size := Measurer.MeasureText(aB.Text);
+
+    end else begin
+
       // We're not yet at the end, so we need to split
-      begin
-      Result:=True;
-      NB:=B.Split(aPos-aPosOffset);
-      T:=NB.Text;
-      // Writeln('T new: >>',T,'<<');
-      B.TrimTrailingWhiteSpace;
-      T:=B.Text;
-      // Writeln('T old: >>',T,'<<');
-      B.Size:=Measurer.MeasureText(T);
-      Inc(Idx);
-      FBlocks.Insert(Idx,NB);
-      NB.ForceNewLine:=True;
-      aPosOffset:=NB.TextOffset;
-      if LineFull then
-        begin
-        CurrPos.X:=0;
-        CurrPos.Y:=CurrPos.Y+B.Size.Height+LineSpacing;
-        end;
-      B:=NB;
+      Result := True;
+
+      nextBlock := aB.Split(lPos - lPosOffset - 1);
+      aB.TrimTrailingWhiteSpace;
+      aB.Size := Measurer.MeasureText(aB.Text);
+
+      Inc(aIdx);
+      FBlocks.Insert(aIdx, nextBlock);
+
+      nextBlock.ForceNewLine := lLineFull;
+      lPosOffset := nextBlock.TextOffset;
+      if lLineFull then begin
+        aCurrPos.X := 0;
+        aCurrPos.Y += aB.Size.Height + LineSpacing;
+      end else begin
+        aCurrPos.X += aB.Size.Width;
       end;
-  until (aPos>=MaxLen);
+      aB := nextBlock;
+
+    end;
+  until (lPos >= lMaxLen);
 end;
 
+// WrapLayout
+//
 function TTextLayouter.WrapLayout : Boolean;
-
 var
-  CurrPos : TTextPoint; // value in pixels
-  i: integer;
-  lSize : TTextMeasures;
-  B : TTextBlock;
+  lCurrPos : TTextPoint; // value in pixels
+  i : Integer;
+  currBlock : TTextBlock;
   lText : TTextString;
-
+  lastFont : TTextFont;
 begin
-  Result:=False;
-  CurrPos:=Default(TTextPoint);
-  I:=0;
-  While I<FBlocks.Count do
+  Result := False;
+
+  lastFont := nil;
+  lCurrPos.x := 0;
+  lCurrPos.y := 0;
+  i := 0;
+  while i < FBlocks.Count do
+  begin
+    currBlock := FBlocks[i];
+    if currBlock.ForceNewLine then
     begin
-    B:=FBlocks[i];
-    if B.ForceNewLine then
-      CurrPos.X:=0;
-    lText:=B.Text;
-    Measurer.SetFont(B.Font);
-    lSize:=Measurer.MeasureText(lText);
-    if CurrPos.X+lSize.Width>Bounds.Width then
-       Result:=WrapBlock(B,lText,I,CurrPos) or Result;
-    inc(I);
+      lCurrPos.X := 0;
+      Result := True;
+    end;
+
+    if (lastFont = nil) or not lastFont.IsSameFont(currBlock.Font) then
+    begin
+      lastFont := currBlock.Font;
+      Measurer.SetFont(lastFont);
     end;
-  B:=FBlocks[FBlocks.Count-1];
+    Measurer.SetFont(currBlock.Font);
+
+    lText := currBlock.Text;
+    currBlock.Size := Measurer.MeasureText(lText);
+    if lCurrPos.X + currBlock.Size.Width > Bounds.Width then
+      Result := WrapBlock(currBlock, lText, i, lCurrPos) or Result;
+    Inc(i);
+  end;
 end;
 
+// NoWrapLayout
+//
 function TTextLayouter.NoWrapLayout: Boolean;
-
 var
-  CurrPos : TTextPoint;
-  CurrHeight : TTextUnits;
-  i: integer;
-  B : TTextBlock;
-  lText : TTextString;
-
+  currPos : TTextPoint;
+  currHeight : TTextUnits;
+  i : Integer;
+  currBlock : TTextBlock;
+  lastFont : TTextFont;
 begin
   Result:=False;
-  CurrPos.X:=0;
-  CurrPos.Y:=0;
-  CurrHeight:=0;
-  I:=0;
-  While I<FBlocks.Count do
+
+  lastFont := nil;
+  currPos.X := 0;
+  currPos.Y := 0;
+  currHeight := 0;
+  i := 0;
+  while i < FBlocks.Count do
+  begin
+    currBlock := FBlocks[i];
+    if currBlock.ForceNewLine then
     begin
-    B:=FBlocks[i];
-    if B.ForceNewLine then
-      begin
-      CurrPos.X:=0;
-      CurrPos.Y:=CurrPos.Y+CurrHeight+LineSpacing;
-      CurrHeight:=0;
-      Result:=True;
-      end;
-    lText:=B.Text;
-    Measurer.SetFont(B.Font);
-    B.Size:=Measurer.MeasureText(lText);
-    B.LayoutPos:=CurrPos;
-    // Shift pos
-    CurrPos.X:=CurrPos.X+B.Width;
-    if B.Height>CurrHeight then
-      CurrHeight:=B.Height;
-    inc(I);
+      currPos.X := 0;
+      currPos.Y += currHeight + LineSpacing;
+      currHeight:=0;
+      Result := True;
     end;
+
+    if (lastFont = nil) or not lastFont.IsSameFont(currBlock.Font) then
+    begin
+      lastFont := currBlock.Font;
+      Measurer.SetFont(lastFont);
+    end;
+    currBlock.Size := Measurer.MeasureText(currBlock.Text);
+    currBlock.LayoutPos := currPos;
+
+    // Shift pos
+    currPos.X += currBlock.Width;
+    if currBlock.Height > currHeight then
+      currHeight := currBlock.Height;
+    Inc(i);
+  end;
 end;
 
 
@@ -1436,40 +1470,42 @@ function TTextLayouter.Execute: integer;
         Inc(Result);
   end;
 
-  Function CalcNeededHeight : TTextUnits;
-
+  function CalcNeededHeight : TTextUnits;
   var
-    I : Integer;
+    i : Integer;
     NewH : TTextUnits;
-
+    block : TTextBlock;
   begin
-    Result:=0;
-    For I:=0 to TextBlockCount-1 do
-      begin
-      With TextBlocks[i] do
-        NewH:=LayoutPos.Y+Size.Height;
-      if NewH>Result then
-        Result:=NewH;
-      end;
+    Result := 0;
+    for i := 0 to TextBlockCount-1 do
+    begin
+      block := TextBlocks[i];
+      NewH := block.LayoutPos.Y + block.Size.Height;
+      if NewH > Result then
+        Result := NewH;
+    end;
   end;
 
 begin
   Reset;
   HandleRanges;
   HandleNewLines;
+
   if WordWrap then
     WrapLayout
   else
     NoWrapLayout;
+
+  ApplyVertTextAlignment;
+  ApplyHorzTextAlignment;
+
+  // can only cull after alignment
   if StretchMode = TStretchMode.smDontStretch then
     CullTextOutOfBoundsVertically
-  else
-    ApplyStretchMode(CalcNeededHeight);
-  // We do this after vertical culling, potentially less blocks...
+  else ApplyStretchMode(CalcNeededHeight);
   CullTextOutOfBoundsHorizontally;
-  ApplyVertTextAlignment;
-  ApplyHorzTextAlignment;
-  Result:=TextBlockCount;
+
+  Result := TextBlockCount;
 end;
 
 function TTextLayouter.Execute(const aText: String): Integer;
@@ -1608,15 +1644,14 @@ begin
   Result:=yMax;
 end;
 
-function TTextLayouter.GetTotalSize: TFresnelPoint;
+function TTextLayouter.GetTotalSize: TSizeF;
 begin
-  Result.X:=GetTotalWidth;
-  Result.Y:=GetTotalHeight;
+  Result:=TSizeF.Create(GetTotalWidth,GetTotalHeight);
 end;
 
-function TTextLayouter.GetBoundsRect: TFresnelRect;
+function TTextLayouter.GetBoundsRect: TRectF;
 begin
-  Result:=TFresnelRect.Create(GetMinLeft,GetMinTop,GetMaxRight,GetMaxBottom);
+  Result:=TRectF.Create(GetMinLeft,GetMinTop,GetMaxRight,GetMaxBottom);
 end;
 
 procedure TTextLayouter.ApplyStretchMode(const ADesiredHeight: TTextUnits);
@@ -1653,7 +1688,7 @@ var
   i: integer;
   lBlock: TTextBlock;
   MaxHeight, vPos : TTextUnits;
-  lRemainingHeight: TFresnelLength;
+  lRemainingHeight: single;
   d: single;
   doDelete : Boolean;
   aSize : TTextMeasures;
@@ -1788,6 +1823,8 @@ var
     for idx := lList.Count-1 downto 0 do
     begin
       b := TTextBlock(lList[idx]);
+      if b.Size.Width = 0 then
+        b.Size := Measurer.MeasureText(b.Text);
       b.LayoutPos.X := lXOffset - b.Size.Width;
       lXOffset := b.LayoutPos.X;
     end;
@@ -1804,6 +1841,8 @@ var
     for idx := 0 to lList.Count-1 do
     begin
       b := TTextBlock(lList[idx]);
+      if b.Size.Width = 0 then
+        b.Size := Measurer.MeasureText(b.Text);
       lTotalWidth := lTotalWidth + b.Width;
     end;
     lXOffset := (Bounds.Width - lTotalWidth) / 2;
@@ -1847,193 +1886,124 @@ var
   *)
 
 begin
+  if FBlocks.Count = 0 then
+      Exit;
+
   lList := TFPList.Create;
   try
-  lLastYPos := 0;
-  i := 0;
-  While I<FBlocks.Count do
-  begin
-    tb := FBlocks[i];
-    if tb.LayoutPos.Y = lLastYPos then // still on the same text line
-      lList.Add(tb)
-    else
+    tb := FBlocks[0];
+    lLastYPos := tb.LayoutPos.y;
+    lList.Add(tb);
+    i := 1;
+    while i < FBlocks.Count do
+    begin
+      tb := FBlocks[i];
+      if tb.LayoutPos.Y = lLastYPos then // still on the same text line
+        lList.Add(tb)
+      else
+      begin
+        { a new line has started - process what we have collected in lList }
+        case HorizontalAlign of
+          TTextAlign.Leading:   ; // Nothing to do
+          TTextAlign.Trailing:  ProcessRightJustified;
+          TTextAlign.Center:    ProcessCentered;
+          // taWidth:           ProcessWidth;
+        end;
+        lList.Clear;
+        lLastYPos := tb.LayoutPos.Y;
+        lList.Add(tb)
+      end; { if..else }
+      Inc(i);
+    end; { while i<fblocks.count }
+
+    { process the last text line's items }
+    if lList.Count > 0 then
     begin
-      { a new line has started - process what we have collected in lList }
       case HorizontalAlign of
         TTextAlign.Leading:   ; // Nothing to do
         TTextAlign.Trailing:  ProcessRightJustified;
         TTextAlign.Center:    ProcessCentered;
         // taWidth:           ProcessWidth;
       end;
-      lList.Clear;
-      lLastYPos := tb.LayoutPos.Y;
-      lList.Add(tb)
-    end; { if..else }
-    inc(I);
-  end; { while i<fblocks.count }
-
-  { process the last text line's items }
-  if lList.Count > 0 then
-  begin
-    case HorizontalAlign of
-      TTextAlign.Leading:   ; // Nothing to do
-      TTextAlign.Trailing:  ProcessRightJustified;
-      TTextAlign.Center:    ProcessCentered;
-      // taWidth:           ProcessWidth;
     end;
-  end;
 
   finally
     llist.Free;
   end;
 end;
 
-{ this affects only Y coordinate of text blocks }
+// ApplyVertTextAlignment
+//
+// this affects only Y coordinate of text blocks
 procedure TTextLayouter.ApplyVertTextAlignment;
 var
-  i: integer;
-  tb: TTextBlock;
-  lList: TFPList;
-  lLastYPos: TTextUnits;
-  lTotalHeight: TTextUnits;
-  lYOffset: TTextUnits;
+  lineHeight : TTextUnits;
 
-  procedure ProcessTop;
+  function ComputeTotalHeight : TTextUnits;
   var
-    idx: integer;
-    b: TTextBlock;
+    i : Integer;
+    tb : TTextBlock;
+    lLastYPos : TTextUnits;
   begin
-    if lList.Count = 0 then
-      Exit;
-    for idx := 0 to lList.Count-1 do
-    begin
-      b := TTextBlock(lList[idx]);
-      b.LayoutPos.Y := lYOffset;
-    end;
-    lYOffset := lYOffset + LineSpacing + b.Height + b.Descender;
-  end;
-
-  procedure ProcessCenter;
-  var
-    idx: integer;
-    b: TTextBlock;
-  begin
-    for idx := 0 to lList.Count-1 do
-    begin
-      b := TTextBlock(lList[idx]);
-      b.LayoutPos.Y := lYOffset;
-    end;
-    lYOffset := lYOffset + LineSpacing + b.Height + b.Descender;
-  end;
-
-  procedure ProcessBottom;
-  var
-    idx: integer;
-    b: TTextBlock;
-  begin
-    for idx := 0 to lList.Count-1 do
-    begin
-      b := TTextBlock(lList[idx]);
-      b.LayoutPos.Y := lYOffset;
+    tb := FBlocks[0];
+    lLastYPos := tb.LayoutPos.y;
+    Result := lineHeight;
+
+    for i := 1 to FBlocks.Count-1 do begin
+      tb := FBlocks[i];
+      if tb.LayoutPos.Y <> lLastYPos then begin
+        Result += lineHeight + LineSpacing;
+        lLastYPos := tb.LayoutPos.Y;
+      end;
     end;
-    lYOffset := lYOffset - LineSpacing - b.Height - b.Descender;
   end;
 
+var
+  i: integer;
+  tb: TTextBlock;
+  lLastYPos: TTextUnits;
+  lTotalHeight: TTextUnits;
+  lYOffset: TTextUnits;
 begin
   if FBlocks.Count = 0 then
     Exit;
-  lList := TFPList.Create;
-  try
-    lLastYPos := FBlocks[FBlocks.Count-1].LayoutPos.Y;  // last textblock's Y coordinate
-    lTotalHeight := 0;
 
-    Case VerticalAlign of
-    TTextAlign.Leading:
-      begin
-      // Nothing to do
-      end;
+  // We vertically reflow the text blocks, blocks LayoutPos.y is used to determine
+  // which blocks are on the same line (actual value discarded)
+  // Current limitation: assumes all blocks are of same height (ignores block height)
+  // because block height will vary on actual content, which can be problematic
+  // (f.i. if a line has only '-' characters)
 
-    TTextAlign.Trailing:
-      begin
-      lYOffset := Bounds.Height;
-      for i := FBlocks.Count-1 downto 0 do
-        begin
-        tb := FBlocks[i];
-        if i = FBlocks.Count-1 then
-          lYOffset := lYOffset - tb.Height - tb.Descender;  // only need to do this for one line
-        if tb.LayoutPos.Y = lLastYPos then // still on the same text line
-          lList.Add(tb)
-        else
-          begin
-          { a new line has started - process what we have collected in lList }
-          ProcessBottom;
-
-          lList.Clear;
-          lLastYPos := tb.LayoutPos.Y;
-          lList.Add(tb)
-          end; { if..else }
-        end; { for i }
-      end; // TTextAlign.Trailing:
-
-    TTextAlign.Center:
-      begin
-      { First, collect the total height of all the text lines }
-      lTotalHeight := 0;
-      lLastYPos := 0;
-      for i := 0 to FBlocks.Count-1 do
-        begin
-        tb := FBlocks[i];
-        // Writeln('AlignV: block ',i,' h:',tb.Height,' desc :',tb.Descender);
-        if i = 0 then  // do this only for the first block
-          lTotalHeight := tb.Height; // + tb.Descender;
-        if tb.LayoutPos.Y = lLastYPos then // still on the same text line
-          Continue
-        else
-          begin
-          { a new line has started - process what we have collected in lList }
-          lTotalHeight := lTotalHeight + LineSpacing + tb.Height // + tb.Descender;
-          end; { if..else }
-        lLastYPos := tb.LayoutPos.Y;
-        end; { for i }
+  lineHeight :=  Measurer.LineHeight;
 
-      { Now process them line-by-line }
-      lList.Clear;
-      lYOffset := (Bounds.Height - lTotalHeight) / 2;
-      // Writeln('AlignV: Bounds.Height : ',Bounds.Height:8:2,' total : ',lTotalHeight :8:2,',offset: ',lYOffset:8:2);
+  case VerticalAlign of
+    TTextAlign.Center :
+      lYOffset := (Bounds.Height - ComputeTotalHeight) / 2;
 
-      lLastYPos := 0;
-      for i := 0 to FBlocks.Count-1 do
-        begin
-        tb := FBlocks[i];
-        if tb.LayoutPos.Y = lLastYPos then // still on the same text line
-          lList.Add(tb)
-        else
-        begin
-          { a new line has started - process what we have collected in lList }
-          ProcessCenter;
+    TTextAlign.Trailing :
+      lYOffset := Bounds.Height - ComputeTotalHeight;
+  else
+    // TTextAlign.Leading & fallback
+    lYOffset := 0;
+  end;
 
-          lList.Clear;
-          lLastYPos := tb.LayoutPos.Y;
-          lList.Add(tb)
-        end; { if..else }
-        end; { for i }
-      end; // TTextAlign.Center
-    end; // Case
+  tb := FBlocks[0];
+  lLastYPos := tb.LayoutPos.y;
+  tb.LayoutPos.y := lYOffset;
+  //Writeln('yOffset block 0 ', lYOffset, ' for bounds height ', bounds.Height);
 
-    { process the last text line's items }
-    if lList.Count > 0 then
-    begin
-      case VerticalAlign of
-        TTextAlign.Leading:  ProcessTop;
-        TTextAlign.Center:   ProcessCenter;
-        TTextAlign.Trailing: ProcessBottom;
-      end;
+  for i := 1 to FBlocks.Count-1 do begin
+    tb := FBlocks[i];
+    if tb.LayoutPos.y = lLastYPos then
+      tb.LayoutPos.y := lYOffset
+    else begin
+      lLastYPos := tb.LayoutPos.y;
+      lYOffset += lineHeight + LineSpacing;
+      tb.LayoutPos.y := lYOffset;
     end;
-  finally
-    lList.Free;
+    //Writeln(lYOffset);
   end;
 end;
 
-
 end.