Version 1.17
  - new TPdfDocument.UseFontFallBack property (enabled by default) and
    associated FontFallBackName property (set to 'Arial Unicode MS' by default),
    used to define if the PDF document will handle "font fallback" for characters
    not existing in the current font: it will avoid rendering block/square
    symbols instead of the correct characters (e.g. for Chinese text)



}


{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64

{$define USE_UNISCRIBE}
................................................................................
    FDefaultPageHeight: Cardinal;
    FDefaultPaperSize: TPDFPaperSize;
    FCompressionMethod: TPdfCompressionMethod;
    FUseOutlines: boolean;
    FCharSet: integer;
    FCodePage: cardinal;
    FTrueTypeFonts: TRawUTF8DynArray;


    FDC: HDC;
    FScreenLogPixels: Integer;
    FStandardFontsReplace: boolean;
    fEmbeddedTTF: boolean;
    fEmbeddedWholeTTF: boolean;
    fEmbeddedTTFIgnore: TRawUTF8List;
    fRawPages: TList;
................................................................................
    // use the UnicodeFont property to get the corresponding Unicode aware
    // version, if it was used
    function GetRegisteredTrueTypeFont(AFontIndex: integer;
      AStyle: TFontStyles; ACharSet: byte): TPdfFont; overload;
    /// get the supplied TrueType Font from the internal font list
    // - if the true type font doesn't exist yet, returns NIL
    function GetRegisteredTrueTypeFont(const AFontLog: TLogFontW): TPdfFont; overload;


    // select the specified font object, then return the fDC value
    function GetDCWithFont(TTF: TPdfFontTrueType): HDC;
    /// release the current document content
    procedure FreeDoc;
  public
    /// create the PDF document instance, with a Canvas and a default A4 paper size
    // - the current charset and code page are retrieved from the SysLocale
................................................................................
    /// if Uniscribe-related methods must handle the text from right to left
    fRightToLeftText: Boolean;
{$endif}
    /// parameters taken from RenderMetaFile() call
    fUseSetTextJustification: Boolean;
    fKerningHScaleBottom: Single;
    fKerningHScaleTop: Single;



    // result := FOffsetX + (X * fFactorX);
    function I2X(X: Integer): Single; overload; {$ifdef HASINLINE}inline;{$endif}
    // result := FOffsetX + (X * fFactorX);
    function I2X(X: Single): Single; overload; {$ifdef HASINLINE}inline;{$endif}
    // result := FOffsetY - Y * fFactorY;
    function I2Y(Y: Integer): Single; overload; {$ifdef HASINLINE}inline;{$endif}
    // result := FOffsetY - Y * fFactorY;
................................................................................
    // - expect the font name to be either a standard embedded font
    // ('Helvetica','Courier','Times') or its Windows equivalency (i.e.
    // 'Arial','Courier New','Times New Roman'), either a UTF-8 encoded
    // True Type font name available on the system
    // - if no CharSet is specified (i.e. if it remains -1), the current document
    // CharSet parameter is used
    function SetFont(const AName: RawUTF8; ASize: Single; AStyle: TFontStyles;
      ACharSet: integer=-1; AForceTTF: integer=-1): TPdfFont; overload;
    /// set the current font for the PDF Canvas
    // - this method use the Win32 structure that defines the characteristics
    // of the logical font
    function SetFont(ADC: HDC; const ALogFont: TLogFontW; ASize: single): TPdfFont; overload;

    /// show some text at a specified page position
    procedure TextOut(X, Y: Single; const Text: PDFString);
................................................................................
  FDC := CreateCompatibleDC(0);
  FScreenLogPixels := GetDeviceCaps(FDC, LOGPIXELSY);
  FCanvas := TPdfCanvas.Create(Self); // need FScreenLogPixels
  // retrieve true type fonts available for all charsets
  FillChar(LFont, sizeof(LFont), 0);
  LFont.lfCharset := DEFAULT_CHARSET; // enumerate ALL fonts
  EnumFontFamiliesExW(FDC, LFont, @EnumFontsProcW, PtrInt(@FTrueTypeFonts), 0);

  FCompressionMethod := cmFlateDecode; // deflate by default
  fBookMarks := TRawUTF8List.Create;
  fMissingBookmarks := TRawUTF8List.Create;
  FUseOutlines := AUseOutlines;
  fUseFontFallBack := true;
  fFontFallBackIndex := FindRawUTF8(FTrueTypeFonts,'Arial Unicode MS');
  if fFontFallBackIndex<0 then
    for i := 0 to high(FTrueTypeFonts) do
      if PosEx('Unicode',FTrueTypeFonts[i])>0 then begin
        fFontFallBackIndex := i;
        break;
      end;
  NewDoc;
................................................................................
    (Name: 'Times-Bold'; Widths: @TIMES_BOLD_W_ARRAY),
    (Name: 'Times-Oblique'; Widths: @TIMES_ITALIC_W_ARRAY),
    (Name: 'Times-BoldOblique'; Widths: @TIMES_BOLDITALIC_W_ARRAY) );
var i: integer;
    FontName2: PDFString;
begin
  // handle default embedded fonts

  if StandardFontsReplace then begin // fonts width are for WinAnsi encoding only
    FontName2 := RawUTF8ToPDFString(FontName);
    for i := 0 to high(STANDARDFONTS) do
      if SameTextU(STANDARDFONTS[i].Name,FontName) then begin
        result := TPdfFontType1.Create(FXref,FontName2,STANDARDFONTS[i].Widths);
        RegisterFont(result);
        Exit;
      end;
................................................................................
begin
  if (L1.lfWeight<>L2.lfWeight) or (L1.lfItalic<>L2.lfItalic) then
    // ignore lfHeight/lfUnderline/lfStrikeOut:
    // font size/underline/strike are internal to PDF graphics state
    result := false else
    result := (AnsiICompW(L1.lfFaceName,L2.lfFaceName)=0);
end;














function TPdfDocument.GetRegisteredTrueTypeFont(const AFontLog: TLogFontW): TPdfFont;
var i: integer;
begin
  // if specified font exists in fontlist, returns the WinAnsi version
  with FFontList do
    for i := 0 to Count-1 do begin
................................................................................
begin
  fPDFA1 := Value;
  NewDoc;
end;

procedure TPdfDocument.SetFontFallBackName(const Value: string);
begin
  fFontFallBackIndex := FindRawUTF8(FTrueTypeFonts,StringToUTF8(Value));
end;

function TPdfDocument.GetFontFallBackName: string;
begin
  if fFontFallBackIndex>=0 then
    result := UTF8ToString(FTrueTypeFonts[fFontFallBackIndex]) else
    result := '';
................................................................................
    lfUnderline := Byte(fsUnderline in AStyle);
    lfStrikeOut := Byte(fsStrikeOut in AStyle);
    UTF8ToWideChar(lfFaceName,Pointer(aFontName));
  end;
end;

function TPdfCanvas.SetFont(const AName: RawUTF8; ASize: single; AStyle: TFontStyles;
  ACharSet: integer=-1; AForceTTF: integer=-1): TPdfFont;
const
  STAND_FONTS_PDF: array[0..2] of RawUTF8 = ('Helvetica','Courier','Times');
  STAND_FONTS_WIN: array[0..2] of RawUTF8 = ('Arial','Courier New','Times New Roman');

procedure SetEmbeddedFont(ABaseFont: RawUTF8);
begin
  ABaseFont := StandardFontName(ABaseFont,AStyle);
  result := fDoc.GetRegisteredNotTrueTypeFont(RawUTF8ToPDFString(ABaseFont));
  if result=nil then
    // font not already registered -> try to add now
    result := fDoc.CreateEmbeddedFont(ABaseFont);
................................................................................
        if SameTextU(AName,STAND_FONTS_PDF[i]) or
           SameTextU(AName,STAND_FONTS_WIN[i]) then begin
          SetEmbeddedFont(STAND_FONTS_PDF[i]);
          if result<>nil then
            exit; // we got a standard/embedded font
        end;
    end;


    // search the font in the global system-wide true type fonts list
    FontIndex := FindRawUTF8(fDoc.FTrueTypeFonts,AName,False);

    if FontIndex<0  then


      // do not exist as is: find equivalency of some "standard" font
      for i := low(STAND_FONTS_PDF) to high(STAND_FONTS_PDF) do
        if SameTextU(AName,STAND_FONTS_PDF[i]) then
          FontIndex := FindRawUTF8(fDoc.FTrueTypeFonts,STAND_FONTS_WIN[i],False);




    if FontIndex<0 then
      FontIndex := FindRawUTF8(fDoc.FTrueTypeFonts,'Arial'); // default font

    if FontIndex<0 then
      raise EPdfInvalidValue.CreateFmt('SetFont %s',[string(AName)]); // error






  end;
  if ACharSet<0 then
    ACharSet := fDoc.CharSet; // force the current PDF Document charset
  result := fDoc.GetRegisteredTrueTypeFont(FontIndex+1,AStyle,ACharSet);
  if result=nil then begin
    // a font of this kind is not already registered -> create it
    fillchar(AFont,sizeof(AFont),0);
................................................................................
    byte(AStyle) := 0;
  if ALogFont.lfUnderline<>0 then
    include(AStyle,fsUnderline);
  if ALogFont.lfStrikeOut<>0 then
    include(AStyle,fsStrikeOut);
  if ALogFont.lfWeight>=FW_SEMIBOLD then
    include(AStyle,fsBold);
  result := SetFont(AName,ASize,AStyle,ALogFont.lfCharSet);

end;

procedure TPdfCanvas.TextOut(X, Y: Single; const Text: PDFString);
begin
  if FContents<>nil then begin
    FContents.Writer.Add('BT'#10).AddWithSpace(X).AddWithSpace(Y).Add('Td'#10);
    ShowText(Text);
................................................................................
  Old := SelectObject(destDC,HF);
  GetTextMetrics(destDC,TM);
  SelectObject(destDC,Old);
  DeleteObject(HF);
  with obj[aLogFont^.ihFont-1] do begin
    kind := OBJ_FONT;
    move(aLogFont^.elfw.elfLogFont,LogFont,sizeof(LogFont));

    if LogFont.lfOrientation<>0 then
      FontSpec.angle := LogFont.lfOrientation div 10 else // -360..+360
      FontSpec.angle := LogFont.lfEscapement div 10;
    FontSpec.ascent := TM.tmAscent;
    FontSpec.descent := TM.tmDescent;
    FontSpec.cell := TM.tmHeight-TM.tmInternalLeading;
  end;

  Version 1.17
  - new TPdfDocument.UseFontFallBack property (enabled by default) and
    associated FontFallBackName property (set to 'Arial Unicode MS' by default),
    used to define if the PDF document will handle "font fallback" for characters
    not existing in the current font: it will avoid rendering block/square
    symbols instead of the correct characters (e.g. for Chinese text)
  - now handle device or bitmap fonts as the most close true-type font available
  - speed-up of internal true-type fonts list (using binary search) 

}


{$I Synopse.inc} // define HASINLINE USETYPEINFO CPU32 CPU64

{$define USE_UNISCRIBE}
................................................................................
    FDefaultPageHeight: Cardinal;
    FDefaultPaperSize: TPDFPaperSize;
    FCompressionMethod: TPdfCompressionMethod;
    FUseOutlines: boolean;
    FCharSet: integer;
    FCodePage: cardinal;
    FTrueTypeFonts: TRawUTF8DynArray;
    FTrueTypeFontLastName: RawUTF8;
    FTrueTypeFontLastIndex: integer;
    FDC: HDC;
    FScreenLogPixels: Integer;
    FStandardFontsReplace: boolean;
    fEmbeddedTTF: boolean;
    fEmbeddedWholeTTF: boolean;
    fEmbeddedTTFIgnore: TRawUTF8List;
    fRawPages: TList;
................................................................................
    // use the UnicodeFont property to get the corresponding Unicode aware
    // version, if it was used
    function GetRegisteredTrueTypeFont(AFontIndex: integer;
      AStyle: TFontStyles; ACharSet: byte): TPdfFont; overload;
    /// get the supplied TrueType Font from the internal font list
    // - if the true type font doesn't exist yet, returns NIL
    function GetRegisteredTrueTypeFont(const AFontLog: TLogFontW): TPdfFont; overload;
    /// find an index of in FTrueTypeFonts[]
    function GetTrueTypeFontIndex(const AName: RawUTF8): integer;
    // select the specified font object, then return the fDC value
    function GetDCWithFont(TTF: TPdfFontTrueType): HDC;
    /// release the current document content
    procedure FreeDoc;
  public
    /// create the PDF document instance, with a Canvas and a default A4 paper size
    // - the current charset and code page are retrieved from the SysLocale
................................................................................
    /// if Uniscribe-related methods must handle the text from right to left
    fRightToLeftText: Boolean;
{$endif}
    /// parameters taken from RenderMetaFile() call
    fUseSetTextJustification: Boolean;
    fKerningHScaleBottom: Single;
    fKerningHScaleTop: Single;
    // some cache
    FPreviousRasterFontName: RawUTF8;
    FPreviousRasterFontIndex: integer;
    // result := FOffsetX + (X * fFactorX);
    function I2X(X: Integer): Single; overload; {$ifdef HASINLINE}inline;{$endif}
    // result := FOffsetX + (X * fFactorX);
    function I2X(X: Single): Single; overload; {$ifdef HASINLINE}inline;{$endif}
    // result := FOffsetY - Y * fFactorY;
    function I2Y(Y: Integer): Single; overload; {$ifdef HASINLINE}inline;{$endif}
    // result := FOffsetY - Y * fFactorY;
................................................................................
    // - expect the font name to be either a standard embedded font
    // ('Helvetica','Courier','Times') or its Windows equivalency (i.e.
    // 'Arial','Courier New','Times New Roman'), either a UTF-8 encoded
    // True Type font name available on the system
    // - if no CharSet is specified (i.e. if it remains -1), the current document
    // CharSet parameter is used
    function SetFont(const AName: RawUTF8; ASize: Single; AStyle: TFontStyles;
      ACharSet: integer=-1; AForceTTF: integer=-1; AIsFixedWidth: boolean=false): TPdfFont; overload;
    /// set the current font for the PDF Canvas
    // - this method use the Win32 structure that defines the characteristics
    // of the logical font
    function SetFont(ADC: HDC; const ALogFont: TLogFontW; ASize: single): TPdfFont; overload;

    /// show some text at a specified page position
    procedure TextOut(X, Y: Single; const Text: PDFString);
................................................................................
  FDC := CreateCompatibleDC(0);
  FScreenLogPixels := GetDeviceCaps(FDC, LOGPIXELSY);
  FCanvas := TPdfCanvas.Create(Self); // need FScreenLogPixels
  // retrieve true type fonts available for all charsets
  FillChar(LFont, sizeof(LFont), 0);
  LFont.lfCharset := DEFAULT_CHARSET; // enumerate ALL fonts
  EnumFontFamiliesExW(FDC, LFont, @EnumFontsProcW, PtrInt(@FTrueTypeFonts), 0);
  QuickSortRawUTF8(FTrueTypeFonts,length(FTrueTypeFonts),nil,StrIComp);
  FCompressionMethod := cmFlateDecode; // deflate by default
  fBookMarks := TRawUTF8List.Create;
  fMissingBookmarks := TRawUTF8List.Create;
  FUseOutlines := AUseOutlines;
  fUseFontFallBack := true;
  fFontFallBackIndex := GetTrueTypeFontIndex('Arial Unicode MS');
  if fFontFallBackIndex<0 then
    for i := 0 to high(FTrueTypeFonts) do
      if PosEx('Unicode',FTrueTypeFonts[i])>0 then begin
        fFontFallBackIndex := i;
        break;
      end;
  NewDoc;
................................................................................
    (Name: 'Times-Bold'; Widths: @TIMES_BOLD_W_ARRAY),
    (Name: 'Times-Oblique'; Widths: @TIMES_ITALIC_W_ARRAY),
    (Name: 'Times-BoldOblique'; Widths: @TIMES_BOLDITALIC_W_ARRAY) );
var i: integer;
    FontName2: PDFString;
begin
  // handle default embedded fonts
  if StandardFontsReplace then begin
    // fonts width are for WinAnsi encoding only
    FontName2 := RawUTF8ToPDFString(FontName);
    for i := 0 to high(STANDARDFONTS) do
      if SameTextU(STANDARDFONTS[i].Name,FontName) then begin
        result := TPdfFontType1.Create(FXref,FontName2,STANDARDFONTS[i].Widths);
        RegisterFont(result);
        Exit;
      end;
................................................................................
begin
  if (L1.lfWeight<>L2.lfWeight) or (L1.lfItalic<>L2.lfItalic) then
    // ignore lfHeight/lfUnderline/lfStrikeOut:
    // font size/underline/strike are internal to PDF graphics state
    result := false else
    result := (AnsiICompW(L1.lfFaceName,L2.lfFaceName)=0);
end;

function TPdfDocument.GetTrueTypeFontIndex(const AName: RawUTF8): integer;
begin
  if StrIComp(pointer(FTrueTypeFontLastName),pointer(AName))=0 then begin
    result := FTrueTypeFontLastIndex; // simple but efficient cache
    exit;
  end;
  result := FastFindPUTF8CharSorted(pointer(FTrueTypeFonts),high(FTrueTypeFonts),pointer(AName),StrIComp);
  if result>=0 then begin
    FTrueTypeFontLastName := AName;
    FTrueTypeFontLastIndex := result;
  end;
end;

function TPdfDocument.GetRegisteredTrueTypeFont(const AFontLog: TLogFontW): TPdfFont;
var i: integer;
begin
  // if specified font exists in fontlist, returns the WinAnsi version
  with FFontList do
    for i := 0 to Count-1 do begin
................................................................................
begin
  fPDFA1 := Value;
  NewDoc;
end;

procedure TPdfDocument.SetFontFallBackName(const Value: string);
begin
  fFontFallBackIndex := GetTrueTypeFontIndex(StringToUTF8(Value));
end;

function TPdfDocument.GetFontFallBackName: string;
begin
  if fFontFallBackIndex>=0 then
    result := UTF8ToString(FTrueTypeFonts[fFontFallBackIndex]) else
    result := '';
................................................................................
    lfUnderline := Byte(fsUnderline in AStyle);
    lfStrikeOut := Byte(fsStrikeOut in AStyle);
    UTF8ToWideChar(lfFaceName,Pointer(aFontName));
  end;
end;

function TPdfCanvas.SetFont(const AName: RawUTF8; ASize: single; AStyle: TFontStyles;
  ACharSet: integer=-1; AForceTTF: integer=-1; AIsFixedWidth: boolean=false): TPdfFont;
const
  STAND_FONTS_PDF: array[0..2] of RawUTF8 = ('Helvetica','Courier','Times');
  STAND_FONTS_WIN: array[0..2] of RawUTF8 = ('Arial','Courier New','Times New Roman');
  STAND_FONTS_UPPER: array[0..2] of PUTF8Char = ('HELVETICA','COURIER','TIMES');
procedure SetEmbeddedFont(ABaseFont: RawUTF8);
begin
  ABaseFont := StandardFontName(ABaseFont,AStyle);
  result := fDoc.GetRegisteredNotTrueTypeFont(RawUTF8ToPDFString(ABaseFont));
  if result=nil then
    // font not already registered -> try to add now
    result := fDoc.CreateEmbeddedFont(ABaseFont);
................................................................................
        if SameTextU(AName,STAND_FONTS_PDF[i]) or
           SameTextU(AName,STAND_FONTS_WIN[i]) then begin
          SetEmbeddedFont(STAND_FONTS_PDF[i]);
          if result<>nil then
            exit; // we got a standard/embedded font
        end;
    end;
    if (FPreviousRasterFontName<>'') and (FPreviousRasterFontName=AName) then
      FontIndex := FPreviousRasterFontIndex else begin
      // search the font in the global system-wide true type fonts list

      FontIndex := fDoc.GetTrueTypeFontIndex(AName);
      if FontIndex<0 then begin // unknown, device or raster font
        if AIsFixedWidth then // sounds to be fixed-width -> set 'Courier'
          FontIndex := fDoc.GetTrueTypeFontIndex(STAND_FONTS_WIN[1]);
        // do not exist as is: find equivalency of some "standard" font
        for i := low(STAND_FONTS_UPPER) to high(STAND_FONTS_UPPER) do


          if (FontIndex<0) and IdemPChar(pointer(AName),STAND_FONTS_UPPER[i]) then
            FontIndex := fDoc.GetTrueTypeFontIndex(STAND_FONTS_WIN[i]);
        if FontIndex<0 then begin // use variable width default font
          FontIndex := FDoc.fFontFallBackIndex;
          if FontIndex<0 then

            FontIndex := fDoc.GetTrueTypeFontIndex('Arial');
          if FontIndex<0 then

            exit;
        end;
        FPreviousRasterFontName := AName;
        FPreviousRasterFontIndex := FontIndex;
      end;
    end;
  end;
  if ACharSet<0 then
    ACharSet := fDoc.CharSet; // force the current PDF Document charset
  result := fDoc.GetRegisteredTrueTypeFont(FontIndex+1,AStyle,ACharSet);
  if result=nil then begin
    // a font of this kind is not already registered -> create it
    fillchar(AFont,sizeof(AFont),0);
................................................................................
    byte(AStyle) := 0;
  if ALogFont.lfUnderline<>0 then
    include(AStyle,fsUnderline);
  if ALogFont.lfStrikeOut<>0 then
    include(AStyle,fsStrikeOut);
  if ALogFont.lfWeight>=FW_SEMIBOLD then
    include(AStyle,fsBold);
  result := SetFont(AName,ASize,AStyle,ALogFont.lfCharSet,-1,
    ALogFont.lfPitchAndFamily and TMPF_FIXED_PITCH=0);
end;

procedure TPdfCanvas.TextOut(X, Y: Single; const Text: PDFString);
begin
  if FContents<>nil then begin
    FContents.Writer.Add('BT'#10).AddWithSpace(X).AddWithSpace(Y).Add('Td'#10);
    ShowText(Text);
................................................................................
  Old := SelectObject(destDC,HF);
  GetTextMetrics(destDC,TM);
  SelectObject(destDC,Old);
  DeleteObject(HF);
  with obj[aLogFont^.ihFont-1] do begin
    kind := OBJ_FONT;
    move(aLogFont^.elfw.elfLogFont,LogFont,sizeof(LogFont));
    LogFont.lfPitchAndFamily := TM.tmPitchAndFamily;
    if LogFont.lfOrientation<>0 then
      FontSpec.angle := LogFont.lfOrientation div 10 else // -360..+360
      FontSpec.angle := LogFont.lfEscapement div 10;
    FontSpec.ascent := TM.tmAscent;
    FontSpec.descent := TM.tmDescent;
    FontSpec.cell := TM.tmHeight-TM.tmInternalLeading;
  end;