vpdfengine.pas

生成PDF文档的控件

{*******************************************************}
{                                                       }
{       This unit is part of the VISPDF VCL library.    }
{       Written by R.Husske - ALL RIGHTS RESERVED.      }
{                                                       }
{       Copyright (C) 2000-2008, www.vispdf.com         }
{                                                       }
{       e-mail: [e-mail]                      }
{       http://www.vispdf.com                           }
{                                                       }
{*******************************************************}

unit VPDFEngine;

interface

{$I VisPDFLib.inc }

uses
  Classes, Windows, SysUtils, Graphics, VPDFTypes, VPDFFonts,
  VPDFData;

type
  IndexedChar = record
    CharCode: boolean;
    Index: Integer;
  end;

  TVPDFFontObject = class(TObject)
  private
    FName: string;
    FFontStyle: TFontStyles;
    FCharset: TFontCharset;
    FIsStandard: boolean;
    FIsVertical: boolean;
  public
    UniLen: Integer;
    FActive: boolean;
    FLongCodes: boolean;
    IsEmbeded: boolean;
    FFntFeatures: TVPDFFontFeatures;
    OldName: string;
    FontDocName: string;
    Symbols: array of CDescript;
    UnicodeTable: array of IndexedChar;
    SymbolTable: array[32..255] of boolean;
    function GetFontFeature: TVPDFFontFeatures;
    constructor Create(AName: string); virtual;
    function GetCharWidth(AText: string; APos: integer): integer; virtual;
    property IsVertical: boolean read FIsVertical write FIsVertical;
    property LongCodes: boolean read FLongCodes write FLongCodes;
    property IsStandard: boolean read FIsStandard write FIsStandard;
    property FontStyle: TFontStyles read FFontStyle write FFontStyle;
    property Charset: TFontCharset read FCharset write FCharset;
    property Name: string read FName write FName;
  end;

implementation

function TVPDFFontObject.GetFontFeature: TVPDFFontFeatures;
var
  HDescript: HDC;
  LFont: TLogFont;
  FntObj: THandle;
  TextM: TTextMetric;
begin
  HDescript := CreateCompatibleDC(0);
  try
    FillChar(LFont, SizeOf(LFont), 0);
    with LFont do
    begin
      lfHeight := -1000;
      lfWidth := 0;
      lfEscapement := 0;
      lfOrientation := 0;
      if fsBold in FontStyle then
        lfWeight := FW_BOLD
      else
        lfWeight := FW_NORMAL;
      lfItalic := Byte(fsItalic in FontStyle);
      lfCharSet := FCharset;
      StrPCopy(lfFaceName, OldName);
      lfQuality := DEFAULT_QUALITY;
      lfOutPrecision := OUT_DEFAULT_PRECIS;
      lfClipPrecision := CLIP_DEFAULT_PRECIS;
      lfPitchAndFamily := DEFAULT_PITCH;
    end;
    FntObj := CreateFontIndirect(LFont);
    try
      SelectObject(HDescript, FntObj);
      GetTextMetrics(HDescript, TextM);
      Result.Ascent := TextM.tmAscent;
      Result.IsMonospaced := (TextM.tmPitchAndFamily and TMPF_FIXED_PITCH) = 0;
      Result.FontLen := TextM.tmHeight - TextM.tmInternalLeading;
      FillChar(Result.OutTextM, SizeOf(Result.OutTextM), 0);
      Result.OutTextM.otmSize := SizeOf(Result.OutTextM);
      GetCharABCWidths(HDescript, 0, 255, Result.ABCArray);
      GetOutlineTextMetrics(HDescript, SizeOf(Result.OutTextM),
        @Result.OutTextM);
    finally
      DeleteObject(FntObj);
    end;
  finally
    DeleteDC(HDescript);
  end;
end;

function TVPDFFontObject.GetCharWidth(AText: string; APos: integer): integer;
var
  ChCode: Byte;
begin
  ChCode := Ord(AText[APos]);
  if not FFntFeatures.IsMonospaced then
    Result := FFntFeatures.ABCArray[ChCode].abcA +
      Integer(FFntFeatures.ABCArray[ChCode].abcB) +
      FFntFeatures.ABCArray[ChCode].abcC
  else
    Result := FFntFeatures.ABCArray[0].abcA +
      Integer(FFntFeatures.ABCArray[0].abcB) + FFntFeatures.ABCArray[0].abcC;
end;

constructor TVPDFFontObject.Create(AName: string);
begin
  inherited Create;
  FName := AName;
  UniLen := 0;
  FActive := false;
  LongCodes := false;
  FIsVertical := false;
  FFntFeatures := GetFontFeature;
end;

end.