mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-17 13:39:36 +02:00
* Fix underline/strikethrough for standard fonts. Fix issue #39585
This commit is contained in:
parent
72e88a3452
commit
cec8d84ae7
58
packages/fcl-pdf/examples/stdfonttest.lpi
Normal file
58
packages/fcl-pdf/examples/stdfonttest.lpi
Normal 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>
|
35
packages/fcl-pdf/examples/stdfonttest.pp
Normal file
35
packages/fcl-pdf/examples/stdfonttest.pp
Normal 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.
|
@ -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;
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user