# revisions: 44293,44294,44435,44877,45188,45539

git-svn-id: branches/fixes_3_2@45686 -

.gitattributes

@@ -3653,6 +3653,7 @@ packages/fcl-passrc/tests/testpassrc.lpr svneol=native#text/plain
 packages/fcl-pdf/Makefile svneol=native#text/plain
 packages/fcl-pdf/Makefile.fpc svneol=native#text/plain
 packages/fcl-pdf/examples/diamond.png -text svneol=unset#image/png
+packages/fcl-pdf/examples/metautf16.pp svneol=native#text/plain
 packages/fcl-pdf/examples/poppy.jpg -text
 packages/fcl-pdf/examples/testfppdf.lpi svneol=native#text/plain
 packages/fcl-pdf/examples/testfppdf.lpr svneol=native#text/plain
@@ -4529,6 +4530,7 @@ packages/fcl-xml/Makefile.fpc svneol=native#text/plain
 packages/fcl-xml/Makefile.fpc.fpcmake svneol=native#text/plain
 packages/fcl-xml/buildfclxml.lpi svneol=native#text/plain
 packages/fcl-xml/buildfclxml.pp svneol=native#text/plain
+packages/fcl-xml/examples/htmlwithsax.lpr svneol=native#text/plain
 packages/fcl-xml/examples/reducexml.lpi svneol=native#text/plain
 packages/fcl-xml/examples/reducexml.pp svneol=native#text/plain
 packages/fcl-xml/examples/test.html svneol=native#text/html

packages/chm/src/chmwriter.pas

@@ -1174,7 +1174,7 @@ const idxhdrmagic ='T#SM';
 procedure TChmWriter.CreateIDXHDRStream;
 var i : Integer;
 begin
-   if fmergefiles.count=0 then  // I assume text/site properties could also trigger idxhdr
+   if (fmergefiles.count=0) and not HasBinaryIndex then  // I assume text/site properties could also trigger idxhdr
      exit;
 
    FIDXHdrStream.setsize(4096);
@@ -2295,7 +2295,7 @@ begin
   mapstream.size:=2;
   mapstream.position:=2;
   propertystream :=TMemoryStream.Create;
-  propertystream.write(NToLE(0),sizeof(4));
+  propertystream.write(NToLE(0),sizeof(longint));
   // we iterate over all entries and write listingblocks directly to the stream.
   // and the first (and maybe last) level is written to blockn.
   // we can't do higher levels yet because we don't know how many listblocks we get
@@ -2442,6 +2442,19 @@ begin
   hdr.unknown4       :=NToLE(0);            // unknown 0
   hdr.unknown5       :=NToLE(0);            // unknown 0
 
+  if totalentries<>0 then
+     begin
+       // If there are no links of this type in the CHM then this will be a zero DWORD. Othewise it contains the following DWORDs: 0, 0, 0, 0xC, 1, 1, 0, 0. AFAICS this file is pretty much useless.
+       // we already have written the first 0 dword
+       propertystream.write(NToLE(0),sizeof(longint));
+       propertystream.write(NToLE(0),sizeof(longint));
+       propertystream.write(NToLE($C),sizeof(longint));
+       propertystream.write(NToLE(1),sizeof(longint));
+       propertystream.write(NToLE(1),sizeof(longint));
+       propertystream.write(NToLE(0),sizeof(longint));
+       propertystream.write(NToLE(0),sizeof(longint));
+     end;
+
   IndexStream.Position:=0;
   IndexStream.write(hdr,sizeof(hdr));
   {$ifdef binindex}

packages/fcl-base/src/fileinfo.pp

@@ -101,17 +101,17 @@ type
                      );
 
 // Extract program version information in 1 call.
-Function GetProgramVersion (Var Version : TVersionQuad) : Boolean;
+Function GetProgramVersion (Out Version : TVersionQuad) : Boolean;
-Function GetProgramVersion (Var Version : TProgramVersion) : Boolean;
+Function GetProgramVersion (Out Version : TProgramVersion) : Boolean;
 // Compare 2 versions
 Function CompareVersionQuads(Quad1,Quad2 : TVersionQuad) : TVersionCompare;
 Function CompareProgramVersion(Version1,Version2 : TProgramVersion) : TVersionCompare;
 // Convert version quad to string
 Function VersionQuadToStr(Const Quad : TVersionQuad) : String;
-Function ProgramversionToStr(Const Version : TProgramVersion) : String;
+Function ProgramVersionToStr(Const Version : TProgramVersion) : String;
 // Try to convert string to version quad.
-Function TryStrToVersionQuad(S : String; Var Quad : TVersionQuad) : Boolean;
+Function TryStrToVersionQuad(S : String; Out Quad : TVersionQuad) : Boolean;
-Function TryStrToProgramVersion(S : String; Var Version : TProgramVersion) : Boolean;
+Function TryStrToProgramVersion(S : String; Out Version : TProgramVersion) : Boolean;
 // Convert string to version quad, raise exception if invalid string.
 Function StrToVersionQuad(Const S : String) : TVersionQuad;
 Function StrToProgramVersion(Const S : String ): TProgramVersion;
@@ -183,7 +183,7 @@ end;
 procedure TVersionInfo.Load(Const AFileName : String);
 
 Var
-  I : Integer;
+  I : LongWord;
 
 begin
   FreeResources;
@@ -265,8 +265,7 @@ procedure TFileVersionInfo.ReadFileInfo;
 Var
   VI : TVersionInfo;
   ST : TVersionStringTable;
-  TI,I,J : Integer;
+  TI,I : Integer;
-  S: String;
 
 begin
   FEnabled:=True;
@@ -304,9 +303,9 @@ begin
         end;
       end;
     ST:=VI.StringFileInfo.Items[Ti];
-    for J:=0 to ST.Count-1 do
+    for i:=0 to ST.Count-1 do
-      if (FFilter.Count=0) or (FFilter.IndexOf(ST.Keys[j])<>-1) then
+      if (FFilter.Count=0) or (FFilter.IndexOf(ST.Keys[i])<>-1) then
-        FVersionStrings.Add(ST.Keys[j]+'='+ST.Values[j]);
+        FVersionStrings.Add(ST.Keys[i]+'='+ST.Values[i]);
   finally
     FreeAndNil(VI);
   end;
@@ -347,7 +346,7 @@ end;
 
 { Convenience function }
 
-Function GetProgramVersion (Var Version : TVersionQuad) : Boolean;
+Function GetProgramVersion (Out Version : TVersionQuad) : Boolean;
 
 Var
   VI : TVersionInfo;
@@ -370,7 +369,7 @@ begin
   end;
 end;
 
-Function GetProgramVersion (Var Version : TProgramVersion) : Boolean;
+Function GetProgramVersion (Out Version : TProgramVersion) : Boolean;
 Var
   VQ : TVersionQuad;
 begin
@@ -435,7 +434,7 @@ begin
   Result:=Format('%d.%d.%d.%d',[Version.Major,Version.Minor,Version.Revision,Version.Build]);
 end;
 
-Function TryStrToProgramVersion(S : String; Var Version : TProgramVersion) : Boolean;
+Function TryStrToProgramVersion(S : String; Out Version : TProgramVersion) : Boolean;
 
 Var
   Q : TVersionQuad;
@@ -445,7 +444,7 @@ begin
     Version:=Q;
 end;
 
-Function TryStrToVersionQuad(S : String; Var Quad : TVersionQuad) : Boolean;
+Function TryStrToVersionQuad(S : String; Out Quad : TVersionQuad) : Boolean;
 
 Var
   I,P,Dots,Q : Integer;
@@ -488,12 +487,12 @@ end;
 Function NewerVersion(V1,V2 : TProgramVersion) : Boolean;
 
 Var
-  Q1,Q2 : TversionQuad;
+  Q1,Q2 : TVersionQuad;
 
 begin
   Q1:=V1;
   Q2:=V2;
-  Result:=Newerversion(Q1,Q2);
+  Result:=NewerVersion(Q1,Q2);
 end;
 
 Function NewerVersion(Q1,Q2 : TVersionQuad) : Boolean;

packages/fcl-image/src/fpimage.pp

@@ -664,22 +664,22 @@ type
 
 const
   HtmlColorNameToFPColorMap: array[THtmlColorName] of TFPColor = (
-    (red: $ff; green: $ff; blue: $ff; alpha: alphaOpaque), //hcnWhite
+    (red: $ff or $ff shl 8; green: $ff or $ff shl 8; blue: $ff or $ff shl 8; alpha: alphaOpaque), //hcnWhite
-    (red: $c0; green: $c0; blue: $c0; alpha: alphaOpaque), //hcnSilver
+    (red: $c0 or $c0 shl 8; green: $c0 or $c0 shl 8; blue: $c0 or $c0 shl 8; alpha: alphaOpaque), //hcnSilver
-    (red: $80; green: $80; blue: $80; alpha: alphaOpaque), //hcnGray
+    (red: $80 or $80 shl 8; green: $80 or $80 shl 8; blue: $80 or $80 shl 8; alpha: alphaOpaque), //hcnGray
-    (red: $00; green: $00; blue: $00; alpha: alphaOpaque), //hcnBlack
+    (red: $00;              green: $00;              blue: $00;              alpha: alphaOpaque), //hcnBlack
-    (red: $ff; green: $00; blue: $00; alpha: alphaOpaque), //hcnRed
+    (red: $ff or $ff shl 8; green: $00;              blue: $00;              alpha: alphaOpaque), //hcnRed
-    (red: $80; green: $00; blue: $00; alpha: alphaOpaque), //hcnMaroon
+    (red: $80 or $80 shl 8; green: $00;              blue: $00;              alpha: alphaOpaque), //hcnMaroon
-    (red: $ff; green: $ff; blue: $00; alpha: alphaOpaque), //hcnYellow
+    (red: $ff or $ff shl 8; green: $ff or $ff shl 8; blue: $00;              alpha: alphaOpaque), //hcnYellow
-    (red: $80; green: $80; blue: $00; alpha: alphaOpaque), //hcnOlive
+    (red: $80 or $80 shl 8; green: $80 or $80 shl 8; blue: $00;              alpha: alphaOpaque), //hcnOlive
-    (red: $00; green: $ff; blue: $00; alpha: alphaOpaque), //hcnLime
+    (red: $00;              green: $ff or $ff shl 8; blue: $00;              alpha: alphaOpaque), //hcnLime
-    (red: $00; green: $80; blue: $00; alpha: alphaOpaque), //hcnGreen
+    (red: $00;              green: $80 or $80 shl 8; blue: $00;              alpha: alphaOpaque), //hcnGreen
-    (red: $00; green: $ff; blue: $ff; alpha: alphaOpaque), //hcnAqua
+    (red: $00;              green: $ff or $ff shl 8; blue: $ff or $ff shl 8; alpha: alphaOpaque), //hcnAqua
-    (red: $00; green: $80; blue: $80; alpha: alphaOpaque), //hcnTeal
+    (red: $00;              green: $80 or $80 shl 8; blue: $80 or $80 shl 8; alpha: alphaOpaque), //hcnTeal
-    (red: $00; green: $00; blue: $ff; alpha: alphaOpaque), //hcnBlue
+    (red: $00;              green: $00;              blue: $ff or $ff shl 8; alpha: alphaOpaque), //hcnBlue
-    (red: $00; green: $00; blue: $80; alpha: alphaOpaque), //hcnNavy
+    (red: $00;              green: $00;              blue: $80 or $80 shl 8; alpha: alphaOpaque), //hcnNavy
-    (red: $ff; green: $00; blue: $ff; alpha: alphaOpaque), //hcnFuchsia
+    (red: $ff or $ff shl 8; green: $00;              blue: $ff or $ff shl 8; alpha: alphaOpaque), //hcnFuchsia
-    (red: $80; green: $00; blue: $80; alpha: alphaOpaque)  //hcnPurple
+    (red: $80 or $80 shl 8; green: $00;              blue: $80 or $80 shl 8; alpha: alphaOpaque)  //hcnPurple
   );
 
 function TryStrToHtmlColorName(const S: String; out AName: THtmlColorName): Boolean;

packages/fcl-pdf/examples/metautf16.pp

@@ -0,0 +1,45 @@
+program metautf16;
+
+{$codepage utf-8}
+
+uses sysutils,fpPDF;
+
+var
+  D:TpdfDocument;
+  S:TPdfSection;
+  P:TPdfPage;
+
+begin
+  D:=TpdfDocument.Create(nil);
+  try
+    D.Infos.Title := 'Урывак з паэмы "Новая Зямля"';
+    D.Infos.Author := 'Якуб Колас';
+    D.Infos.Producer := 'fcl-pdf';
+    D.Infos.ApplicationName := 'нейкі тэст';
+    D.Infos.CreationDate := Now;
+    D.Infos.KeyWords:='fcl-pdf report';
+
+    D.Options := [poPageOriginAtTop,poSubsetFont,poCompressFonts,poCompressImages,poUseImageTransparency,poUTF16Info];
+
+    D.StartDocument;
+    D.AddFont('fonts/FreeSans.ttf','FreeSans');
+
+    
+    S:=D.Sections.AddSection;      
+   
+    P:=D.Pages.AddPage;
+    P.PaperType := ptA4;
+    P.UnitOfMeasure := uomPixels;
+    P.Orientation:=ppoPortrait;
+    S.AddPage(P);
+
+    P.SetFont(0,10);
+    P.WriteText(100,100,'Мой родны кут,');
+    P.WriteText(100,150,'Як ты мне мілы');
+    P.WriteText(100,200,'Забыць цябе');
+    P.WriteText(100,250,'Не маю сілы');
+  finally
+    D.SaveToFile('test.pdf');
+    D.Free;
+  end;
+end.

packages/fcl-pdf/src/fppdf.pp

@@ -70,7 +70,7 @@ type
   TPDFUnitOfMeasure = (uomInches, uomMillimeters, uomCentimeters, uomPixels);
 
   TPDFOption = (poOutLine, poCompressText, poCompressFonts, poCompressImages, poUseRawJPEG, poNoEmbeddedFonts,
-    poPageOriginAtTop, poSubsetFont, poMetadataEntry, poNoTrailerID, poUseImageTransparency);
+    poPageOriginAtTop, poSubsetFont, poMetadataEntry, poNoTrailerID, poUseImageTransparency,poUTF16info);
   TPDFOptions = set of TPDFOption;
 
   EPDF = Class(Exception);
@@ -282,6 +282,16 @@ type
     property    Value: AnsiString read FValue;
   end;
 
+  TPDFUTF16String = class(TPDFAbstractString)
+  private
+    FValue: UnicodeString;
+  protected
+    procedure Write(const AStream: TStream); override;
+  public
+    constructor Create(Const ADocument : TPDFDocument; const AValue: UnicodeString; const AFontIndex : Integer); overload;
+    property    Value: UnicodeString read FValue;
+  end;
+
   { TPDFRawHexString }
 
   TPDFRawHexString = class(TPDFDocumentObject)
@@ -424,6 +434,17 @@ type
     property    Text: TPDFUTF8String read FString;
   end;
 
+  TPDFUTF16Text = class(TPDFBaseText)
+  private
+    FString: TPDFUTF16String;
+  protected
+    procedure   Write(const AStream: TStream); override;
+  public
+    constructor Create(const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: UnicodeString; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean); overload;
+    destructor  Destroy; override;
+    property    Text: TPDFUTF16String read FString;
+  end;
+
 
   TPDFLineSegment = class(TPDFDocumentObject)
   private
@@ -601,6 +622,7 @@ type
     procedure AddInteger(const AKey : String; AInteger : Integer);
     procedure AddReference(const AKey : String; AReference : Integer);
     procedure AddString(const AKey, AString : String);
+    procedure AddString(const AKey:string;const AString : UnicodeString);
     function IndexOfKey(const AValue: string): integer;
     procedure Write(const AStream: TStream); override;
     procedure WriteDictionary(const AObject: integer; const AStream: TStream);
@@ -1069,7 +1091,7 @@ type
     procedure CreateAnnotEntries(const APageNum: integer; const APageDict: TPDFDictionary); virtual;
     function CreateContentsEntry(const APageNum: integer): integer;virtual;
     function CreateCatalogEntry: integer;virtual;
-    procedure CreateInfoEntry;virtual;
+    procedure CreateInfoEntry(UseUTF16 : Boolean);virtual;
     procedure CreateMetadataEntry;virtual;
     procedure CreateTrailerID;virtual;
     procedure CreatePreferencesEntry;virtual;
@@ -1095,6 +1117,7 @@ type
     function CreateCIDToGIDMap(const AFontNum: integer): integer; virtual;
     procedure CreatePageStream(APage : TPDFPage; PageNum: integer);
     Function CreateString(Const AValue : String) : TPDFString;
+    Function CreateUTF16String(Const AValue : UnicodeString; const AFontIndex: integer) : TPDFUTF16String;
     Function CreateUTF8String(Const AValue : UTF8String; const AFontIndex: integer) : TPDFUTF8String;
     Function CreateGlobalXRef: TPDFXRef;
     Function AddGlobalXRef(AXRef : TPDFXRef) : Integer;
@@ -1117,6 +1140,7 @@ type
     Function CreateEmbeddedFont(const APage: TPDFPage; AFontIndex, AFontSize : Integer) : TPDFEmbeddedFont;
     Function CreateText(X,Y : TPDFFloat; AText : AnsiString; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean) : TPDFText; overload;
     Function CreateText(X,Y : TPDFFloat; AText : UTF8String; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean) : TPDFUTF8Text; overload;
+    Function CreateText(X,Y : TPDFFloat; AText : UnicodeString; const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean) : TPDFUTF16Text; overload;
     Function CreateRectangle(const X,Y,W,H, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean) : TPDFRectangle;
     function CreateRoundedRectangle(const X, Y, W, H, ARadius, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean): TPDFRoundedRectangle;
     Function CreateColor(AColor : TARGBColor; AStroke : Boolean) : TPDFColor;
@@ -3431,6 +3455,54 @@ begin
     FValue := InsertEscape(FValue);
 end;
 
+
+{ TPDFUTF16String }
+
+constructor TPDFUTF16String.Create(Const ADocument : TPDFDocument; const AValue: Unicodestring; const AFontIndex : Integer);
+begin
+  inherited Create(ADocument);
+  FValue := AValue;
+  FFontIndex:=aFontIndex;
+end;
+
+function oct_str(b:byte):string;
+begin
+  Result:='';
+  repeat
+     Result:=IntToStr(b and $7)+Result;
+     b:=b shr 3;
+  until b=0;
+end;
+
+procedure TPDFUTF16String.Write(const AStream: TStream);
+var
+  i:integer;
+  us:utf8string;
+  s:ansistring;
+  wv:word;
+begin
+  us := Utf8Encode(FValue);
+  if (length(us)<>length(fValue)) then // quote
+  begin
+    s:='\376\377'; // UTF-16BE BOM
+    for i:=1 to length(fValue) do
+    begin
+      wv:=word(fValue[i]);
+      s:=s+'\'+oct_str(hi(wv));
+      s:=s+'\'+oct_str(lo(wv));
+    end;
+  end else
+  begin
+    if (Pos('(', FValue) > 0) or (Pos(')', FValue) > 0) or (Pos('\', FValue) > 0) then
+      s := InsertEscape(FValue)
+    else
+      s:=fValue;
+  end;
+  WriteString('('+s+')', AStream);
+end;
+
+
+
 { TPDFUTF8String }
 
 function TPDFUTF8String.RemapedText: AnsiString;
@@ -3858,6 +3930,101 @@ begin
   inherited Destroy;
 end;
 
+{ TPDFUTF16Text }
+
+procedure TPDFUTF16Text.Write(const AStream: TStream);
+var
+  t1, t2, t3: string;
+  rad: single;
+  lFC: TFPFontCacheItem;
+  lWidth: single;
+  lTextWidthInMM: single;
+  lHeight: single;
+  lTextHeightInMM: single;
+  lColor: string;
+  lLineWidth: string;
+  lDescender: single;
+  v : UTF8String;
+  
+begin
+  inherited Write(AStream);
+  WriteString('BT'+CRLF, AStream);
+  if Degrees <> 0.0 then
+  begin
+    rad := DegToRad(-Degrees);
+    t1 := FloatStr(Cos(rad));
+    t2 := FloatStr(-Sin(rad));
+    t3 := FloatStr(Sin(rad));
+    WriteString(Format('%s %s %s %s %s %s Tm', [t1, t2, t3, t1, FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
+  end
+  else
+  begin
+    WriteString(FloatStr(X)+' '+FloatStr(Y)+' TD'+CRLF, AStream);
+  end;
+  FString.Write(AStream);
+  WriteString(' Tj'+CRLF, AStream);
+  WriteString('ET'+CRLF, AStream);
+
+  if (not Underline) and (not StrikeThrough) then
+    Exit;
+
+  // implement Underline and Strikethrough here
+  lFC := gTTFontCache.Find(Document.Fonts[Font.FontIndex].Name);
+  if not Assigned(lFC) then
+    Exit;  // we can't do anything further
+
+  // result is in Font Units
+  v:=UTF8Encode(FString.Value);
+  lWidth := lFC.TextWidth(v, Font.PointSize);
+  lHeight := lFC.TextHeight(v, Font.PointSize, lDescender);
+  { convert the Font Units to Millimeters. This is also because fontcache DPI (default 96) could differ from PDF DPI (72). }
+  lTextWidthInMM := (lWidth * cInchToMM) / gTTFontCache.DPI;
+  lTextHeightInMM := (lHeight * cInchToMM) / gTTFontCache.DPI;
+
+  if Degrees <> 0.0 then
+    // angled text
+    WriteString(Format('q %s %s %s %s %s %s cm', [t1, t2, t3, t1, FloatStr(X), FloatStr(Y)]) + CRLF, AStream)
+  else
+    // horizontal text
+    WriteString(Format('q 1 0 0 1 %s %s cm', [FloatStr(X), FloatStr(Y)]) + CRLF, AStream);
+
+  { set up a pen width and stroke color }
+  lColor := TPDFColor.Command(True, Color);
+  lLineWidth := FloatStr(mmToPDF(lTextHeightInMM / 12)) + ' w ';
+  WriteString(lLineWidth + lColor + CRLF, AStream);
+
+  { line segment is relative to matrix translation coordinate, set above }
+  if Underline then
+    WriteString(Format('0 -1.5 m %s -1.5 l S', [FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
+  if StrikeThrough then
+    WriteString(Format('0 %s m %s %0:s l S', [FloatStr(mmToPDF(lTextHeightInMM) / 2), FloatStr(mmToPDF(lTextWidthInMM))]) + CRLF, AStream);
+
+  { restore graphics state to before the translation matrix adjustment }
+  WriteString('Q' + CRLF, AStream);
+
+end;
+
+constructor TPDFUTF16Text.Create(const ADocument: TPDFDocument; const AX, AY: TPDFFloat; const AText: UnicodeString;
+  const AFont: TPDFEmbeddedFont; const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean);
+begin
+  inherited Create(ADocument);
+  X := AX;
+  Y := AY;
+  Font := AFont;
+  Degrees := ADegrees;
+  Underline := AUnderline;
+  if Assigned(AFont) and Assigned(AFont.Page) then
+    Color := AFont.Page.FLastFontColor;
+  StrikeThrough := AStrikeThrough;
+  FString := ADocument.CreateUTF16String(AText, AFont.FontIndex);
+end;
+
+destructor TPDFUTF16Text.Destroy;
+begin
+  FreeAndNil(FString);
+  inherited Destroy;
+end;
+
 { TPDFLineSegment  }
 
 procedure TPDFLineSegment.Write(const AStream: TStream);
@@ -4202,6 +4369,11 @@ begin
   AddElement(AKey,Document.CreateString(AString));
 end;
 
+procedure TPDFDictionary.AddString(const AKey:string;const AString: UnicodeString);
+begin
+  AddElement(AKey,Document.CreateUTF16String(AString,-1));
+end;
+
 function TPDFDictionary.IndexOfKey(const AValue: string): integer;
 var
   i: integer;
@@ -4578,7 +4750,7 @@ begin
   FInfos.Assign(AValue);
 end;
 
-procedure TPDFDocument.SetOptions(AValue: TPDFOptions);
+procedure TPDFDocument.SetOptions(aValue: TPDFOptions);
 begin
   if FOptions=AValue then Exit;
   if (poNoEmbeddedFonts in  aValue) then
@@ -4772,26 +4944,31 @@ begin
   Result:=GlobalXRefCount-1;
 end;
 
-procedure TPDFDocument.CreateInfoEntry;
+procedure TPDFDocument.CreateInfoEntry(UseUTF16 : Boolean);
 
 var
   IDict: TPDFDictionary;
 
+  Procedure DoEntry(aName, aValue : String; NoUnicode: boolean = false);
+  
+  begin
+    if aValue='' then exit;
+    if UseUTF16 and not NoUnicode then
+      IDict.AddString(aName,utf8decode(aValue))
+    else
+      IDict.AddString(aName,aValue);  
+  end;
+
 begin
   IDict:=CreateGlobalXRef.Dict;
   Trailer.AddReference('Info', GLobalXRefCount-1);
   (Trailer.ValueByName('Size') as TPDFInteger).Value:=GLobalXRefCount;
-  if Infos.Title <> '' then
+  DoEntry('Title',Infos.Title);
-    IDict.AddString('Title',Infos.Title);
+  DoEntry('Author',Infos.Author);
-  if Infos.Author <> '' then
+  DoEntry('Creator',Infos.ApplicationName);
-    IDict.AddString('Author',Infos.Author);
+  DoEntry('Producer',Infos.Producer);
-  if Infos.ApplicationName <> '' then
+  DoEntry('CreationDate',DateToPdfDate(Infos.CreationDate),True);
-    IDict.AddString('Creator',Infos.ApplicationName);
+  DoEntry('Keywords',Infos.Keywords);
-  IDict.AddString('Producer',Infos.Producer);
-  if Infos.CreationDate <> 0 then
-    IDict.AddString('CreationDate',DateToPdfDate(Infos.CreationDate));
-  if Infos.Keywords <> '' then
-    IDict.AddString('Keywords', Infos.Keywords);
 end;
 
 procedure TPDFDocument.CreateMetadataEntry;
@@ -5530,7 +5707,7 @@ begin
   CreateRefTable;
   CreateTrailer;
   FCatalogue:=CreateCatalogEntry;
-  CreateInfoEntry;
+  CreateInfoEntry(poUTF16Info in Options);
   if poMetadataEntry in Options then
     CreateMetadataEntry;
   if not (poNoTrailerID in Options) then
@@ -5840,6 +6017,12 @@ begin
   Result := TPDFUTF8Text.Create(Self, X, Y, AText, AFont, ADegrees, AUnderline, AStrikeThrough);
 end;
 
+function TPDFDocument.CreateText(X, Y: TPDFFloat; AText: UnicodeString; const AFont: TPDFEmbeddedFont;
+  const ADegrees: single; const AUnderline: boolean; const AStrikethrough: boolean): TPDFUTF16Text;
+begin
+  Result := TPDFUTF16Text.Create(Self, X, Y, AText, AFont, ADegrees, AUnderline, AStrikeThrough);
+end;
+
 function TPDFDocument.CreateRectangle(const X,Y,W,H, ALineWidth: TPDFFloat; const AFill, AStroke: Boolean): TPDFRectangle;
 begin
   Result:=TPDFRectangle.Create(Self,X,Y,W,H,ALineWidth,AFill, AStroke);
@@ -5876,6 +6059,11 @@ begin
   Result:=TPDFString.Create(Self,AValue);
 end;
 
+function TPDFDocument.CreateUTF16String(const AValue: UnicodeString; const AFontIndex: integer): TPDFUTF16String;
+begin
+  Result:=TPDFUTF16String.Create(Self,AValue,aFontIndex);
+end;
+
 function TPDFDocument.CreateUTF8String(const AValue: UTF8String; const AFontIndex: integer): TPDFUTF8String;
 begin
   Result := TPDFUTF8String.Create(self, AValue, AFontIndex);

packages/fcl-xml/examples/htmlwithsax.lpr

@@ -0,0 +1,117 @@
+program htmlwithsax;
+
+uses sysutils, classes, sax,sax_html, custapp;
+
+Type
+
+  { TMyApp }
+
+  TMyApp = Class(TCustomApplication)
+  Private
+    Indent : string;
+    procedure DoEndDocument(Sender: TObject);
+    procedure DoEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
+    procedure DoFile(const aFileName: String);
+    procedure DoStartDocument(Sender: TObject);
+    procedure DoStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString; Atts: TSAXAttributes);
+  Protected
+    Procedure DoRun; override;
+  end;
+
+
+{ TMyApp }
+
+procedure TMyApp.DoFile(const aFileName : String);
+
+var
+  F : TFileStream;
+  MyReader : THTMLReader;
+
+begin
+  MyReader:=Nil;
+  F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
+  try
+    MyReader:=THTMLReader.Create;
+    MyReader.OnStartDocument:=@DoStartDocument;
+    MyReader.OnStartElement:=@DoStartElement;
+    MyReader.OnEndElement:=@DoEndElement;
+    MyReader.OnEndDocument:=@DoEndDocument;
+    MyReader.ParseStream(F);
+  finally
+    FreeAndNil(MyReader);
+    F.Free;
+  end;
+end;
+
+procedure TMyApp.DoRun;
+
+var
+  I : Integer;
+
+begin
+  StopOnException:=True;
+  Terminate;
+  if ParamCount<1 then
+    begin
+    Writeln('Usage : ',ExtractFileName(ExeName),' <htmlfile1> [htmlfile2 [htmlfile3]]');
+    Exit;
+    end;
+  for I:=1 to ParamCount do
+      DoFile(Params[i]);
+end;
+
+procedure TMyApp.DoStartDocument(Sender: TObject);
+begin
+  Writeln('Document start');
+  Indent:='';
+end;
+
+procedure TMyApp.DoEndElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString);
+begin
+  Indent:=Copy(Indent,1,Length(Indent)-2);
+end;
+
+procedure TMyApp.DoEndDocument(Sender: TObject);
+begin
+  Writeln('Document end');
+  Indent:='';
+end;
+
+procedure TMyApp.DoStartElement(Sender: TObject; const NamespaceURI, LocalName, QName: SAXString; Atts: TSAXAttributes);
+
+Var
+  I : Integer;
+  S : unicodestring;
+
+begin
+  S:='';
+  if Assigned(Atts) then
+    for I:=0 to Atts.Length-1 do
+      begin
+      if S<>'' then S:=S+', ';
+      S:=S+Atts.LocalNames[i];
+      end;
+  Write(Indent,'Tag: <',LocalName,'>');
+  if NameSpaceURI<>'' then
+    Write(' xmlns: ',NameSpaceURI);
+  if QName<>'' then
+    Write(', full tag: ',QName);
+  If S<>'' then
+    Write(', attrs: ',S);
+  Writeln;
+  Indent:=Indent+'  ';
+end;
+
+
+
+begin
+  With TMyApp.Create(Nil) do
+    try
+      Initialize;
+      Run;
+    finally
+      Free;
+    end;
+
+end.
+

utils/fpcm/revision.inc

@@ -1 +1 @@
-'2020-03-20 rev 44315'
+'2020-06-20 rev 45662'