mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-13 04:39:22 +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;
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
{ TPDFString }
|
||||||
|
|
||||||
TPDFString = class(TPDFAbstractString)
|
TPDFString = class(TPDFAbstractString)
|
||||||
private
|
private
|
||||||
FValue: AnsiString;
|
FValue: AnsiString;
|
||||||
|
FCPValue : RawByteString;
|
||||||
|
function GetCPValue: RAwByteString;
|
||||||
protected
|
protected
|
||||||
procedure Write(const AStream: TStream); override;
|
procedure Write(const AStream: TStream); override;
|
||||||
public
|
public
|
||||||
constructor Create(Const ADocument : TPDFDocument; const AValue: AnsiString); overload;
|
constructor Create(Const ADocument : TPDFDocument; const AValue: String); overload;
|
||||||
property Value: AnsiString read FValue;
|
property Value: AnsiString read FValue;
|
||||||
|
property CPValue : RAwByteString Read GetCPValue;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TPDFUTF16String = class(TPDFAbstractString)
|
TPDFUTF16String = class(TPDFAbstractString)
|
||||||
@ -3470,13 +3475,22 @@ end;
|
|||||||
|
|
||||||
{ TPDFString }
|
{ 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);
|
procedure TPDFString.Write(const AStream: TStream);
|
||||||
var
|
var
|
||||||
s: RawByteString;
|
s: RawByteString;
|
||||||
begin
|
begin
|
||||||
// TPDFText uses hardcoded WinAnsiEncoding (=win-1252), we have to convert to 1252 as well and not to ansi (that is not always 1252)
|
// 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;
|
s :=CPValue;
|
||||||
SetCodePage(s, 1252);
|
|
||||||
WriteString('(', AStream);
|
WriteString('(', AStream);
|
||||||
WriteString(s, AStream);
|
WriteString(s, AStream);
|
||||||
WriteString(')', AStream);
|
WriteString(')', AStream);
|
||||||
@ -3759,14 +3773,17 @@ var
|
|||||||
i: integer;
|
i: integer;
|
||||||
lWidth: double;
|
lWidth: double;
|
||||||
lFontName: string;
|
lFontName: string;
|
||||||
|
CPV : RawByteString;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
lFontName := Document.Fonts[Font.FontIndex].Name;
|
lFontName := Document.Fonts[Font.FontIndex].Name;
|
||||||
if not Document.IsStandardPDFFont(lFontName) then
|
if not Document.IsStandardPDFFont(lFontName) then
|
||||||
raise EPDF.CreateFmt(rsErrUnknownStdFont, [lFontName]);
|
raise EPDF.CreateFmt(rsErrUnknownStdFont, [lFontName]);
|
||||||
|
|
||||||
lWidth := 0;
|
lWidth := 0;
|
||||||
for i := 1 to Length(FString.Value) do
|
CPV:=FString.CPValue;
|
||||||
lWidth := lWidth + Document.GetStdFontCharWidthsArray(lFontName)[Ord(FString.Value[i])];
|
for i := 1 to Length(CPV) do
|
||||||
|
lWidth := lWidth + Document.GetStdFontCharWidthsArray(lFontName)[Ord(CPV[i])];
|
||||||
Result := lWidth * Font.PointSize / 1540;
|
Result := lWidth * Font.PointSize / 1540;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user