vpdffonts.pas

生成PDF文档的控件

      end;
      if ((IsMonoSpaced) and (Count <> 4)) then
      begin
        TempStream.Write(HmtxTable.Item[0], 2);
        TempStream.Write(HmtxTable.Item[i + 2], 2);
      end
      else
      begin
        TempStream.Write(HmtxTable.Item[(i * 2) - 2], 2);
        TempStream.Write(HmtxTable.Item[(i * 2) - 1], 2);
      end;
    end;
    TmpGlyf := TmpGlyf.NextGlyph;
  end;
  TmpGlyf := GlyfRoot;
  for I := 1 to MaxpTable.numGlyphs do
  begin
    if TmpGlyf.RecordSize > 0 then
    begin
      if not (TmpGlyf.Hidden) then
      begin
        TmpGlyf := TmpGlyf.NextGlyph;
        continue;
      end;
      if ((IsMonoSpaced) and (Count <> 4)) then
      begin
        TempStream.Write(HmtxTable.Item[0], 2);
        TempStream.Write(HmtxTable.Item[i + 2], 2);
      end
      else
      begin
        TempStream.Write(HmtxTable.Item[(i * 2) - 2], 2);
        TempStream.Write(HmtxTable.Item[(i * 2) - 1], 2);
      end;
    end;
    TmpGlyf := TmpGlyf.NextGlyph;
  end;
end;

procedure TTrueTypeTables.GetLOCA(TempStream: TStream);
var
  I, SetVal: Integer;
  CharsCount: word;
  Count: LongWord;
  TmpGlyf: PGlyfRecord;

begin
  SetVal := 0;
  TempStream.Write(SetVal, 4);
  Count := 42;
  SetVal := (DoubleSwap(Count));
  TempStream.Write(SetVal, 4);
  TempStream.Write(SetVal, 4);
  CharsCount := Length(HandleCharsKit);
  for I := 0 to (CharsCount - 1) do
  begin
    if (HandleCharsKit[I].Code > 32) then
    begin
      Inc(Count, PGlyfRecord(GlyfStack[ConvertFromUnicode(HandleCharsKit[I].Code)]).RecordSize);
      SetVal := (DoubleSwap(Count));
      TempStream.Write(SetVal, 4);
    end;
  end;
  TmpGlyf := GlyfRoot;
  for I := 1 to MaxpTable.numGlyphs do
  begin
    if TmpGlyf.RecordSize > 0 then
    begin
      if not (TmpGlyf.Hidden) then
      begin
        TmpGlyf := TmpGlyf.NextGlyph;
        continue;
      end;
      Inc(Count, TmpGlyf.RecordSize);
      SetVal := (DoubleSwap(Count));
      TempStream.Write(SetVal, 4);
    end;
    TmpGlyf := TmpGlyf.NextGlyph;
  end;
end;

function TTrueTypeTables.ConvertToUnicode(ID: Word): Word;
var
  MBStr: AnsiString;
  CCodepage: Cardinal;
  CharArray: array[0..0] of word;
begin
  MBStr := AnsiString(chr(ID));
  CCodepage := GetCodepage(FCharSet);
  MultiByteToWideChar(CCodepage, 0, PAnsiChar(MBStr), 1, PWideChar(@CharArray[0]), 1);
  Result := CharArray[0];
end;

function TTrueTypeTables.ConvertFromUnicode(ID: Word): Word;
var
  MBStr: word;
  CCodepage: Cardinal;
  CharArray: array[0..0] of word;
begin
  MBStr := 0;
  CharArray[0] := ID;
  CCodepage := GetCodepage(FCharSet);
  WideCharToMultiByte(CCodepage, 0, PWideChar(@CharArray[0]), 1, PAnsiChar(@MBStr), 1, nil, nil);
  Result := MBStr;
end;

procedure TTrueTypeTables.CreateFontTable(Name: LongWord; var Table:
  TVPDFFontTable);
var
  I: Integer;
  TableStream: TMemoryStream;
  TmpValue: SHORT;
  PostVersion: VISPDFLFIXED;
begin
  TableStream := TMemoryStream.Create;
  try
    if Name = 1668707360 then
    begin
      SetLength(Table.Content, CVTTable.TableLength);
      Move(CVTTable.Item[0], Table.Content[0], CVTTable.TableLength);
      Table.Size := DoubleSwap(CVTTable.TableLength);
    end
    else if Name = 1718642541 then
    begin
      SetLength(Table.Content, FPGMTable.TableLength);
      Move(FPGMTable.Item[0], Table.Content[0], FPGMTable.TableLength);
      Table.Size := DoubleSwap(FPGMTable.TableLength);
    end
    else if Name = 1735162214 then
    begin
      GetGLYF(TableStream);
      TableStream.Position := 0;
      Table.Size := DoubleSwap(TableStream.Size);
      SetLength(Table.Content, TableStream.Size);
      TableStream.Read(Table.Content[0], TableStream.Size);
    end
    else if Name = 1751474532 then
    begin
      SetLength(Table.Content, Sizeof(HeadTableType));
      TmpValue := HeadTable.IndexToLocFormat;
      HeadTable.IndexToLocFormat := Swap(1);
      Move(HeadTable, Table.Content[0], Sizeof(HeadTableType));
      HeadTable.IndexToLocFormat := TmpValue;
      Table.Size := DoubleSwap(Sizeof(HeadTableType));
    end
    else if Name = 1751672161 then
    begin
      SetLength(Table.Content, Sizeof(HheaTableType));
      TmpValue := HheaTable.numberOfHMetrics;
      HheaTable.numberOfHMetrics := swap(CapsuleCount + 2);
      Move(HheaTable, Table.Content[0], Sizeof(HheaTable));
      HheaTable.numberOfHMetrics := TmpValue;
      Table.Size := DoubleSwap(Sizeof(HheaTable));
    end
    else if Name = 1752003704 then
    begin
      GetHMTX(TableStream);
      TableStream.Position := 0;
      Table.Size := DoubleSwap(TableStream.Size);
      SetLength(Table.Content, TableStream.Size);
      TableStream.Read(Table.Content[0], TableStream.Size);
    end
    else if Name = 1819239265 then
    begin
      GetLOCA(TableStream);
      TableStream.Position := 0;
      Table.Size := DoubleSwap(TableStream.Size);
      SetLength(Table.Content, TableStream.Size);
      TableStream.Read(Table.Content[0], TableStream.Size);
    end
    else if Name = 1835104368 then
    begin
      SetLength(Table.Content, SizeOf(MaxpTableType));
      TmpValue := MaxpTable.numGlyphs;
      MaxpTable.numGlyphs := swap(CapsuleCount + 2);
      Move(MaxpTable, Table.Content[0], SizeOf(MaxpTableType));
      MaxpTable.numGlyphs := TmpValue;
      Table.Size := DoubleSwap(SizeOf(MaxpTableType));
    end
    else if Name = 1886352244 then
    begin
      SetLength(Table.Content, SizeOf(TPostTableType));
      TableStream.Position := 0;
      PostVersion := DoubleSwap(196608);
      TableStream.Write(PostVersion, 4);
      PostVersion := 0;
      for I := 0 to 6 do
        TableStream.Write(PostVersion, 4);
      TableStream.Position := 0;
      TableStream.Read(Table.Content[0], 32);
      Table.Size := DoubleSwap(32);
    end
    else if Name = 1886545264 then
    begin
      SetLength(Table.Content, PrepTable.TableLength);
      Move(PrepTable.Item[0], Table.Content[0], PrepTable.TableLength);
      Table.Size := DoubleSwap(PrepTable.TableLength);
    end;
  finally
    TableStream.Free;
  end;
  Table.Name := DoubleSwap(Name);
  Table.CheckSum := Checksum(PVISPDFULONG(@Table.Content[0]),
    DoubleSwap(Table.Size));
end;

procedure TTrueTypeTables.MoveRange(var SegmentMapping: array of DeltaValues;
  ItemIndex: Integer);
var
  SMItem: DeltaValues;
begin
  while SegmentMapping[ItemIndex].StartCode < SegmentMapping[ItemIndex -
    1].StartCode do
  begin
    SMItem := SegmentMapping[ItemIndex - 1];
    SegmentMapping[ItemIndex - 1] := SegmentMapping[ItemIndex];
    SegmentMapping[ItemIndex] := SMItem;
    Dec(ItemIndex);
  end;
end;

procedure TTrueTypeTables.GetFullCMAP(TempStream: TStream);
var
  I, H: Integer;
  TableSign: Word;
  SMLength: Integer;
  SubSegment: TMemoryStream;
  ExtendedTableSign: SmallInt;
  SegmentEntering: OutCmapHead;
  SymbolCode, PrevSymbolCode: Word;
  SymbolNumber, VectorLength: Integer;
  SegmentMapping: array of DeltaValues;
  FirstCode: Integer;
begin
  SymbolNumber := 1;
  PrevSymbolCode := 32;
  FirstCode := DoubleSwap(1);
  TempStream.Write(CodeMapping, 55);
  TempStream.Write(FirstCode, 4);
  VectorLength := Length(SymbolSelection);
  for I := 1 to VectorLength do
  begin
    if SymbolSelection[I - 1].CODE <> 0 then
    begin
      if SymbolSelection[I - 1].Hidden then continue;
      for H := 1 to (SymbolSelection[I - 1].CODE - PrevSymbolCode - 1) do
      begin
        TempStream.Write(CodeMapping, 1);
      end;
      PrevSymbolCode := SymbolSelection[I - 1].CODE;
      Inc(SymbolNumber);
      TempStream.Write(SymbolNumber, 1);
    end;
  end;
  PrevSymbolCode := 32;
  QSort(SymbolSelection, 0, length(SymbolSelection) - 1, true);
  SMLength := 2;
  SetLength(SegmentMapping, SMLength + 1);
  SegmentMapping[0].StartCode := 61440;
  SegmentMapping[0].EndCode := 61440;
  SegmentMapping[0].IDRange := 4096;
  SegmentMapping[1].StartCode := 61472;
  SegmentMapping[1].idRange := 4065;
  QSort(SymbolSelection, 0, length(SymbolSelection) - 1, false);
  for I := 1 to VectorLength do
  begin
    if SymbolSelection[i - 1].CODE <> 0 then
    begin
      if SymbolSelection[I - 1].Hidden then continue;
      SymbolCode := SymbolSelection[i - 1].CODE;
      if ((abs(SymbolCode - PrevSymbolCode) >= 2)) then
      begin
        SegmentMapping[SMLength - 1].EndCode := PrevSymbolCode + 61440;
        MoveRange(SegmentMapping, SMLength - 1);
        Inc(SMLength);
        SetLength(SegmentMapping, SMLength);
        SegmentMapping[SMLength - 1].StartCode := SymbolCode + 61440;
        SegmentMapping[SMLength - 1].idRange := (4096 - SymbolCode) +
          (Links[SymbolSelection[i - 1].GlyphID - 1] + 1);
      end;
      PrevSymbolCode := SymbolCode;
    end;
  end;
  SegmentMapping[Length(SegmentMapping) - 1].EndCode := PrevSymbolCode +
    61440;
  MoveRange(SegmentMapping, SMLength - 1);
  Inc(SMLength);
  SetLength(SegmentMapping, SMLength);
  SegmentMapping[SMLength - 1].EndCode := $FFFF;
  SegmentMapping[SMLength - 1].StartCode := $FFFF;
  SegmentMapping[SMLength - 1].IDRange := $0001;
  TableSign := TempStream.Size;
  QSort(SymbolSelection, 0, length(SymbolSelection) - 1, true);
  TempStream.Seek(0, soFromEnd);
  while TableSign < CmapTable4Offset do
  begin
    TempStream.Write(CodeMapping, 1);
    Inc(TableSign);
  end;
  TableSign := 4;
  TempStream.Write(TableSign, 1);
  SubSegment := TMemoryStream.Create;
  try
    SegmentEntering.Language := 0;
    SegmentEntering.SegCountX2 := Swap(SMLength * 2);
    SegmentEntering.SearchRange := (2 * trunc(power(2, log2(SMLength))));
    SegmentEntering.RangeShift := (2 * SMLength) -
      SegmentEntering.SearchRange;
    SegmentEntering.EntrySelector := Round(Log2(SegmentEntering.SearchRange) / 2);
    SegmentEntering.SearchRange := Swap(SegmentEntering.SearchRange);
    SegmentEntering.EntrySelector := Swap(SegmentEntering.EntrySelector);
    SegmentEntering.RangeShift := Swap(SegmentEntering.RangeShift);
    SubSegment.Write(SegmentEntering, sizeof(OutCmapHead));
    for i := 0 to SMLength - 1 do
    begin
      TableSign := Swap(SegmentMapping[i].EndCode);
      SubSegment.Write(TableSign, 2);
    end;
    TableSign := 0;
    SubSegment.Write(TableSign, 2);
    for i := 0 to SMLength - 1 do
    begin
      TableSign := Swap(SegmentMapping[i].StartCode);
      SubSegment.Write(TableSign, 2);
    end;
    for i := 0 to SMLength - 1 do
    begin
      ExtendedTableSign := Swap(SegmentMapping[i].idRange);
      SubSegment.Write(ExtendedTableSign, 2);
    end;
    TableSign := 0;
    for i := 0 to SMLength - 1 do
      SubSegment.Write(TableSign, 2);
    TableSign := 0;
    TableSign := Swap(TableSign);
    SubSegment.Write(TableSign, 2);
    SymbolNumber := 2;
    SegmentMapping[0].StartCode := 32;
    SubSegment.Position := 0;
    TableSign := SubSegment.Size;
    TableSign := Swap(TableSign + 2);
    TempStream.Write(TableSign, 2);
    TempStream.CopyFrom(SubSegment, Swap(TableSign) - 2);
  finally
    SubSegment.Free;
  end;
end;

procedure TTrueTypeTables.SaveWideCharFont(Stream: TStream);
var
  CMAPTbl: TVPDFFontTable;
  CVTTbl: TVPDFFontTable;
  FPGMTbl: TVPDFFontTable;
  GLYFTbl: TVPDFFontTable;
  HEADTbl: TVPDFFontTable;
  HHEATbl: TVPDFFontTable;
  HMTXTbl: TVPDFFontTable;
  LOCATbl: TVPDFFontTable;
  MAXPTbl: TVPDFFontTable;
  POSTTbl: TVPDFFontTable;
  PREPTbl: TVPDFFontTable;
  PrevOff, PrevSize: Integer;
  TableStream: TMemoryStream;
begin
  PrevSize := 0;
  TableStream := TMemoryStream.Create;
  try
    GetFullCMAP(TableStream);
    TableStream.Position := 0;
    CMAPTbl.Size := DoubleSwap(TableStream.Size);
    SetLength(CMAPTbl.Content, TableStream.Size);
    TableStream.Read(CMAPTbl.Content[0], TableStream.Size);
    CMAPTbl.Name := DoubleSwap(1668112752);
    CMAPTbl.CheckSum := Checksum(PVISPDFULONG(@CMAPTbl.Content[0]),
      DoubleSwap(CMAPTbl.Size));
  finally
    TableStream.Free;
  end;
  if FPGMTable.IsPresent then
    PrevOff := 12 + (16 * Swap(FontStreamHeader.NumTables))
  else
    PrevOff := 12 + (16 * (Swap(FontStreamHeader.NumTables) - 1));
  Stream.Write(FontStreamHeader, 12);
  if CVTTable.IsPresent then
  begin
    CreateFontTable(1668707360, CVTTbl);
    CVTTbl.Offset := DoubleSwap(PrevOff);
    PrevSize := DoubleSwap(CVTTbl.Size);
    Stream.Write(CVTTbl, 16);
  end;
  PrevOff := PrevOff + PrevSize;
  CmapTbl.Offset := DoubleSwap(PrevOff);
  Stream.Write(CmapTbl, 16);
  PrevSize := DoubleSwap(CmapTbl.Size);
  CreateFontTable(1751474532, HEADTbl);
  PrevOff := PrevOff + PrevSize;
  HEADTbl.Offset := DoubleSwap(PrevOff);
  Stream.Write(HEADTbl, 16);
  PrevSize := DoubleSwap(HEADTbl.Size);
  CreateFontTable(1735162214, GLYFTbl);
  PrevOff := PrevOff + PrevSize;
  GlyfTbl.Offset := DoubleSwap(PrevOff);