uttf2vct.pas

windows TTF 字型的delphi reader

{
  UTTF2Vct.pas       (was UTTFToVector.pas; changed for 8.3 compatibility )

  TTF to Vector converter
  Copyright (c) 1996-97 by Marco Cocco. All rights reseved.
  Copyright (c) 1996-97 by D3K Artisan Of Ware. All rights reseved.

  Please send comments to [e-mail]
                          [e-mail]
                          
  URL: http://free.websight.com/Cocco2/

  Do you need additional features ? Feel free to ask for it!

  ******************************************************************************
  *   Permission to use, copy,  modify, and distribute this software and its   *
  * documentation without fee for any non-commerical purpose is hereby granted,*
  *   provided that the above copyright notice appears on all copies and that  *
  *     both that copyright notice and this permission notice appear in all    *
  *                         supporting documentation.                          *
  *                                                                            *
  * NO REPRESENTATIONS ARE MADE ABOUT THE SUITABILITY OF THIS SOFTWARE FOR ANY *
  *    PURPOSE.  IT IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY.   *
  *   NEITHER MARCO COCCO OR D3K SHALL BE LIABLE FOR ANY DAMAGES SUFFERED BY   *
  *                          THE USE OF THIS SOFTWARE.                         *
  ******************************************************************************
  * D3K - Artisan Of Ware - A Marco Cocco's Company                            *
  * Casella Postale 99 - 09047 Selargius (CA) - ITALY                          *
  ******************************************************************************

  History
  ------------------------------------------------------------------
  17/Dec/1996  v1.00 Start of implementation
  19/Dec/1996  v1.01 Added some sparse comments
  20/Dec/1996  v1.02 Added support for Delphi 1.0/Win3.x
  20/Dec/1996  v2.00 Converterd from pure class to component
  20/Dec/1996  v2.01 Added support for UNICODE (Delphi 2.0 only)
  03/Jan/1997  v2.02 Coordinate scaling causing runtime errors has been fixed.
                     Bug in memory allocation has been fixed (Delphi 1.0).
                     Now works even with R+, Q+
  04/Jan/1997  v2.03 Added automatic conversion of glyphs to a GDI region
                     (useful for clipping & special effects)
  14/Jan/1997  v2.04 Some minor changes
  15/Jan/1997  v2.05 Some minor changes

  To do:
    - Test for new routines added in v2.03
    - Glyph scaling to caller defined dimensions (!)
    - Baseline coordinate retrieval (!)
    - UNICODE tests (need WinNT to do this) (!)
    - Increase performance and spline precision (?)
    - Triangle subdivision for texture mapping (?)
    - Char to char morphing (?)
    - 3D Extrusion (?)

    (!) = to do as soon as possible
    (?) = may be
}

unit UTTF2Vct;

interface

uses
  {$IFDEF WIN32}
  Windows,
  {$ELSE}
  WinTypes, WinProcs,
  {$ENDIF}
  Classes, Graphics, SysUtils;

type
  { Font stroke: a Font Stroke is the "basic" element of a character glyph,
                that is a glyph is a sequence of connected strokes (lines).
                First point of first stroke connects to last point of last stroke.
                All strokes with equal GlyphNumber value come from the same glyph.
                Strokes of the same glyph are stored sequentially, i.e. stroke 0,
                stroke 1, ... stoke n-1. }
  PFontStroke = ^TFontStroke;
  TFontStroke = record
                  GlyphNumber: integer;
                  Pt1, Pt2: TPoint;          { Note: Strokes[i].Pt2=Strokes[i+1].Pt1
                                                     (also Strokes[i].Pt1=Strokes[i-1].Pt2)
                                                      when Strokes[i].GlyphNumber = Strokes[i+1].GlyphNumber }
                end;

  TEnumStrokesCallback = function( Idx: integer; const Stroke: TFontStroke ): boolean of object;

  TStrokeCollection = class( TList )
    private
    protected
      function GetNumGlyphs: integer;
      function GetFontStroke( Idx: integer ): TFontStroke;
      procedure FreeStrokes;
      function GetBounds: TRect;
    public
      constructor Create; virtual;
      destructor Destroy; override;

      { Returns the index of the first stroke for the glyph number GlyphNumber }
      function StartOfGlyph( GlyphNumber: integer ): integer;
      { Returns the count of strokes for the glyph number GlyphNumber. }
      function GlyphNumStrokes( GlyphNumber: integer ): integer;
      { Enumerates all strokes of all glyphs }
      procedure EnumStrokes( Callback: TEnumStrokesCallback );

      { Returns the number of glyphs }
      property NumGlyphs: integer read GetNumGlyphs;
      { Returns the stroke number Idx. Use StrartOfGlyph to determine
        the index of the first stroke for a given glyph.
        Use GlyphNumStrokes to determine the number of strokes a glyph is. }
      property Stroke[Idx:integer]: TFontStroke read GetFontStroke;
      { Returns the smallest rectangle that completely bounds all glyphs }
      property Bounds: TRect read GetBounds;
  end;

  TTTFToVectorConverter = class( TComponent )
    private
      FFont: TFont;
      FSplinePrecision: integer;
      FUNICODE: boolean;
    protected
      procedure SetFont( Value: TFont ); virtual;
      procedure SetSplinePrecision( Value: integer );
    public
      constructor Create( Owner: TComponent ); override;
      destructor Destroy; override;

      function GetCharacterGlyphs( CharCode: integer ): TStrokeCollection;
      function GetCharacterRegion( CharCode, SizeX, SizeY, OfsX, OfsY: integer ): HRGN;

    published
      property Font: TFont read FFont write SetFont;
      property Precision: integer read FSplinePrecision write SetSplinePrecision default 5;
      {$IFDEF WIN32}
      { Set to TRUE if you wish retrieve outlines for UNICODE fonts
        NEVER TESTED!!! }
      property UNICODE: boolean read FUNICODE write FUNICODE default false;
      {$ENDIF}
  end;

procedure Register;

implementation

{$IFNDEF WIN32}
type
  DWORD = longint;

  PTTPolygonHeader = ^TTTPolygonHeader;
  TTTPolygonHeader = packed record
    cb: DWORD;
    dwType: DWORD;
    pfxStart: TPointFX;
  end;

const
  GDI_ERROR = -1;
{$ENDIF}

{ *** TStrokeCollection ****************** }

constructor TStrokeCollection.Create;
begin
  inherited Create;
end;

destructor TStrokeCollection.Destroy;
begin
  FreeStrokes;
  inherited Destroy;
end;

procedure TStrokeCollection.FreeStrokes;
var i: integer;
begin
  for i := 0 to Count-1 do
  begin
    {$IFDEF WIN32}
    FreeMem( Items[i] );
    {$ELSE}
    FreeMem( Items[i], sizeof(TFontStroke) );
    {$ENDIF}
    Items[i] := nil;
  end;
  Pack;
end;

function TStrokeCollection.GetNumGlyphs: integer;
begin
  if Count = 0 then
    Result := 0
  else
    Result := PFontStroke(Items[Count-1])^.GlyphNumber+1;
end;

function TStrokeCollection.StartOfGlyph( GlyphNumber: integer ): integer;
var ng, i: integer;
begin
  ng := GetNumGlyphs;
  if (GlyphNumber<0) or (GlyphNumber>=ng) then
    Result := -1
  else
  begin
    for i := 0 to Count-1 do
      if PFontStroke(Items[i])^.GlyphNumber = GlyphNumber then
        break;
    Result := i;
  end;
end;

function TStrokeCollection.GlyphNumStrokes( GlyphNumber: integer ): integer;
var sog, eog: integer;
begin
  sog := StartOfGlyph( GlyphNumber );
  if sog < 0 then
    Result := -1
  else
  begin
    eog := StartOfGlyph( GlyphNumber+1 );
    if eog < 0 then
      eog := Count;
    Result := eog - sog;
  end;
end;

function TStrokeCollection.GetFontStroke( Idx: integer ): TFontStroke;
begin
  if (Idx>=0) and (Idx<Count) then
    Result := PFontStroke(Items[Idx])^
  else
    Error;
end;

procedure TStrokeCollection.EnumStrokes( Callback: TEnumStrokesCallback );
var i: integer;
begin
  if not Assigned( Callback ) then
    exit;
  for i := 0 to Count-1 do
    if not Callback( i, PFontStroke(Items[i])^ ) then
      break;
end;

function TStrokeCollection.GetBounds: TRect;
var i: integer;
    fs: PFontStroke;
begin
  if Count = 0 then
  begin
    Result := Rect( 0, 0, 0, 0 );
    exit;
  end;
  Result := Rect( MaxInt, MaxInt, -MaxInt, -MaxInt );
  for i := 0 to Count-1 do
  begin
    fs := Items[i];
    if fs^.Pt1.X < Result.Left then
      Result.Left := fs^.Pt1.X;
    if fs^.Pt1.X > Result.Right then
      Result.Right := fs^.Pt1.X;
    if fs^.Pt2.X < Result.Left then
      Result.Left := fs^.Pt2.X;
    if fs^.Pt2.X > Result.Right then
      Result.Right := fs^.Pt2.X;
    if fs^.Pt1.Y < Result.Top then
      Result.Top := fs^.Pt1.Y;
    if fs^.Pt1.Y > Result.Bottom then
      Result.Bottom := fs^.Pt1.Y;
    if fs^.Pt2.Y < Result.Top then
      Result.Top := fs^.Pt2.Y;
    if fs^.Pt2.Y > Result.Bottom then
      Result.Bottom := fs^.Pt2.Y;
  end;
end;

{ *** TTTFToVectorConverter ************** }

constructor TTTFToVectorConverter.Create( Owner: TComponent );
begin
  inherited Create( Owner );
  FFont := TFont.Create;
  FFont.Name := 'Arial';
  FFont.Size := 28;
  FSplinePrecision := 8;
  FUNICODE := false;
end;

destructor TTTFToVectorConverter.Destroy;
begin
  FFont.Free;
  inherited Destroy;
end;

procedure TTTFToVectorConverter.SetFont( Value: TFont );
begin
  FFont.Assign( Value );
end;

procedure TTTFToVectorConverter.SetSplinePrecision( Value: integer );
begin
  if (Value<1) or (Value>100) then
    exit;
  FSplinePrecision := Value;
end;

type
  TFXPArray = array[0..MaxInt div sizeof(TPOINTFX)-1] of TPOINTFX;