paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-19 05:09:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Correct font handling for blocks in memos with different fonts (bug ID 36459, patch by Andi Friess)

Browse Source 
git-svn-id: trunk@43701 -
This commit is contained in:
michael 2019-12-20 15:28:57 +00:00
parent c09c8ed845
commit 3440d166ae
1 changed files with 16 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
packages/fcl-report/src/fpreport.pp
View File

@ -1953,9 +1953,11 @@ type
function PixelsToMM(APixels: single): single; inline; function PixelsToMM(APixels: single): single; inline;
function mmToPixels(mm: single): integer; inline; function mmToPixels(mm: single): integer; inline;
{ Result is in millimeters. } { Result is in millimeters. }
function TextHeight(const AText: string; out ADescender: TFPReportUnits): TFPReportUnits; function TextHeight(const AText, FontName: string; FontSize: Integer; out
ADescender: TFPReportUnits): TFPReportUnits;
{ Result is in millimeters. } { Result is in millimeters. }
function TextWidth(const AText: string): TFPReportUnits; function TextWidth(const AText, FontName: string; FontSize: Integer
): TFPReportUnits;
procedure SetLinkColor(AValue: TFPReportColor); procedure SetLinkColor(AValue: TFPReportColor);
procedure SetTextAlignment(AValue: TFPReportTextAlignment); procedure SetTextAlignment(AValue: TFPReportTextAlignment);
procedure SetOptions(const AValue: TFPReportMemoOptions); procedure SetOptions(const AValue: TFPReportMemoOptions);
@ -4511,8 +4513,8 @@ begin
FCurTextBlock.FontName := lNewFontName; FCurTextBlock.FontName := lNewFontName;
FCurTextBlock.Width := TextWidth(FCurTextBlock.Text); FCurTextBlock.Width := TextWidth(FCurTextBlock.Text, FCurTextBlock.FontName, Font.Size);
FCurTextBlock.Height := TextHeight(FCurTextBlock.Text, lDescender); FCurTextBlock.Height := TextHeight(FCurTextBlock.Text,FCurTextBlock.FontName, Font.Size, lDescender);
FCurTextBlock.Descender := lDescender; FCurTextBlock.Descender := lDescender;
// get X offset from previous textblocks // get X offset from previous textblocks
@ -4539,36 +4541,35 @@ begin
Result := Round(mm * (gTTFontCache.DPI / cMMperInch)); Result := Round(mm * (gTTFontCache.DPI / cMMperInch));
end; end;
function TFPReportCustomMemo.TextHeight(const AText: string; out ADescender: TFPReportUnits): TFPReportUnits; function TFPReportCustomMemo.TextHeight(const AText, FontName: string; FontSize: Integer; out ADescender: TFPReportUnits): TFPReportUnits;
var var
lHeight: single; lHeight: single;
lDescenderHeight: single; lDescenderHeight: single;
lFC: TFPFontCacheItem; lFC: TFPFontCacheItem;
begin begin
// TODO: FontName might need to change to TextBlock.FontName. lFC := gTTFontCache.FindFont(FontName); // we are doing a PostScript Name lookup (it contains Bold, Italic info)
lFC := gTTFontCache.FindFont(Font.Name); // we are doing a PostScript Name lookup (it contains Bold, Italic info)
if not Assigned(lFC) then if not Assigned(lFC) then
raise EReportFontNotFound.CreateFmt(SErrFontNotFound, [Font.Name]); raise EReportFontNotFound.CreateFmt(SErrFontNotFound, [FontName]);
{ Both lHeight and lDescenderHeight are in pixels } { Both lHeight and lDescenderHeight are in pixels }
lHeight := lFC.TextHeight(AText, Font.Size, lDescenderHeight); lHeight := lFC.TextHeight(AText, FontSize, lDescenderHeight);
{ convert pixels to mm. } { convert pixels to mm. }
ADescender := PixelsToMM(lDescenderHeight); ADescender := PixelsToMM(lDescenderHeight);
Result := PixelsToMM(lHeight); Result := PixelsToMM(lHeight);
end; end;
function TFPReportCustomMemo.TextWidth(const AText: string): TFPReportUnits; function TFPReportCustomMemo.TextWidth(const AText, FontName: string; FontSize: Integer): TFPReportUnits;
var var
lWidth: single; lWidth: single;
lFC: TFPFontCacheItem; lFC: TFPFontCacheItem;
begin begin
// TODO: FontName might need to change to TextBlock.FontName. // TODO: FontName might need to change to TextBlock.FontName.
lFC := gTTFontCache.FindFont(Font.Name); // we are doing a PostScript Name lookup (it contains Bold, Italic info) lFC := gTTFontCache.FindFont(FontName); // we are doing a PostScript Name lookup (it contains Bold, Italic info)
if not Assigned(lFC) then if not Assigned(lFC) then
raise EReportFontNotFound.CreateFmt(SErrFontNotFound, [Font.Name]); raise EReportFontNotFound.CreateFmt(SErrFontNotFound, [FontName]);
{ result is in pixels } { result is in pixels }
lWidth := lFC.TextWidth(AText, Font.Size); lWidth := lFC.TextWidth(AText, FontSize);
{ convert pixels to mm. } { convert pixels to mm. }
Result := PixelsToMM(lWidth); Result := PixelsToMM(lWidth);
@ -4688,8 +4689,8 @@ begin
try try
FCurTextBlock.Text := AText; FCurTextBlock.Text := AText;
FCurTextBlock.FontName := Font.Name; FCurTextBlock.FontName := Font.Name;
FCurTextBlock.Width := TextWidth(FCurTextBlock.Text); FCurTextBlock.Width := TextWidth(FCurTextBlock.Text, FCurTextBlock.FontName, Font.Size);
FCurTextBlock.Height := TextHeight(FCurTextBlock.Text, lDescender); FCurTextBlock.Height := TextHeight(FCurTextBlock.Text, FCurTextBlock.FontName, Font.Size, lDescender);
FCurTextBlock.Descender := lDescender; FCurTextBlock.Descender := lDescender;
// get X offset from previous textblocks // get X offset from previous textblocks