mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 03:59:28 +02:00
* Merging revisions r43490 from trunk:
------------------------------------------------------------------------
r43490 | michael | 2019-11-16 13:11:32 +0100 (Sat, 16 Nov 2019) | 1 line
* Fix overflow in case of disabled wordwrap (bug ID 33356)
------------------------------------------------------------------------
git-svn-id: branches/fixes_3_2@43720 -
This commit is contained in:
michael
parent
c561c43c32
commit
61ff151b2e
@ -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,
|
||||
fpTTF;
|
||||
base64;
|
||||
|
||||
resourcestring
|
||||
cPageCountMarker = '~PC~';
|
||||
@ -3926,95 +3927,94 @@ begin
|
||||
Changed;
|
||||
end;
|
||||
|
||||
procedure TFPReportCustomMemo.SetWordWrapOverflow(AValue: TFPReportWordWrapOverflow);
|
||||
procedure TFPReportCustomMemo.SetWordOverflow(AValue: TFPReportWordOverflow);
|
||||
begin
|
||||
if FWordWrapOverflow=AValue then Exit;
|
||||
FWordWrapOverflow:=AValue;
|
||||
if FWordOverflow=AValue then Exit;
|
||||
FWordOverflow:=AValue;
|
||||
Changed;
|
||||
end;
|
||||
|
||||
procedure TFPReportCustomMemo.WrapText(const AText: String; var ALines: TStrings; const ALineWidth: TFPReportUnits; out
|
||||
AHeight: TFPReportUnits);
|
||||
{ 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 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
|
||||
@ -4022,10 +4022,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);
|
||||
@ -4033,35 +4029,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);
|
||||
@ -4906,7 +4901,10 @@ procedure TFPReportCustomMemo.RecalcLayout;
|
||||
end;
|
||||
|
||||
var
|
||||
h: TFPReportUnits;
|
||||
h, maxW: TFPReportUnits;
|
||||
lFC : TFPFontCacheItem;
|
||||
S : String;
|
||||
|
||||
begin
|
||||
FTextBlockList.Clear;
|
||||
FCurTextBlock := nil;
|
||||
@ -4914,11 +4912,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));
|
||||
@ -5142,7 +5147,7 @@ begin
|
||||
TextAlignment.Assign(E.TextAlignment);
|
||||
Options := E.Options;
|
||||
Original := E;
|
||||
WordWrapOverflow:= E.WordWrapOverflow;
|
||||
WordOverflow:= E.WordOverflow;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user