uttf2vct.pas

windows TTF 字型的delphi reader

  PFXPArray = ^TFXPArray;

function TTTFToVectorConverter.GetCharacterGlyphs( CharCode: integer ): TStrokeCollection;
const EMSIZE = 1024; SIZEX = 1024; SIZEY = 1024;
type TDPoint = record x,y: double end;
var res, bufSize : integer;
    bufPtr, buf: PTTPolygonHeader;
    pc: PTTPolyCurve;
    dc, mdc: HDC;
    ofont: HFONT;
    gm: TGLYPHMETRICS;
    m2: TMAT2;
    ps, p1, p2 : TDPoint;
    ofs, ofs2, pcSize: integer;
    done: boolean;
    i: integer;
    pfxA, pfxB, pfXC: TDPoint;
    lpAPFX: PFXPArray;
    polyN: integer;
    pcType: integer;
    first: boolean;

  function Fix2Double( AFix: TFixed ): double;
  begin
    Result := AFix.fract/65536.0 + AFix.value;
  end;

  function EqualPoints( var p1, p2: TDPoint ): boolean;
  begin
    Result := (p1.X = p2.X) and
              (p1.Y = p2.Y);
  end;

  procedure NewStroke( GlyphNumber: integer; var Pt1, Pt2: TDPoint );
  var ps: PFontStroke;
  begin
    ps := AllocMem( sizeof(TFontStroke) );
    ps^.GlyphNumber := GlyphNumber;
    ps^.Pt1.X := round(Pt1.X/EMSIZE*SIZEX);
    ps^.Pt1.Y := round(Pt1.Y/EMSIZE*SIZEY);
    ps^.Pt2.X := round(Pt2.X/EMSIZE*SIZEX);
    ps^.Pt2.Y := round(Pt2.Y/EMSIZE*SIZEY);
    Result.Add( ps );
  end;

  procedure DrawQSpline( APolyN: integer; var pa, pb, pc: TDPoint );
  var di, i: double;
      p1,p2: TDPoint;
  begin
    di := 1.0 / FSplinePrecision;
    i := di;
    p2 := pa;
    while i<=1.0 do
    begin
      if i-di/2 > 1.0-di then
        i := 1.0;
      p1 := p2;
      p2.X := (pa.X-2*pb.X+pc.X)*sqr(i) + (2*pb.X-2*pa.X)*i + pa.X;
      p2.Y := (pa.Y-2*pb.Y+pc.Y)*sqr(i) + (2*pb.Y-2*pa.Y)*i + pa.Y;
      if not EqualPoints( p1, p2 ) then
        NewStroke( APolyN, p1, p2 );
      i := i + di;
    end;
    pc := p2;
  end;

begin
  Result := nil;
  if Font.Handle = 0 then
    exit;

  dc := GetDC( 0 );
  mdc := CreateCompatibleDC( dc );
  ReleaseDC( 0, dc );

  FFont.Size := EMSIZE;
  ofont := SelectObject( mdc, FFont.Handle );

  m2.eM11.value := 1; m2.eM11.fract := 1; { Identity matrix }
  m2.eM12.value := 0; m2.eM12.fract := 1; { |1,0|           }
  m2.eM21.value := 0; m2.eM21.fract := 1; { |0,1|           }
  m2.eM22.value := 1; m2.eM22.fract := 1;

  {$IFDEF WIN32}
  if not FUNICODE then
    bufSize := GetGlyphOutline( mdc,
                                CharCode,
                                GGO_NATIVE,
                                gm,
                                0, nil,
                                m2 )
  else
    bufSize := GetGlyphOutlineW( mdc,
                                 CharCode,
                                 GGO_NATIVE,
                                 gm,
                                 0, nil,
                                 m2 );
  {$ELSE}
  bufSize := GetGlyphOutline( mdc,
                              CharCode,
                              GGO_NATIVE,
                              gm,
                              0, nil,
                              m2 );
  {$ENDIF}
  if (bufSize = GDI_ERROR) or (bufSize=0) then
  begin
    SelectObject( mdc, ofont );
    DeleteDC( mdc );
    exit;
  end;

  bufPtr := AllocMem( bufSize );
  buf := bufPtr;

  {$IFDEF WIN32}
  if not FUNICODE then
    res := GetGlyphOutline( mdc,
                            CharCode,
                            GGO_NATIVE,
                            gm,
                            bufSize, pchar(buf),
                            m2 )
  else
    res := GetGlyphOutlineW( mdc,
                             CharCode,
                             GGO_NATIVE,
                             gm,
                             bufSize, pchar(buf),
                             m2 );
  {$ELSE}
  res := GetGlyphOutline( mdc,
                          CharCode,
                          GGO_NATIVE,
                          gm,
                          bufSize, pchar(buf),
                          m2 );
  {$ENDIF}
  SelectObject( mdc, ofont );
  DeleteDC( mdc );
  if (res = GDI_ERROR) or (buf^.dwType <> TT_POLYGON_TYPE) then
  begin
    {$IFDEF WIN32}
    FreeMem( bufPtr );
    {$ELSE}
    FreeMem( bufPtr, bufSize );
    {$ENDIF}
    exit;
  end;

  Result := TStrokeCollection.Create;

  done := false;
  ofs := 0;
  polyN := 0;
  while not done do
  begin
    ps.X := Fix2Double( buf^.pfxStart.X );
    ps.Y := Fix2Double( buf^.pfxStart.Y );
    pcSize := buf^.cb - sizeof(TTTPOLYGONHEADER);
    pchar(pc) := pchar(buf) + sizeof(TTTPOLYGONHEADER);
    ofs2 := 0;
    p2 := ps;
    while not done and (ofs2 < pcSize) do
    begin
      pcType := pc^.wType;
      case pcType of
        TT_PRIM_LINE:
          begin
            lpAPFX := @pc^.apfx[0];
            for i := 0 to pc^.cpfx-1 do
            begin
              p1 := p2;
              p2.X := Fix2Double(lpAPFX^[i].X);
              p2.Y := Fix2Double(lpAPFX^[i].Y);
              if not EqualPoints( p1, p2 ) then
                NewStroke( polyN, p1, p2 );
            end;
          end;
        TT_PRIM_QSPLINE:
          begin
            lpAPFX := @pc^.apfx[0];
            pfxA := p2;
            for i := 0 to pc^.cpfx-2 do
            begin
              pfxB.X := Fix2Double(lpAPFX^[i].X);
              pfxB.Y := Fix2Double(lpAPFX^[i].Y);
              if i < pc^.cpfx-2 then
              begin
                pfxC.X := Fix2Double(lpAPFX^[i+1].X);
                pfxC.Y := Fix2Double(lpAPFX^[i+1].Y);
                pfxC.X := (pfxC.X + pfxB.X) / 2;
                pfxC.Y := (pfxC.Y + pfxB.Y) / 2;
              end
              else
              begin
                pfxC.X := Fix2Double(lpAPFX^[i+1].X);
                pfxC.Y := Fix2Double(lpAPFX^[i+1].Y);
              end;
              DrawQSpline( polyN, pfxA, pfxB, pfxC );
              pfxA := pfxC;
            end;
            p2 := pfxC;
          end;
      end;
      ofs2 := ofs2 + sizeof(TTTPOLYCURVE) + (pc^.cpfx-1)*sizeof(TPOINTFX);
      pchar(pc) := pchar(pc) + sizeof(TTTPOLYCURVE) + (pc^.cpfx-1)*sizeof(TPOINTFX);
    end;
    if not done then
    begin
      p1 := p2;
      p2 := ps;
      if not EqualPoints( p1, p2 ) then
        NewStroke( polyN, p1, p2 );
      ofs := ofs + pcSize + sizeof(TTTPOLYGONHEADER);
      done := ofs >= bufSize-sizeof(TTTPolygonHeader);
      pchar(buf) := pchar(pc);
      inc( polyN );
    end;
  end;
  {$IFDEF WIN32}
  FreeMem( bufPtr );
  {$ELSE}
  FreeMem( bufPtr, bufSize );
  {$ENDIF}
end;

function TTTFToVectorConverter.GetCharacterRegion( CharCode, SizeX, SizeY, OfsX, OfsY: integer ): HRGN;
var strokes: TStrokeCollection;
    cbounds: TRect;
    i, j, k, sog: integer;
    polys, pps: ^TPoint;
    {$ifdef WIN32}
    polyCounts, ppc: ^UINT;
    {$else}
    polyCounts, ppc: ^word;
    {$endif}
    stroke: TFontStroke;
    sx, sy: double; { Scaling factors }
begin
  { ************************************** }
  {  Convert to polilines                  }
  { ************************************** }
  strokes := GetCharacterGlyphs( CharCode );
  if strokes = nil then
  begin
    Result := 0;
    exit;
  end;
  { ************************************** }
  {  Compose the GDI region                }
  { ************************************** }
  {  Get character bounds }
  cbounds := strokes.Bounds;
  {  Scaling factors }
  sx := SizeX/(cbounds.Right-cbounds.Left+1);
  sy := SizeY/(cbounds.Bottom-cbounds.Top+1);
  {  Allocate memory for (all) the points }
  polys := AllocMem( sizeof(TPoint) * strokes.Count );
  {  Allocate memory for the "points per polygon" counters }
  {$IFDEF WIN32}
  polyCounts := AllocMem( sizeof(UINT) * strokes.NumGlyphs );
  {$ELSE}
  polyCounts := AllocMem( sizeof(word) * strokes.NumGlyphs );
  {$ENDIF}
  {  Copy glyphs' points to the allocated buffers }
  pps := polys;
  ppc := polyCounts;
  for i := 0 to strokes.NumGlyphs-1 do
  begin
    ppc^ := strokes.GlyphNumStrokes( i );
    sog := strokes.StartOfGlyph( i );
    for j := 0 to ppc^-1 do
    begin
      {  Get a stroke }
      stroke := strokes.Stroke[sog+j];
      {  Store it }
      pps^.x := OfsX + round( (stroke.Pt1.X-cbounds.Left) * sx );
      pps^.y := OfsY + round( (cbounds.Bottom-stroke.Pt1.Y) * sy ); {  Flip vertically! }
      {  Next }
      pps := pointer( pchar(pps) + sizeof(TPoint) );
    end;
    ppc := pointer( pchar(ppc) + sizeof(ppc^) );
  end;
  Result := CreatePolyPolygonRgn( polys^,
                                  polyCounts^,
                                  strokes.NumGlyphs,
                                  WINDING );
  {  Release buffers }
  {$IFDEF WIN32}
  FreeMem( polys );
  FreeMem( polyCounts );
  {$ELSE}
  FreeMem( polys, sizeof(TPoint) * strokes.Count );
  FreeMem( polyCounts, sizeof(word) * strokes.NumGlyphs );
  {$ENDIF}
  {  Release the strokes }
  strokes.Free;
end;

procedure Register;
begin
  RegisterComponents( 'D3K', [TTTFToVectorConverter]);
end;

end.