* Fix underline/strikethrough for standard fonts. Fix issue #39585

This commit is contained in:
Michaël Van Canneyt 2022-02-17 13:38:47 +01:00
parent 72e88a3452
commit cec8d84ae7
3 changed files with 116 additions and 6 deletions

View File

@ -0,0 +1,58 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
<MainUnitHasScaledStatement Value="False"/>
<UseDefaultCompilerOptions Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<Title Value="stdfonttest"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<Units>
<Unit>
<Filename Value="stdfonttest.pp"/>
<IsPartOfProject Value="True"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="stdfonttest"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<OtherUnitFiles Value="../src"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,35 @@
{
Demo program to demonstrate standard font strange character support, with strikethrough and underline.
}
program stdfonttest;
{$mode objfpc}{$H+}
{$codepage UTF8}
uses
{$ifdef unix}cwstring,{$endif}SysUtils, fpTTF, fpPDF;
var
PDF: TPDFDocument;
StdFtHelvetica: Integer;
P: TPDFPage;
begin
PDF := TPDFDocument.Create(nil);
PDF.Infos.Producer := 'Test';
PDF.Infos.CreationDate := Now;
PDF.Options := [poPageOriginAtTop, {poNoEmbeddedFonts,} poSubsetFont, poCompressFonts, poCompressImages];
PDF.DefaultOrientation := ppoPortrait;
PDF.DefaultPaperType := ptA4;
PDF.DefaultUnitOfMeasure := uomMillimeters;
PDF.StartDocument;
PDF.Sections.AddSection;
PDF.Sections[0].AddPage(PDF.Pages.AddPage);
StdFtHelvetica := PDF.AddFont('Helvetica');
P:=PDF.Pages[0];
P.SetFont(StdFtHelvetica, 14);
P.WriteText(10,10,'FPC Demo: PDF öäü ÖÄÜ Test',0,true,true);
PDF.SaveToFile('test-stdfont.pdf');
PDF.Free;
end.

View File

@ -272,14 +272,19 @@ type
end;
{ TPDFString }
TPDFString = class(TPDFAbstractString)
private
FValue: AnsiString;
FCPValue : RawByteString;
function GetCPValue: RAwByteString;
protected
procedure Write(const AStream: TStream); override;
public
constructor Create(Const ADocument : TPDFDocument; const AValue: AnsiString); overload;
property Value: AnsiString read FValue;
constructor Create(Const ADocument : TPDFDocument; const AValue: String); overload;
property Value: AnsiString read FValue;
property CPValue : RAwByteString Read GetCPValue;
end;
TPDFUTF16String = class(TPDFAbstractString)
@ -3470,13 +3475,22 @@ end;
{ TPDFString }
function TPDFString.GetCPValue: RAwByteString;
begin
if FCPValue='' then
begin
FCPValue:=Value;
SetCodePage(FCPValue, 1252);
end;
Result:=FCPValue;
end;
procedure TPDFString.Write(const AStream: TStream);
var
s: RawByteString;
begin
// TPDFText uses hardcoded WinAnsiEncoding (=win-1252), we have to convert to 1252 as well and not to ansi (that is not always 1252)
s := FValue;
SetCodePage(s, 1252);
s :=CPValue;
WriteString('(', AStream);
WriteString(s, AStream);
WriteString(')', AStream);
@ -3759,14 +3773,17 @@ var
i: integer;
lWidth: double;
lFontName: string;
CPV : RawByteString;
begin
lFontName := Document.Fonts[Font.FontIndex].Name;
if not Document.IsStandardPDFFont(lFontName) then
raise EPDF.CreateFmt(rsErrUnknownStdFont, [lFontName]);
lWidth := 0;
for i := 1 to Length(FString.Value) do
lWidth := lWidth + Document.GetStdFontCharWidthsArray(lFontName)[Ord(FString.Value[i])];
CPV:=FString.CPValue;
for i := 1 to Length(CPV) do
lWidth := lWidth + Document.GetStdFontCharWidthsArray(lFontName)[Ord(CPV[i])];
Result := lWidth * Font.PointSize / 1540;
end;