Merge pull request #25 from digao-dalpiaz/line-spacing

Line spacing
digao-dalpiaz · Jul 31, 2020 · 4b87144 · 4b87144
2 parents 4abfad5 + 19f9085
commit 4b87144
Show file tree

Hide file tree

Showing 4 changed files with 114 additions and 21 deletions.
diff --git a/DzHTMLText.pas b/DzHTMLText.pas
@@ -174,6 +174,7 @@   TDzHTMLText = class(TGraphicControl)
     FOnRetrieveImgRes: TDHEvRetrieveImgRes;
 
     FLineVertAlign: TDHLineVertAlign;
+    FLineSpacing: Integer;
     FListLevelPadding: Integer;
 
     FOnLinkEnter, FOnLinkLeave: TDHEvLink;
@@ -208,6 +209,7 @@   TDzHTMLText = class(TGraphicControl)
     procedure SetCursorWithoutChange(C: TCursor);
     procedure SetImages(const Value: TCustomImageList);
     procedure SetLineVertAlign(const Value: TDHLineVertAlign);
+    procedure SetLineSpacing(const Value: Integer);
     procedure SetListLevelPadding(const Value: Integer);
     //procedure SetTransparent(const Value: Boolean);
   protected
@@ -303,6 +305,7 @@   TDzHTMLText = class(TGraphicControl)
     property AutoOpenLink: Boolean read FAutoOpenLink write FAutoOpenLink default True;
 
     property LineVertAlign: TDHLineVertAlign read FLineVertAlign write SetLineVertAlign default vaTop;
+    property LineSpacing: Integer read FLineSpacing write SetLineSpacing default 0;
     property ListLevelPadding: Integer read FListLevelPadding write SetListLevelPadding default _DEF_LISTLEVELPADDING;
 
     property About: String read FAbout;
@@ -449,7 +452,7 @@ constructor TDzHTMLText.Create(AOwner: TComponent);
   ControlStyle := ControlStyle + [csOpaque];
   //Warning! The use of transparency in the component causes flickering
 
-  FAbout := 'Digao Dalpiaz / Version 2.1';
+  FAbout := 'Digao Dalpiaz / Version 2.2';
 
   FLines := TStringList.Create;
   FLines.TrailingLineBreak := False;
@@ -591,6 +594,16 @@ procedure TDzHTMLText.SetLineVertAlign(const Value: TDHLineVertAlign);
   end;
 end;
 
+procedure TDzHTMLText.SetLineSpacing(const Value: Integer);
+begin
+  if Value<>FLineSpacing then
+  begin
+    FLineSpacing := Value;
+
+    BuildAndPaint;
+  end;
+end;
+
 procedure TDzHTMLText.SetListLevelPadding(const Value: Integer);
 begin
   if Value<>FListLevelPadding then
@@ -893,7 +906,8 @@ procedure TDzHTMLText.CMMouseleave(var Message: TMessage);
     ttImage, ttImageResource,
     ttBulletList, ttNumberList, ttListItem,
     ttFloat,
-    ttSpoilerTitle, ttSpoilerDetail);
+    ttSpoilerTitle, ttSpoilerDetail,
+    ttLineSpace);
 
   TToken = class
     Kind: TTokenKind;
@@ -991,13 +1005,13 @@ procedure TBuilder.AddToken(aKind: TTokenKind; aTagClose: Boolean = False; const
   LToken.Add(T);
 end;
 
-function Tag_Index_ProcValue(const Value: String; var Valid: Boolean): Integer;
+function Tag_IntZeroBased_ProcValue(const Value: String; var Valid: Boolean): Integer;
 begin
   Result := StrToIntDef(Value, -1);
   Valid := (Result>-1);
 end;
 
-function Tag_Number_ProcValue(const Value: String; var Valid: Boolean): Integer;
+function Tag_IntOneBased_ProcValue(const Value: String; var Valid: Boolean): Integer;
 begin
   Result := StrToIntDef(Value, 0);
   Valid := (Result>0);
@@ -1016,30 +1030,31 @@ type TDefToken = record
   AllowPar, OptionalPar: Boolean;
   ProcValue: function(const Value: String; var Valid: Boolean): Integer;
 end;
-const DEF_TOKENS: array[0..22] of TDefToken = (
+const DEF_TOKENS: array[0..23] of TDefToken = (
   (Ident: 'BR'; Kind: ttBreak; Single: True),
   (Ident: 'B'; Kind: ttBold),
   (Ident: 'I'; Kind: ttItalic),
   (Ident: 'U'; Kind: ttUnderline),
   (Ident: 'S'; Kind: ttStrike),
   (Ident: 'FN'; Kind: ttFontName; AllowPar: True),
-  (Ident: 'FS'; Kind: ttFontSize; AllowPar: True; ProcValue: Tag_Number_ProcValue),
+  (Ident: 'FS'; Kind: ttFontSize; AllowPar: True; ProcValue: Tag_IntOneBased_ProcValue),
   (Ident: 'FC'; Kind: ttFontColor; AllowPar: True; ProcValue: Tag_Color_ProcValue),
   (Ident: 'BC'; Kind: ttBackColor; AllowPar: True; ProcValue: Tag_Color_ProcValue),
   (Ident: 'A'; Kind: ttLink; AllowPar: True; OptionalPar: True),
   (Ident: 'L'; Kind: ttAlignLeft),
   (Ident: 'C'; Kind: ttAlignCenter),
   (Ident: 'R'; Kind: ttAlignRight),
-  (Ident: 'T'; Kind: ttTab; Single: True; AllowPar: True; ProcValue: Tag_Number_ProcValue),
-  (Ident: 'TF'; Kind: ttTabF; Single: True; AllowPar: True; ProcValue: Tag_Number_ProcValue),
-  (Ident: 'IMG'; Kind: ttImage; Single: True; AllowPar: True; ProcValue: Tag_Index_ProcValue),
+  (Ident: 'T'; Kind: ttTab; Single: True; AllowPar: True; ProcValue: Tag_IntOneBased_ProcValue),
+  (Ident: 'TF'; Kind: ttTabF; Single: True; AllowPar: True; ProcValue: Tag_IntOneBased_ProcValue),
+  (Ident: 'IMG'; Kind: ttImage; Single: True; AllowPar: True; ProcValue: Tag_IntZeroBased_ProcValue),
   (Ident: 'IMGRES'; Kind: ttImageResource; Single: True; AllowPar: True),
   (Ident: 'UL'; Kind: ttBulletList), //Unordered HTML List
   (Ident: 'OL'; Kind: ttNumberList), //Ordered HTML List
   (Ident: 'LI'; Kind: ttListItem), //HTML List Item
   (Ident: 'FLOAT'; Kind: ttFloat; AllowPar: True), //Floating div
   (Ident: 'SPOILER'; Kind: ttSpoilerTitle; AllowPar: True),
-  (Ident: 'SDETAIL'; Kind: ttSpoilerDetail; AllowPar: True)
+  (Ident: 'SDETAIL'; Kind: ttSpoilerDetail; AllowPar: True),
+  (Ident: 'LS'; Kind: ttLineSpace; AllowPar: True; ProcValue: Tag_IntZeroBased_ProcValue)
 );
 
 function TBuilder.ProcessTag(const Tag: String): Boolean;
@@ -1168,7 +1183,7 @@ procedure TBuilder.ReadTokens;
 
   Text := StringReplace(Text, #13#10'<NBR>', EmptyStr, [rfReplaceAll, rfIgnoreCase]); //ignore next break
   Text := StringReplace(Text, #13#10, '<BR>', [rfReplaceAll]);
-  if not Text.IsEmpty then Text := Text + '<BR>'; //final height and linecount adjust
+  if not Text.IsEmpty then Text := Text + '<BR>'; //internal final break
 
   while not Text.IsEmpty do
   begin
@@ -1280,6 +1295,9 @@ function THTMLSpoilerDetList.IsAllOpened(Lb: TDzHTMLText): Boolean;
 end;
 
 type
+  TLineInfo = class
+    Height, Space: Integer;
+  end;
   TGroupBound = class
     Right, Limit: Integer;
   end;
@@ -1313,6 +1331,7 @@   TPreObj_Visual = class(TPreObj)
     {The group is isolated at each line or tabulation to delimit text horizontal align area}
     FixedPos: TFixedPosition;
     Align: TAlignment;
+    LineSpace: Integer;
     Space: Boolean;
     Print: Boolean;
 
@@ -1334,13 +1353,14 @@   TTokensProcess = class
     Lb: TDzHTMLText;
     C: TCanvas;
 
-    LLineHeight: TList<Integer>;
+    LLineInfo: TObjectList<TLineInfo>;
     LGroupBound: TObjectList<TGroupBound>;
 
     Items: TListPreObj;
 
     BackColor: TColor;
     Align: TAlignment;
+    LineSpace: Integer;
 
     LBold: TListStack<Boolean>;
     LItalic: TListStack<Boolean>;
@@ -1351,6 +1371,7 @@   TTokensProcess = class
     LFontColor: TListStack<TColor>;
     LBackColor: TListStack<TColor>;
     LAlign: TListStack<TAlignment>;
+    LLineSpace: TListStack<Integer>;
     LHTMLList: TObjectListStack<THTMLList>;
     LSpoilerDet: THTMLSpoilerDetList;
 
@@ -1366,6 +1387,7 @@   TTokensProcess = class
     procedure DoFontColor(T: TToken);
     procedure DoBackColor(T: TToken);
     procedure DoAlignment(T: TToken);
+    procedure DoLineSpace(T: TToken);
     procedure DoTextAndRelated(T: TToken);
     procedure DoLink(T: TToken; I: Integer);
     procedure DoLists(T: TToken);
@@ -1403,9 +1425,10 @@ constructor TTokensProcess.Create(xBuilder: TBuilder);
 
   BackColor := clNone;
   Align := taLeftJustify;
+  LineSpace := Lb.FLineSpacing;
 
   Items := TListPreObj.Create;
-  LLineHeight := TList<Integer>.Create;
+  LLineInfo := TObjectList<TLineInfo>.Create;
   LGroupBound := TObjectList<TGroupBound>.Create;
 
   LBold := TListStack<Boolean>.Create;
@@ -1417,6 +1440,8 @@ constructor TTokensProcess.Create(xBuilder: TBuilder);
   LFontColor := TListStack<TColor>.Create;
   LBackColor := TListStack<TColor>.Create;
   LAlign := TListStack<TAlignment>.Create;
+  LLineSpace := TListStack<Integer>.Create;
+
   LHTMLList := TObjectListStack<THTMLList>.Create;
   LSpoilerDet := THTMLSpoilerDetList.Create;
 
@@ -1429,12 +1454,13 @@ constructor TTokensProcess.Create(xBuilder: TBuilder);
   LFontColor.Add(C.Font.Color);
   LBackColor.Add(BackColor);
   LAlign.Add(Align);
+  LLineSpace.Add(LineSpace);
 end;
 
 destructor TTokensProcess.Destroy;
 begin
   Items.Free;
-  LLineHeight.Free;
+  LLineInfo.Free;
   LGroupBound.Free;
 
   LBold.Free;
@@ -1446,6 +1472,8 @@ destructor TTokensProcess.Destroy;
   LFontColor.Free;
   LBackColor.Free;
   LAlign.Free;
+  LLineSpace.Free;
+
   LHTMLList.Free;
   LSpoilerDet.Free;
   inherited;
@@ -1474,6 +1502,7 @@ procedure TTokensProcess.Execute;
       ttFontColor: DoFontColor(T);
       ttBackColor: DoBackColor(T);
       ttAlignLeft, ttAlignCenter, ttAlignRight: DoAlignment(T);
+      ttLineSpace: DoLineSpace(T);
       ttText, ttSpace, ttInvalid, ttImage, ttImageResource, ttListItem: DoTextAndRelated(T);
       ttLink: DoLink(T, I);
       ttBulletList, ttNumberList: DoLists(T);
@@ -1540,6 +1569,12 @@ procedure TTokensProcess.DoAlignment(T: TToken);
   Align := LAlign.Last;
 end;
 
+procedure TTokensProcess.DoLineSpace(T: TToken);
+begin
+  LLineSpace.AddOrDel(T, T.Value);
+  LineSpace := LLineSpace.Last;
+end;
+
 procedure TTokensProcess.DoTextAndRelated(T: TToken);
 var
   Ex: TSize;
@@ -1617,6 +1652,7 @@ procedure TTokensProcess.DoTextAndRelated(T: TToken);
   Z := TPreObj_Visual.Create;
   Z.Size := Ex;
   Z.Align := Align;
+  Z.LineSpace := LineSpace;
   Z.Space := T.Kind=ttSpace;
   Z.FixedPos := FixedPos;
   Z.Visual := W;
@@ -1738,7 +1774,7 @@ procedure TTokensProcess.DoBreak;
 
 procedure TTokensProcess.Realign;
 type TSizes = record
-  LineHeight, OverallWidth, OverallHeight: Integer;
+  LineHeight, LineSpace, OverallWidth, OverallHeight: Integer;
 end;
 var
   Z: TPreObj;
@@ -1790,20 +1826,27 @@ type TSizes = record
 
   procedure BreakGroupAndLineCtrl(Forward: Boolean; NewPoint: TPoint);
   var GrpLim: Integer;
+    LI: TLineInfo;
   begin
     GrpLim := -1;
     if FloatRect.Width>0 then GrpLim := FloatRect.Right;
     IncPreviousGroup(X, GrpLim);
 
-    LLineHeight.Add(Max.LineHeight);
+    LI := TLineInfo.Create;
+    LI.Height := Max.LineHeight;
+    LI.Space := Max.LineSpace;
+    LLineInfo.Add(LI);
     if Forward then
     begin
-      CurLine := LLineHeight.Count;
+      CurLine := LLineInfo.Count;
       Max.LineHeight := 0;
+      Max.LineSpace := 0;
     end else
     begin
-      CurLine := PrevLine; //restore current line
-      Max.LineHeight := LLineHeight[CurLine]; //restore max height
+      //restore line info
+      CurLine := PrevLine;
+      Max.LineHeight := LLineInfo[CurLine].Height;
+      Max.LineSpace := LLineInfo[CurLine].Space;
     end;
 
     X := NewPoint.X;
@@ -1869,7 +1912,7 @@ type TSizes = record
         CheckPriorSpace; //remove space at previous line if is the last obj
 
       if not InFloat then Inc(LineCount);
-      BreakGroupAndLineCtrl(True, TPoint.Create(FloatRect.Left, Y+Max.LineHeight));
+      BreakGroupAndLineCtrl(True, TPoint.Create(FloatRect.Left, Y+Max.LineHeight+Max.LineSpace));
       //if line is empty, there is no visual item to check overall height
       if Y>Max.OverallHeight then Max.OverallHeight := Y;
 
@@ -1899,6 +1942,7 @@ type TSizes = record
     if V.Visual.Rect.Right>Max.OverallWidth then Max.OverallWidth := V.Visual.Rect.Right;
     if V.Visual.Rect.Bottom>Max.OverallHeight then Max.OverallHeight := V.Visual.Rect.Bottom;
     if V.Visual.Rect.Height>Max.LineHeight then Max.LineHeight := V.Visual.Rect.Height;
+    if V.LineSpace>Max.LineSpace then Max.LineSpace := V.LineSpace;
 
     X := V.Visual.Rect.Right;
   end;
@@ -1941,7 +1985,7 @@ procedure TTokensProcess.Publish;
     //vertical align
     if Lb.FLineVertAlign in [vaCenter, vaBottom] then
     begin
-      Offset := LLineHeight[V.Line] - V.Visual.Rect.Height;
+      Offset := LLineInfo[V.Line].Height - V.Visual.Rect.Height;
       if Lb.FLineVertAlign=vaCenter then Offset := Offset div 2;
 
       V.Visual.Rect.Offset(0, Offset);

diff --git a/README.md b/README.md
@@ -28,6 +28,10 @@
 
 ## What's New
 
+- 07/31/2020 (Version 2.2)
+
+   - Add new tag `<LS>` for line spacing.
+
 - 07/30/2020 (Version 2.1)
 
    - Implemented new Lines (TStrings) property and removed Text published property. :warning:
@@ -171,6 +175,7 @@ Here are all possible tags you can use in text:
 <FLOAT:X,Y[,Width]></FLOAT> - Floating area
 <SPOILER:name></SPOILER> - Spoiler Title
 <SDETAIL:name></SDETAIL> - Spoiler Detail
+<LS:nnn></LS> - Line spacing where 'nnn' is the height in pixels
 ```
 
 > The tags notation is case-insensitive, so you can use `<B>Text</B>` or `<b>Text</b>`.
@@ -220,6 +225,8 @@ This property calls ShellExecute method.
 
 > The component automatically converts #13#10 sequence into a line break. Because of this behavior, all typed line breaks will appear as a real line break. If you don't want the line break in a specific sequence, you can use the `<NBR>` tag after #13#10 characters. This will tell the component to not consider the sequence as a line break (Please check this tag at Example project).
 
+`LineSpacing: Integer` = Specify the default line spacing in overall text. You can use `<LS>` tag to determine line spacing at specific lines.
+
 `LineVertAlign: TDHLineVertAlign (vaTop, vaCenter, vaBottom)` = Allows you to specify the vertical alignment of each element in the line. This property only take effects when the elements have different heights. Default is `vaTop`.
 
 `ListLevelPadding: Integer` = Determines the width of each list level in pixels, when using HTML list tags.

diff --git a/Test/UFrmMain.dfm b/Test/UFrmMain.dfm
@@ -134,4 +134,44 @@ object FrmMain: TFrmMain
         '<sdetail:sp1><i>This is more info about the first spoiler</i></s' +
         'detail>')
   end
+  object DzHTMLText7: TDzHTMLText
+    Left = 464
+    Top = 8
+    Width = 281
+    Height = 205
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -21
+    Font.Name = 'Tahoma'
+    Font.Style = []
+    ParentFont = False
+    Lines.Strings = (
+      'Line 1'
+      'Line 2'
+      'Line 3'
+      ''
+      'Line 5')
+    AutoHeight = True
+    LineSpacing = 20
+  end
+  object DzHTMLText8: TDzHTMLText
+    Left = 464
+    Top = 224
+    Width = 281
+    Height = 190
+    Font.Charset = DEFAULT_CHARSET
+    Font.Color = clWindowText
+    Font.Height = -21
+    Font.Name = 'Tahoma'
+    Font.Style = []
+    ParentFont = False
+    Lines.Strings = (
+      '<bc:clYellow>Line 1'
+      '<ls:5>Line 2 (Line Space: 5px)</ls>'
+      'Line 3'
+      ''
+      'Line 5</bc>')
+    AutoHeight = True
+    LineSpacing = 20
+  end
 end
diff --git a/Test/UFrmMain.pas b/Test/UFrmMain.pas
@@ -14,6 +14,8 @@   TFrmMain = class(TForm)
     DzHTMLText4: TDzHTMLText;
     DzHTMLText5: TDzHTMLText;
     DzHTMLText6: TDzHTMLText;
+    DzHTMLText7: TDzHTMLText;
+    DzHTMLText8: TDzHTMLText;
   private
     { Private declarations }
   public