vpdffonts.pas

生成PDF文档的控件

  Stream.Write(GLYFTbl, 16);
  PrevSize := DoubleSwap(GLYFTbl.Size);
  if FPGMTable.IsPresent then
  begin
    CreateFontTable(1718642541, FPGMTbl);
    PrevOff := PrevOff + PrevSize;
    FPGMTbl.Offset := DoubleSwap(PrevOff);
    Stream.Write(FPGMTbl, 16);
    PrevSize := DoubleSwap(FPGMTbl.Size);
  end;
  CreateFontTable(1751672161, HHEATbl);
  PrevOff := PrevOff + PrevSize;
  HHEATbl.Offset := DoubleSwap(PrevOff);
  Stream.Write(HHEATbl, 16);
  PrevSize := DoubleSwap(HHEATbl.Size);
  CreateFontTable(1752003704, HMTXTbl);
  PrevOff := PrevOff + PrevSize;
  HMTXTbl.Offset := DoubleSwap(PrevOff);
  Stream.Write(HMTXTbl, 16);
  PrevSize := DoubleSwap(HMTXTbl.Size);
  CreateFontTable(1886352244, POSTTbl);
  PrevOff := PrevOff + PrevSize;
  POSTTbl.Offset := DoubleSwap(PrevOff);
  Stream.Write(POSTTbl, 16);
  PrevSize := DoubleSwap(POSTTbl.Size);
  CreateFontTable(1835104368, MAXPTbl);
  PrevOff := PrevOff + PrevSize;
  MAXPTbl.Offset := DoubleSwap(PrevOff);
  Stream.Write(MAXPTbl, 16);
  PrevSize := DoubleSwap(MAXPTbl.Size);
  CreateFontTable(1819239265, LOCATbl);
  PrevOff := PrevOff + PrevSize;
  LOCATbl.Offset := DoubleSwap(PrevOff);
  Stream.Write(LOCATbl, 16);
  PrevSize := DoubleSwap(LOCATbl.Size);
  CreateFontTable(1886545264, PREPTbl);
  PrevOff := PrevOff + PrevSize;
  PREPTbl.Offset := DoubleSwap(PrevOff);
  Stream.Write(PREPTbl, 16);
  if CVTTable.IsPresent then
    Stream.Write(CVTTbl.Content[0], DoubleSwap(CVTTbl.Size));
  Stream.Write(CMAPTbl.Content[0], DoubleSwap(CMAPTbl.Size));
  Stream.Write(HEADTbl.Content[0], DoubleSwap(HEADTbl.Size));
  Stream.Write(GLYFTbl.Content[0], DoubleSwap(GLYFTbl.Size));
  if FPGMTable.IsPresent then
    Stream.Write(FPGMTbl.Content[0], DoubleSwap(FPGMTbl.Size));
  Stream.Write(HHEATbl.Content[0], DoubleSwap(HHEATbl.Size));
  Stream.Write(HMTXTbl.Content[0], DoubleSwap(HMTXTbl.Size));
  Stream.Write(POSTTbl.Content[0], DoubleSwap(POSTTbl.Size));
  Stream.Write(MAXPTbl.Content[0], DoubleSwap(MAXPTbl.Size));
  Stream.Write(LOCATbl.Content[0], DoubleSwap(LOCATbl.Size));
  Stream.Write(PREPTbl.Content[0], DoubleSwap(PREPTbl.Size));
end;

procedure TTrueTypeTables.QSort(var Arr: array of GlyphCodes; BegIndex,
  EndIndex: Integer; FromFirstItem: boolean);
var
  EndItem, BegItem, Mid: Integer;
  Item: GlyphCodes;
begin
  if Length(Arr) > 0 then
  begin
    EndItem := EndIndex;
    BegItem := BegIndex;
    if FromFirstItem then Mid := Arr[(EndItem + BegItem) div 2].UNICODE
    else Mid := Arr[(EndItem + BegItem) div 2].CODE;
    repeat
      if FromFirstItem then while Arr[BegItem].UNICODE < Mid do
          Inc(BegItem)
      else while Arr[BegItem].CODE < Mid do Inc(BegItem);
      if FromFirstItem then while Arr[EndItem].UNICODE > Mid do
          Dec(EndItem)
      else while Arr[EndItem].CODE > Mid do Dec(EndItem);
      if BegItem <= EndItem then
      begin
        Item := Arr[BegItem];
        Arr[BegItem] := Arr[EndItem];
        Arr[EndItem] := Item;
        Inc(BegItem);
        Dec(EndItem);
      end;
    until BegItem > EndItem;
    if EndItem > BegIndex then QSort(Arr, BegIndex, EndItem, FromFirstItem);
    if BegItem < EndIndex then QSort(Arr, BegItem, EndIndex, FromFirstItem);
  end;
end;

function TTrueTypeTables.DoubleSwap(L: Longword): Longword; assembler;
asm
    mov EAX,L
    bswap EAX
    mov @result,EAX
end;

procedure TTrueTypeTables.CharacterDescription(CDArray: PCDescript; FontName:
  TFontname; FontStyle: TFontStyles);
var
  I, H: Word;
  CMap4CLen: Word;
  UPM: Word;
  SlimWidth: Real;
  UniOffset: longint;

begin
  FFontName := FontName;
  FFontStyle := FontStyle;
  GetSourceTables(false);
  SetLength(CDArray^, 65535);
  UPM := Swap(HeadTable.UnitsPerEm);
  CMap4CLen := Round(Swap(CMAPTable4.segCountX2) / 2);
  for I := 0 to CMap4CLen - 2 do
    for H := CMAPTable4.StartCount[I] to CMAPTable4.EndCount[I] do
    begin
      if CMAPTable4.IDRangeOffset[I] = 0 then
        CDArray^[H].Index := Word(H + CMAPTable4.IDDelta[I])
      else
      begin
        UniOffset := I + Trunc(CMAPTable4.idRangeOffset[I] shr 1) -
          Trunc(swap(CMAPTable4.segCountX2) shr 1) + H -
          CMAPTable4.StartCount[I];
        CDArray^[H].Index := Word(CMAPTable4.GlyphIdArray[UniOffset]) +
          CMAPTable4.IDDelta[I];
      end;
      if IsMonoSpaced then
        SlimWidth := Swap(HmtxTable.Item[0])
      else
        SlimWidth := Swap(HmtxTable.Item[CDArray^[H].Index * 2]);
      SlimWidth := SlimWidth / (UPM / 1000);
      CDArray^[H].Width := Trunc(SlimWidth);
    end;
  FreeTempTables;
end;

procedure TTrueTypeTables.GetFontLongEnsemble(FontName: TFontname; FontStyle:
  TFontStyles; OutStream: Tstream; var CharsetBuffer: array of word;
  CharBufferLen: Word);
var
  i: Integer;
  Swaped: Integer;
  LocaByte: PAnsiChar;
  NumOfGlyfs: word;
  TbName: LongWord;
  TbCheckSum: LongInt;
  sLocaOffset: VISPDFUSHORT;
  TmpGlyf: PGlyfRecord;
  LenExpansion: Integer;
  GCurves: TMemoryStream;
  TbOffset, TbSize: Integer;
  PrevOff, PrevSize: Integer;
  LongFontHeader: TFontHeader;
  LocaOffset, xLocaOffset: longint;

  procedure FillStream;
  begin
    TbOffset := (TbOffset + 3) and not 3;
    OutStream.Write((@TbName)^, 4);
    PrevOff := DoubleSwap(TbOffset);
    PrevSize := DoubleSwap(TbSize);
    OutStream.Write((@TbCheckSum)^, 4);
    OutStream.Write((@PrevOff)^, 4);
    OutStream.Write((@PrevSize)^, 4);
  end;

begin
  FFontName := FontName;
  FFontStyle := FontStyle;
  GetSourceTables(true);
  for I := 0 to CharBufferLen - 1 do
    if CharsetBuffer[I] <> 160 then
      MarkUsedGlyf(CharsetBuffer[I]);
  CompressGlyfTable(false);
  LenExpansion := 0;
  if CVTTable.IsPresent then
    Inc(LenExpansion);
  if FPGMTable.IsPresent then
    Inc(LenExpansion);
  if HmtxTable.IsPresent then
    Inc(LenExpansion);
  LongFontHeader.SFNTVersion := $00000100;
  LongFontHeader.NumTables := $0900;
  LongFontHeader.SearchRange := $8000;
  LongFontHeader.EntrySelector := $0300;
  LongFontHeader.RangeShift := $1000;
  LocaByte := PAnsiChar(@LongFontHeader);
  OutStream.Write(LocaByte^, 12);
  TbOffset := 12 + (16 * (6 + LenExpansion));
  if CVTTable.IsPresent then
  begin
    TbName := $20747663;
    TbSize := CVTTable.TableLength;
    TbCheckSum := CheckSum(@CVTTable.Item[0], CVTTable.TableLength);
    FillStream;
  end;
  if FPGMTable.IsPresent then
  begin
    TbName := $6D677066;
    TbOffset := TbOffset + TbSize;
    TbSize := FPGMTable.TableLength;
    TbCheckSum := CheckSum(@FPGMTable.Item[0], FPGMTable.TableLength);
    FillStream;
  end;
  GCurves := TMemoryStream.Create;
  try
    TmpGlyf := GlyfRoot;
    for I := 1 to MaxpTable.numGlyphs do
    begin
      if TmpGlyf.IsTagged then
        GCurves.Write(TmpGlyf.Curves^, TmpGlyf.RecordSize);
      TmpGlyf := TmpGlyf.NextGlyph;
    end;
    TbName := $66796C67;
    TbOffset := TbOffset + TbSize;
    TbSize := GCurves.Size;
    TbCheckSum := CheckSum(GCurves.Memory, GCurves.Size);
    FillStream;
    TbName := $64616568;
    TbOffset := TbOffset + TbSize;
    TbSize := Sizeof(HeadTable);
    TbCheckSum := CheckSum(PVISPDFULONG(@HeadTable), Sizeof(HeadTable));
    FillStream;
    TbName := $61656868;
    TbOffset := TbOffset + TbSize;
    TbSize := Sizeof(HheaTable);
    TbCheckSum := CheckSum(PVISPDFULONG(@HheaTable), Sizeof(HheaTable));
    FillStream;
    TbName := $78746D68;
    TbOffset := TbOffset + TbSize;
    TbSize := HmtxTable.TableLength;
    TbCheckSum := CheckSum(@HmtxTable.Item[0], HmtxTable.TableLength);
    FillStream;
    LocaOffset := 0;
    TmpGlyf := GlyfRoot;
    NumOfGlyfs := MaxpTable.numGlyphs;
    for i := 1 to NumOfGlyfs do
    begin
      if TmpGlyf.IsTagged = false then TmpGlyf.RecordSize := 0;
      if swap(HeadTable.IndexToLocFormat) = 1 then
      begin
        xLocaOffset := DoubleSwap(LocaOffset);
        LocaByte := PAnsiChar(@xLocaOffset);
        LocaTable.Item[(i - 1) * 4] := byte(LocaByte[0]);
        LocaTable.Item[(i - 1) * 4 + 1] := byte(LocaByte[1]);
        LocaTable.Item[(i - 1) * 4 + 2] := byte(LocaByte[2]);
        LocaTable.Item[(i - 1) * 4 + 3] := byte(LocaByte[3]);
        LocaOffset := LocaOffset + TmpGlyf.RecordSize;
      end
      else
      begin
        sLocaOffset := swap(trunc(LocaOffset / 2));
        LocaByte := PAnsiChar(@sLocaOffset);
        LocaTable.Item[(i - 1) * 2] := byte(LocaByte[0]);
        LocaTable.Item[(i - 1) * 2 + 1] := byte(LocaByte[1]);
        LocaOffset := LocaOffset + TmpGlyf.RecordSize;
      end;
      TmpGlyf := TmpGlyf.NextGlyph;
    end;
    if swap(HeadTable.IndexToLocFormat) = 1 then
    begin
      xLocaOffset := DoubleSwap(LocaOffset);
      LocaByte := PAnsiChar(@xLocaOffset);
      LocaTable.Item[NumOfGlyfs * 4] := byte(LocaByte[0]);
      LocaTable.Item[NumOfGlyfs * 4 + 1] := byte(LocaByte[1]);
      LocaTable.Item[NumOfGlyfs * 4 + 2] := byte(LocaByte[2]);
      LocaTable.Item[NumOfGlyfs * 4 + 3] := byte(LocaByte[3]);
    end
    else
    begin
      sLocaOffset := swap(trunc(LocaOffset / 2));
      LocaByte := PAnsiChar(@sLocaOffset);
      LocaTable.Item[NumOfGlyfs * 2] := byte(LocaByte[0]);
      LocaTable.Item[NumOfGlyfs * 2 + 1] := byte(LocaByte[1]);
    end;
    TbName := $61636F6C;
    TbOffset := TbOffset + TbSize;
    if swap(HeadTable.IndexToLocFormat) = 1 then
      TbSize := ((4 + 4 * NumOfGlyfs) + 3) and not 3
    else
      TbSize := ((2 + 2 * NumOfGlyfs) + 3) and not 3;
    TbCheckSum := CheckSum(@LocaTable.Item[0], TbSize);
    FillStream;
    TbName := $7078616D;
    TbOffset := TbOffset + TbSize;
    TbSize := Sizeof(MaxpTable);
    TbCheckSum := CheckSum(PVISPDFULONG(@MaxpTable), TbSize);
    FillStream;
    TbName := $70657270;
    TbOffset := TbOffset + TbSize;
    TbSize := PrepTable.TableLength;
    TbCheckSum := CheckSum(@PrepTable.Item[0], TbSize);
    FillStream;
    if CVTTable.IsPresent then
      OutStream.Write((@CVTTable.Item[0])^, (CVTTable.TableLength + 3) and
        not
        3);
    if FPGMTable.IsPresent then
      OutStream.Write((@FPGMTable.Item[0])^, (FPGMTable.TableLength + 3)
        and not
        3);
    GCurves.Position := 0;
    OutStream.Write(GCurves.Memory^, ((GCurves.Size + 3) and not 3));
  finally
    GCurves.Free;
  end;
  OutStream.Write((@HeadTable)^, (Sizeof(HeadTable) + 3) and not 3);
  OutStream.Write((@HheaTable)^, (Sizeof(HheaTable) + 3) and not 3);
  if HmtxTable.IsPresent then
    OutStream.Write((@HmtxTable.Item[0])^, (HmtxTable.TableLength + 3) and
      not
      3);
  if swap(HeadTable.IndexToLocFormat) = 1 then
    OutStream.Write((@LocaTable.Item[0])^, ((4 + 4 * NumOfGlyfs) + 3) and not
      3)
  else
    OutStream.Write((@LocaTable.Item[0])^, ((2 + 2 * NumOfGlyfs) + 3) and
      not
      3);
  Swaped := MaxpTable.NumGlyphs;
  MaxpTable.NumGlyphs := Swap(MaxpTable.NumGlyphs);
  OutStream.Write((@MaxpTable)^, (Sizeof(MaxpTable) + 3) and not 3);
  MaxpTable.NumGlyphs := Swaped;
  OutStream.Write((@PrepTable.Item[0])^, (PrepTable.TableLength + 3) and not
    3);
  LongCmap := nil;
  FreeTempTables;
  OutStream.Position := 0;
end;


procedure TTrueTypeTables.GetFontEnsemble(FontName: TFontname; FontStyle:
  TFontStyles; OutStream: Tstream; var CharsetBuffer: array of word;
  CharBufferLen: Word);
var
  I: Integer;
  SourceStr: AnsiString;
  CurrCodePage: Cardinal;
  CharArray: array of word;
begin
  if CharBufferLen = 0 then Exit;
  MaxGlyf := 32;
  FFontName := FontName;
  FFontStyle := FontStyle;
  GetSourceTables(false);
  SourceStr := '';
  for I := 1 to CharBufferLen do
    if (CharsetBuffer[I - 1] <> 160) and (CharsetBuffer[I - 1] <> 152) then
      SourceStr := SourceStr + AnsiChar(chr(CharsetBuffer[I - 1]));
  CharBufferLen := Length(SourceStr);
  SetLength(CharArray, CharBufferLen);
  CurrCodePage := GetCodepage(FCharSet);
  MultiByteToWideChar(CurrCodePage, CP_ACP, PAnsiChar(SourceStr), CharBufferLen, @CharArray[0], CharBufferLen);
  ExtractFontCodes(@CharArray[0], CharBufferLen);
  CompressGlyfTable(true);
  SaveWideCharFont(OutStream);
  FreeTempTables;
end;

function TTrueTypeTables.GetCodepage(Charset: Byte): Cardinal;
begin
  if Charset = 1 then
    Charset := GetDefFontCharSet;
  case Charset of
    0: Result := 1252;
    77: Result := 10000;
    128: Result := 932;
    129: Result := 949;
    130: Result := 1361;
    134: Result := 936;
    136: Result := 950;
    161: Result := 1253;
    162: Result := 1254;
    163: Result := 1258;
    177: Result := 1255;
    178: Result := 1256;
    186: Result := 1257;
    204: Result := 1251;
    222: Result := 874;
    238: Result := 1250;
  else
    Result := 1252;
  end;
end;

procedure TTrueTypeTables.FreeTempTables;
var
  i: Integer;
  Temp1, Temp2: PGlyfRecord;
begin
  Temp1 := GlyfRoot;
  for i := 1 to MaxpTable.NumGlyphs do
  begin
    Temp2 := Temp1.NextGlyph;
    if Temp1.Curves <> nil then Freemem(Temp1.Curves);
    Dispose(Temp1);
    Temp1 := Temp2;
  end;
end;

end.