* Fix overflow in case of disabled wordwrap (bug ID 33356)

git-svn-id: trunk@43490 -

packages/fcl-report/src/fpreport.pp

@@ -33,6 +33,7 @@ uses
   contnrs,
   fpCanvas,
   fpImage,
+  fpTTF,
   fpreportstreamer,
 {$IF FPC_FULLVERSION>=30101}
   fpexprpars,
@@ -142,7 +143,7 @@ type
             moResetAggregateOnColumn
             );
   TFPReportMemoOptions    = set of TFPReportMemoOption;
-  TFPReportWordWrapOverflow = (wwoTruncate,wwoOverflow,wwoSplit);
+  TFPReportWordOverflow = (woTruncate,woOverflow,woSplit);
 
   TFPReportSections    = set of rsPage..rsColumn;
 
@@ -1930,13 +1931,13 @@ type
     ExpressionNodes: array of TExprNodeInfoRec;
     FFont: TFPReportFont;
     FUseParentFont: Boolean;
-    FWordWrapOverflow: TFPReportWordWrapOverflow;
+    FWordOverflow: TFPReportWordOverflow;
     function    GetParentFont: TFPReportFont;
     procedure   HandleFontChange(Sender: TObject);
     procedure   SetCullThreshold(AValue: TFPReportCullThreshold);
     procedure   SetText(AValue: TFPReportString);
     procedure   SetUseParentFont(AValue: Boolean);
-    procedure   SetWordWrapOverflow(AValue: TFPReportWordWrapOverflow);
+    procedure   SetWordOverflow(AValue: TFPReportWordOverflow);
     procedure   ApplyHorzTextAlignment;
     procedure   ApplyVertTextAlignment;
     function    GetTextLines: TStrings;
@@ -1960,7 +1961,8 @@ type
     procedure   SetFont(const AValue: TFPReportFont);
     procedure   CullTextOutOfBounds;
   protected
-    procedure   WrapText(const AText: String; var ALines: TStrings; const ALineWidth: TFPReportUnits; out AHeight: TFPReportUnits); virtual;
+    procedure AddTextLine(lFC: TFPFontCacheItem; var S: String; MaxW: TFPReportUnits);
+    procedure WrapText(const AText: String; lFC: TFPFontCacheItem; const ALineWidth: TFPReportUnits; out AHeight: TFPReportUnits);  virtual;
     procedure   ReassignParentFont;
     procedure   ParentFontChanged; override;
     function    CreateTextAlignment: TFPReportTextAlignment; virtual;
@@ -1984,7 +1986,7 @@ type
     property    UseParentFont: Boolean read FUseParentFont write SetUseParentFont default True;
     { % of line height that should be visible, otherwise it's culled if StretchMode = smDontStretch. Valid range is 1-100% and default is 75%}
     property    CullThreshold: TFPReportCullThreshold read FCullThreshold write SetCullThreshold default 75;
-    Property    WordWrapOverflow : TFPReportWordWrapOverflow read FWordWrapOverflow write SetWordWrapOverflow;
+    Property    WordOverflow : TFPReportWordOverflow read FWordOverflow write SetWordOverflow;
   protected
     // *****************************
     //   This block is made Protected simply for Unit Testing purposes.
@@ -2026,7 +2028,7 @@ type
     property  LineSpacing;
     property  LinkColor;
     property  Options;
-    Property  WordWrapOverflow;
+    Property  WordOverflow;
     property  StretchMode;
     property  Text;
     property  TextAlignment;
@@ -2353,8 +2355,7 @@ uses
   typinfo,
   FPReadPNG,
   FPWritePNG,
-  base64,
+  base64;
-  fpTTF;
 
 resourcestring
   cPageCountMarker = '~PC~';
@@ -3916,95 +3917,94 @@ begin
   Changed;
 end;
 
-procedure TFPReportCustomMemo.SetWordWrapOverflow(AValue: TFPReportWordWrapOverflow);
+procedure TFPReportCustomMemo.SetWordOverflow(AValue: TFPReportWordOverflow);
 begin
-  if FWordWrapOverflow=AValue then Exit;
+  if FWordOverflow=AValue then Exit;
-  FWordWrapOverflow:=AValue;
+  FWordOverflow:=AValue;
   Changed;
 end;
 
-procedure TFPReportCustomMemo.WrapText(const AText: String; var ALines: TStrings; const ALineWidth: TFPReportUnits; out
+{ All = True) indicates that if the text is split over multiple lines the last
-  AHeight: TFPReportUnits);
+  line must also be processed before continuing. If All = False, then double
+  CR can be ignored. }
+
+procedure TFPReportCustomMemo.AddTextLine(lFC: TFPFontCacheItem; Var S : String; MaxW : TFPReportUnits);
+
+var
+  w: single;
+  m: integer;
+  s2, s3: string;
+begin
+  s2  := s;
+  w   := lFC.TextWidth(s2, Font.Size);
+  if (Length(s2) > 1) and (w > maxw) then
+  begin
+    while w > maxw do
+    begin
+      m := Length(s);
+      repeat
+        Dec(m);
+        s2  := Copy(s,1,m);
+        w   := lFC.TextWidth(s2, Font.Size);
+      until w <= maxw;
+
+      s3 := s2; // we might need the value of s2 later again
+
+      // are we in the middle of a word. If so find the beginning of word.
+      while (m > 0) and (s2[m] <> ' ') do
+        Dec(m);
+      s2  := Copy(s,1,m);
+
+      if s2 = '' then
+        begin
+        // Single word does not fit. S3 is max word that fits.
+        s2 := s3;
+        Case WordOverflow of
+          woOverflow:
+            begin
+              { We reached the beginning of the line without finding a word that fits the maxw.
+                So we are forced to use a longer than maxw word. We were in the middle of
+                a word, so now find the end of the current word. }
+            m := Length(s2);
+            while (m < Length(s)) and (s[m]<> ' ') do
+              Inc(m);
+            s2:=Copy(s,1,m);
+            end;
+          woTruncate:
+            m:=Length(S); // Discard the remainder of the word.
+          woSplit:
+            m:=Length(S3); // S3 was the longest possible part of the word. Split after
+       end;
+       end;
+      FTextLines.Add(s2);
+      s   := Copy(s, m+1, Length(s));
+      s2  := s;
+      w   := lFC.TextWidth(s2, Font.Size);
+    end; { while }
+    if s2 <> '' then
+      FTextLines.Add(s2);
+    s := '';
+  end
+  else
+  begin
+    if s2 <> '' then
+      FTextLines.Add(s2);
+    s := '';
+  end; { if/else }
+end;
+
+procedure TFPReportCustomMemo.WrapText(const AText: String; lFC: TFPFontCacheItem; const ALineWidth: TFPReportUnits; out AHeight: TFPReportUnits);
+
 var
   maxw: single; // value in pixels
   n: integer;
   s: string;
   c: char;
   lWidth: single;
-  lFC: TFPFontCacheItem;
+
   lDescenderHeight: single;
   lHeight: single;
 
-  // -----------------
-  { All = True) indicates that if the text is split over multiple lines the last
-    line must also be processed before continuing. If All = False, then double
-    CR can be ignored. }
-  procedure AddLine(all: boolean);
-  var
-    w: single;
-    m: integer;
-    s2, s3: string;
-  begin
-    s2  := s;
-    w   := lFC.TextWidth(s2, Font.Size);
-    if (Length(s2) > 1) and (w > maxw) then
-    begin
-      while w > maxw do
-      begin
-        m := Length(s);
-        repeat
-          Dec(m);
-          s2  := Copy(s,1,m);
-          w   := lFC.TextWidth(s2, Font.Size);
-        until w <= maxw;
-
-        s3 := s2; // we might need the value of s2 later again
-
-        // are we in the middle of a word. If so find the beginning of word.
-        while (m > 0) and (s2[m] <> ' ') do
-          Dec(m);
-        s2  := Copy(s,1,m);
-
-        if s2 = '' then
-          begin
-          // Single word does not fit. S3 is max word that fits.
-          s2 := s3;
-          Case WordWrapOverflow of
-            wwoOverflow:
-              begin
-                { We reached the beginning of the line without finding a word that fits the maxw.
-                  So we are forced to use a longer than maxw word. We were in the middle of
-                  a word, so now find the end of the current word. }
-              m := Length(s2);
-              while (m < Length(s)) and (s[m]<> ' ') do
-                Inc(m);
-              s2:=Copy(s,1,m);
-              end;
-            wwoTruncate:
-              m:=Length(S); // Discard the remainder of the word.
-            wwoSplit:
-              m:=Length(S3); // S3 was the longest possible part of the word. Split after
-         end;
-         end;
-        ALines.Add(s2);
-        s   := Copy(s, m+1, Length(s));
-        s2  := s;
-        w   := lFC.TextWidth(s2, Font.Size);
-      end; { while }
-      if all then
-      begin
-        if s2 <> '' then
-          ALines.Add(s2);
-        s := '';
-      end;
-    end
-    else
-    begin
-      if s2 <> '' then
-        ALines.Add(s2);
-      s := '';
-    end; { if/else }
-  end;
 
 begin
   if AText = '' then
@@ -4012,10 +4012,6 @@ begin
 
   if ALineWidth = 0 then
     Exit;
-  { We are doing a PostScript Name lookup (it contains Bold, Italic info) }
-  lFC := gTTFontCache.FindFont(Font.Name);
-  if not Assigned(lFC) then
-    raise EReportFontNotFound.CreateFmt(SErrFontNotFound, [Font.Name]);
   { result is in pixels }
   lWidth := lFC.TextWidth(Text, Font.Size);
   lHeight := lFC.TextHeight(Text, Font.Size, lDescenderHeight);
@@ -4023,35 +4019,34 @@ begin
   AHeight := PixelsToMM(lHeight+lDescenderHeight);
 
   s := '';
-  ALines.Clear;
   n := 1;
   maxw := mmToPixels(ALineWidth - TextAlignment.LeftMargin - TextAlignment.RightMargin);
   { Do we really need to do text wrapping? There must be no linefeed characters and lWidth must be less than maxw. }
   if ((Pos(#13, AText) = 0) and (Pos(#10, AText) = 0)) and (lWidth <= maxw) then
   begin
-    ALines.Add(AText);
+    FTextLines.Add(AText);
     Exit;
   end;
 
   { We got here, so wrapping is needed. First process line wrapping as indicated
     by LineEnding characters in the text. }
   while n <= Length(AText) do
-  begin
+    begin
     c := AText[n];
     if (c = #13) or (c = #10) then
     begin
       { See code comment of AddLine() for the meaning of the True argument. }
-      AddLine(true);
+      AddTextLine(lfc,S,maxw);
       if (c = #13) and (n < Length(AText)) and (AText[n+1] = #10) then
         Inc(n);
     end
     else
       s := s + c;
     Inc(n);
-  end; { while }
+    end; { while }
 
   { Now wrap lines that are longer than ALineWidth }
-  AddLine(true);
+  AddTextLine(lfc,S,maxW);
 end;
 
 procedure TFPReportElement.ApplyStretchMode(const ADesiredHeight: TFPReportUnits);
@@ -4896,7 +4891,10 @@ procedure TFPReportCustomMemo.RecalcLayout;
   end;
 
 var
-  h: TFPReportUnits;
+  h, maxW: TFPReportUnits;
+  lFC : TFPFontCacheItem;
+  S : String;
+
 begin
   FTextBlockList.Clear;
   FCurTextBlock := nil;
@@ -4904,11 +4902,18 @@ begin
     FTextLines := TStringList.Create
   else
     FTextLines.Clear;
-
+  { We are doing a PostScript Name lookup (it contains Bold, Italic info) }
+  lFC := gTTFontCache.FindFont(Font.Name);
+  if not Assigned(lFC) then
+    raise EReportFontNotFound.CreateFmt(SErrFontNotFound, [Font.Name]);
   if not (moDisableWordWrap in Options) then
-    WrapText(Text, FTextLines, Layout.Width, h)
+    WrapText(Text, lfc, Layout.Width, h)
   else
-    FTextLines.Add(Text);
+    begin
+    maxw := mmToPixels(Layout.Width - TextAlignment.LeftMargin - TextAlignment.RightMargin);
+    S:=Text;
+    AddTextLine(lfc,S,maxw);
+    end;
 
   if StretchMode <> smDontStretch then
     ApplyStretchMode(CalcNeededHeight(h));
@@ -5132,7 +5137,7 @@ begin
     TextAlignment.Assign(E.TextAlignment);
     Options := E.Options;
     Original := E;
-    WordWrapOverflow:= E.WordWrapOverflow;
+    WordOverflow:= E.WordOverflow;
   end;
 end;