Browse Source

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

Michaël Van Canneyt 3 years ago
parent
commit
cec8d84ae7

+ 58 - 0
packages/fcl-pdf/examples/stdfonttest.lpi

@@ -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 - 0
packages/fcl-pdf/examples/stdfonttest.pp

@@ -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.

+ 23 - 6
packages/fcl-pdf/src/fppdf.pp

@@ -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;