vpdffonts.pas

生成PDF文档的控件

      DeleteObject(HandleObj);
    end;
  finally
    DeleteDC(HDescript);
  end;
end;

procedure TTrueTypeTables.ExtractFontCodes(Buffer: PWord; BufferLength: Word);
var
  I, H: Integer;
  CountOfSegments: VISPDFUSHORT;
  CharsCount: Integer;
begin
  CharsCount := 0;
  CountOfSegments := Trunc(Swap(CMAPTable4.SegCountX2) / 2);
  for I := 1 to BufferLength do
  begin
    for H := 0 to CountOfSegments - 1 do
      if (Buffer^ <= CMAPTable4.EndCount[H]) and (Buffer^ >=
        CMAPTable4.startCount[H]) then
      begin
        if (Buffer^ <> 152) and (Buffer^ <> 160) then
        begin
          Inc(CharsCount);
          SetLength(HandleCharsKit, CharsCount);
          HandleCharsKit[CharsCount - 1].Code := Buffer^;
          Break;
        end;
      end;
    Inc(Buffer);
  end;
  for I := 0 to (CharsCount - 1) do
    if (HandleCharsKit[I].Code > 32) then
      HandleCharsKit[I].NCount := MarkUsedGlyf(HandleCharsKit[I].Code);
end;

function TTrueTypeTables.MarkUsedGlyf(GlyfCode: VISPDFUSHORT): word;
var
  I: Integer;
  GlyfIdOffset: LongInt;
  CountOfSegments: VISPDFUSHORT;
  GlyfCountour: VISPDFUSHORT;
  CurrentGlyf: PGlyfRecord;
begin
  GlyfCountour := 0;
  if (GlyfCode = 160) then BreaksPresent := true;
  with CMAPTable4 do
  begin
    CountOfSegments := Swap(SegCountX2) shr 1;
    for I := 0 to CountOfSegments - 1 do
      if (not (GlyfCode < StartCount[I])) and (not (GlyfCode >
        EndCount[I]))
        then
      begin
        if IDRangeOffset[I] = 0 then
        begin
          GlyfCountour := GlyfCode + IDDelta[i];
          Break;
        end
        else
        begin
          GlyfIdOffset := I + IDRangeOffset[I] shr 1 - CountOfSegments
            + GlyfCode
            - StartCount[I];
          GlyfCountour := GlyphIdArray[GlyfIdOffset] + IDDelta[I];
          Break;
        end;
      end
      else GlyfCountour := 0;
  end;
  CurrentGlyf := GlyfRoot;
  Result := GlyfCountour;
  for I := 1 to MaxpTable.numGlyphs do
  begin
    if (I = GlyfCountour + 1) then
    begin
      GlyfStack[ConvertFromUnicode(GlyfCode)] := CurrentGlyf;
      if GlyfCode > MaxGlyf then MaxGlyf := GlyfCode;
      CurrentGlyf.IsTagged := true;
      CurrentGlyf.Hidden := false;
      break;
    end;
    CurrentGlyf := CurrentGlyf.NextGlyph;
  end;
end;

procedure TTrueTypeTables.MergeCompositLinks(GlyfLink: PGlyfRecord);
var
  I: integer;
  CurveKeyline: Integer;
  CurveIndex: Integer;
  StoreAllGlyfs: Boolean;
  GlyfCover: PGlyfRecord;
begin
  CurveIndex := 11;
  StoreAllGlyfs := False;
  GlyfCover := GlyfRoot;
  CurveKeyline := (byte(GlyfLink.Curves[CurveIndex + 1]) shl 8) +
    byte(GlyfLink.Curves[CurveIndex + 2]);
  for I := 1 to CurveKeyline do
    GlyfCover := GlyfCover.NextGlyph;
  GlyfCover.IsTagged := True;
  if (byte(GlyfCover.Curves[0]) = 255) and (byte(GlyfCover.Curves[1]) = 255)
    then
    MergeCompositLinks(GlyfCover);
  repeat
    if (byte(GlyfLink.Curves[CurveIndex]) and 33) = 33 then
      CurveIndex := CurveIndex + 8
    else if (byte(GlyfLink.Curves[CurveIndex]) and 32) = 32 then
      CurveIndex := CurveIndex + 6
    else StoreAllGlyfs := True;
    CurveKeyline := (byte(GlyfLink.Curves[CurveIndex + 1]) shl 8) +
      byte(GlyfLink.Curves[CurveIndex + 2]);
    GlyfCover := GlyfRoot;
    for I := 1 to CurveKeyline do
      GlyfCover := GlyfCover.NextGlyph;
    GlyfCover.IsTagged := True;
    if (byte(GlyfCover.Curves[0]) = 255) and (byte(GlyfCover.Curves[1]) =
      255)
      then
      MergeCompositLinks(GlyfCover);
  until StoreAllGlyfs = True;
end;

procedure TTrueTypeTables.EditMonopictedLinks(GlyfLink: PGlyfRecord; SLinks:
  TLinkArray);
var
  I: integer;
  OffsetIndex: Word;
  GlyfCoverOff: PWord;
  CurveIndex: Integer;
  GlyfCover: PGlyfRecord;
  CurveKeyline: Integer;
begin
  CurveIndex := 11;
  GlyfCover := GlyfRoot;
  CurveKeyline := byte(GlyfLink.Curves[CurveIndex + 1]) shl 8 +
    byte(GlyfLink.Curves[CurveIndex + 2]);
  GlyfCoverOff := PWord(GlyfLink.Curves + CurveIndex + 1);
  OffsetIndex := SLinks[CurveKeyline] + 1;
  GlyfCoverOff^ := Swap(OffsetIndex);
  for I := 1 to CurveKeyline do
    GlyfCover := GlyfCover.NextGlyph;
  if (byte(GlyfCover.Curves[0]) = 255) and (byte(GlyfCover.Curves[1]) = 255)
    then
    EditMonopictedLinks(GlyfCover, SLinks);
  repeat
    if (byte(GlyfLink.Curves[CurveIndex])) and (33) = 33 then
      CurveIndex := CurveIndex + 8
    else if (byte(GlyfLink.Curves[CurveIndex])) and (32) = 32 then
      CurveIndex := CurveIndex + 6
    else break;
    CurveKeyline := byte(GlyfLink.Curves[CurveIndex + 1]) shl 8 +
      byte(GlyfLink.Curves[CurveIndex + 2]);
    GlyfCoverOff := PWord(GlyfLink.Curves + CurveIndex + 1);
    OffsetIndex := SLinks[CurveKeyline] + 1;
    GlyfCoverOff^ := Swap(OffsetIndex);
    GlyfCover := GlyfRoot;
    for I := 1 to CurveKeyline do
      GlyfCover := GlyfCover.NextGlyph;
    if (byte(GlyfCover.Curves[0]) = 255) and (byte(GlyfCover.Curves[1]) =
      255)
      then EditMonopictedLinks(GlyfCover, SLinks);
  until false;
end;

procedure TTrueTypeTables.CompressGlyfTable(FullEscort: boolean);
var
  I: Integer;
  CharsCount: word;
  SNCounter: Integer;
  GlyfExtCode, GlyfCmapCode: Word;
  TempGlyf: PGlyfRecord;
begin
  CapsuleCount := 1;
  TempGlyf := GlyfRoot;
  for I := 1 to MaxpTable.NumGlyphs do
  begin
    if (TempGlyf.IsTagged) and (TempGlyf.RecordSize <> 0) then
      if (byte(TempGlyf.Curves[0]) = 255) and (byte(TempGlyf.Curves[1]) =
        255)
        then
        MergeCompositLinks(TempGlyf);
    TempGlyf := TempGlyf.NextGlyph;
  end;
  TempGlyf := GlyfRoot;
  if FullEscort then
  begin
    SetLength(Links, MaxpTable.NumGlyphs);
    CharsCount := Length(HandleCharsKit);
    for I := 0 to (CharsCount - 1) do
      if (HandleCharsKit[I].Code > 32) then
      begin
        Links[HandleCharsKit[I].NCount] := I;
        Inc(CapsuleCount);
      end;
    TempGlyf := GlyfRoot;
    for I := 1 to MaxpTable.numGlyphs do
    begin
      if TempGlyf.IsTagged = True then
      begin
        if not (TempGlyf.Hidden) then
        begin
          TempGlyf := TempGlyf.NextGlyph;
          continue;
        end;
        Links[(i - 1)] := CapsuleCount;
        Inc(CapsuleCount);
      end
      else
        TempGlyf.RecordSize := 0;
      TempGlyf := TempGlyf.NextGlyph;
    end;
  end
  else
  begin
    SetLength(Links, MaxpTable.NumGlyphs + 1);
    for I := 1 to MaxpTable.numGlyphs do
    begin
      Links[i] := CapsuleCount - 1;
      Inc(CapsuleCount);
      TempGlyf := TempGlyf.NextGlyph;
    end;
  end;
  TempGlyf := GlyfRoot;
  for i := 1 to MaxpTable.numGlyphs do
  begin
    if (TempGlyf.IsTagged = true) and (TempGlyf.RecordSize <> 0) then
    begin
      if (byte(TempGlyf.Curves[0]) = 255) and (byte(TempGlyf.Curves[1]) =
        255)
        then
        EditMonopictedLinks(TempGlyf, Links);
    end;
    TempGlyf := TempGlyf.NextGlyph;
  end;
  CapsuleCount := 0;
  SNCounter := 0;
  TempGlyf := GlyfRoot;
  SetLength(SymbolSelection, MaxpTable.numGlyphs);
  if FullEscort then
  begin
    for I := 1 to MaxpTable.numGlyphs do
    begin
      if (TempGlyf.IsTagged { RecordSize <> 0}) then
      begin
        Inc(CapsuleCount);
        SymbolSelection[CapsuleCount - 1].GlyphID := i;
        GlyfCmapCode := HandleCharsKit[Links[i - 1]].Code;
        SymbolSelection[CapsuleCount - 1].UNICODE := GlyfCmapCode;
        GlyfExtCode := ConvertFromUnicode(GlyfCmapCode);
        SymbolSelection[CapsuleCount - 1].Hidden := TempGlyf.Hidden;
        SymbolSelection[CapsuleCount - 1].CODE := GlyfExtCode;
        if not (TempGlyf.Hidden) then
        begin
          Inc(SNCounter);
          SymbolSelection[CapsuleCount - 1].SerialNumber := SNCounter + 3;
        end;
      end;
      TempGlyf := TempGlyf.NextGlyph;
    end;
  end
  else
  begin
    for I := 1 to MaxpTable.numGlyphs do
    begin
      if (TempGlyf.IsTagged { RecordSize <> 0}) then
      begin
        Inc(CapsuleCount);
        SymbolSelection[CapsuleCount - 1].GlyphID := i;
        GlyfCmapCode := GetGlyfCode(i - 1);
        SymbolSelection[CapsuleCount - 1].UNICODE := GlyfCmapCode;
        GlyfExtCode := ConvertFromUnicode(GlyfCmapCode);
        SymbolSelection[CapsuleCount - 1].Hidden := TempGlyf.Hidden;
        SymbolSelection[CapsuleCount - 1].CODE := GlyfExtCode;
        if not (TempGlyf.Hidden) then
        begin
          Inc(SNCounter);
          SymbolSelection[CapsuleCount - 1].SerialNumber := SNCounter + 3;
        end;
      end;
      TempGlyf := TempGlyf.NextGlyph;
    end;
  end;
  QSort(SymbolSelection, 0, CapsuleCount - 1, false);
end;

function TTrueTypeTables.Checksum(TableBuffer: PVISPDFULONG; Length: VISPDFULONG): VISPDFULONG;
var
  Sum: VISPDFULONG;
  Endptr: PVISPDFULONG;
  RealSize: Integer;
begin
  Sum := 0;
  if TableBuffer <> nil then
  begin
    RealSize := Trunc(((Length + 3) and (not 3)) / sizeof(VISPDFULONG)) - 1;
    Endptr := TableBuffer;
    Inc(Endptr, RealSize);
    while (TableBuffer <> EndPtr) do
    begin
      Sum := Integer(Sum + TableBuffer^);
      Inc(TableBuffer);
    end;
  end;
  result := Sum;
end;

function TTrueTypeTables.GetGlyfCode(GyfNumber: Word): Word;
var
  I, H: Integer;
  Segments: Integer;
  CurrentOffset: VISPDFULONG;
  GlyfLine: VISPDFUSHORT;
begin
  Result := 0;
  Segments := Swap(CMAPTable4.segCountX2) shr 1;
  for I := 0 to Segments - 1 do
  begin
    for H := CMAPTable4.StartCount[I] to CMAPTable4.EndCount[I] do
    begin
      if CMAPTable4.IdRangeOffset[I] = 0 then
        GlyfLine := H + CMAPTable4.IdDelta[I]
      else
      begin
        CurrentOffset := I + (CMAPTable4.IdRangeOffset[I] shr 1) -
          Segments + H
          - CMAPTable4.StartCount[I];
        GlyfLine := CMAPTable4.GlyphIdArray[CurrentOffset] +
          CMAPTable4.IdDelta[I];
      end;
      if GyfNumber = GlyfLine then
      begin
        Result := H;
        Exit;
      end;
    end;
  end;
end;

procedure TTrueTypeTables.GetGLYF(TempStream: TStream);
var
  I: Integer;
  TmpGlyf: PGlyfRecord;
begin
  CapsuleCount := 0;
  TempStream.Write(MarkGlyf[1], 42);
  for I := 1 to 255 do
  begin
    if GlyfStack[I] <> nil then
    begin
      if PGlyfRecord(GlyfStack[I]).RecordSize <> 0 then
      begin
        if PGlyfRecord(GlyfStack[I]).Hidden then continue;
        TempStream.Write(PGlyfRecord(GlyfStack[I]).Curves^, PGlyfRecord(GlyfStack[I]).RecordSize);
        Inc(CapsuleCount);
      end;
    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;
      TempStream.Write(TmpGlyf.Curves^, TmpGlyf.RecordSize);
      Inc(CapsuleCount);
    end;
    TmpGlyf := TmpGlyf.NextGlyph;
  end;
  TempStream.Position := 0;
end;

procedure TTrueTypeTables.GetHMTX(TempStream: TStream);
var
  I, SetVal: Integer;
  Count: Integer;
  TmpGlyf: PGlyfRecord;
const
  Mark = $06000100;
  Space = $02390000;
begin
  SetVal := 0;
  SetVal := DoubleSwap(Mark);
  TempStream.Write(SetVal, 4);
  SetVal := DoubleSwap(Space);
  TempStream.Write(SetVal, 4);
  TmpGlyf := GlyfRoot;
  HheaTable.numberOfHMetrics := swap(HheaTable.numberOfHMetrics);
  Count := (HmtxTable.TableLength div HheaTable.numberOfHMetrics);
  for I := 1 to MaxpTable.numGlyphs do
  begin
    if TmpGlyf.RecordSize > 0 then
    begin
      if TmpGlyf.Hidden then
      begin
        TmpGlyf := TmpGlyf.NextGlyph;
        continue;