Font körvonalainak kinyerése

Top  Previous  Next

Internetről:

 

1.


uses wintypes, winprocs, win31;

 

var

dc: hdc;

glyph: TGlyphMetrics;

P: pointer;

Size: Word;

F: File;

 

const

mat2: TMat2 = (eM11: (Fract: 0; Value: 1); eM12: (fract: 0; Value: 0);

                eM21: (Fract: 0; Value: 0); eM22: (fract: 0; Value: 1));

 

 

ch = 'Q';

font = 'arial';

 

begin

dc := getdc(0);

selectobject(dc, createfont(400, 0, 0, 0, fw_Normal, 0, 0, 0, ansi_charset,

   out_tt_precis, clip_tt_always, proof_quality, ff_dontcare,

   font));

textout(dc, 0, 0, ch, 1);

Size := GetGlyphOutLine(dc, word(ch), ggo_native, glyph, 0, nil, mat2);

GetMem(P, Size);

GetGlyphOutLine(dc, word(ch), ggo_native, glyph, Size, P, mat2);

Assign(F, 'c:\daten\progs\ttype\' + ch + '.GLF');

Rewrite(F, 1);

Blockwrite(F, P^, Size);

Close(F);

FreeMem(P, Size);

releasedc(0, dc)

end.

 

2.


 

.           Found an example of using GetGlyphOutline in search at

http://www.tamaracka.com

 

 

 

First create font using CreateFontIndirect and select into device context

(say dc)

 

 

Procedure IdentMat2(var Mat : TMat2 ; aspct : Single);

Begin

With Mat do begin

    eM11 := Double2Fixed(1);

    eM12 := Double2Fixed(0);

    eM21 := Double2Fixed(0);

    eM22 := Double2Fixed(1);

end;

End;

 

Function Fixed2Int(F : TFixed) : Integer;

Begin

   If F.Fract >= $8000 then

      Result := F.Value+1

   Else

      Result := F.Value;

End;

 

Procedure GetShape(ch : char ; var pnt : TPoint); // pnt is current point

and will be updated by new point location

var

LastPnt : TPointFX;

l1,l2,dl : dword;

MaxLen : dword;

Mat : TMat2;

Size : DWord;

FntMem : Pointer;

Ppc : PTTPolyCurve;

Pph : PTTPolygonHeader;

i,j : integer;

GM : TGlyphMetrics;

savedpnt : TPoint;

pptfx, pptfxnext : PPointFX;

 

IdentMat2(Mat,aspct);

savedpnt := pnt;

Size:=GetGlyphOutline(dc, ord(ch), GGO_NATIVE, GM, 0, nil, Mat);

pnt.x := pnt.x + gm.gmCellIncX;

pnt.y := pnt.y + gm.gmCellIncY;

if (Size=0) or (Size=GDI_ERROR) then exit;

 

FntMem := AllocMem(Size);

If GetGlyphOutline(dc, ord(ch), GGO_NATIVE, GM, Size, FntMem, Mat) <> 0

then

Begin

    l1 :=0;

    while l1<Size do begin

       pntcount := 0;

       PPH := PTTPolygonHeader(DWord(FntMem)+L1);

       MaxLen :=PPH^.cb;

 

       LastPnt :=PPH^.pfxStart;

 

       L2 := SizeOF(TTTPolygonHeader);

       inc(L1,L2);

       while L2<MaxLen do begin

          PPC := PTTPolyCurve(DWord(FntMem)+L1);

          case PPC^.wType of

             TT_PRIM_LINE: begin

                pptfx := @PPC^.apfx[0];

                for j :=0 to PPC^.cpfx-1 do begin

                    // Draw line from LastPnt to pptfx^ . Converting

TPointfx to Tpoint by calling Fixed2Int(Lastpnt.x),Fixed2Int(lastpnt.y) and

adding the savedpnt

                   LastPnt := pptfx^;

                   inc(pptfx);

                end;

             end;

             TT_PRIM_QSPLINE: begin

                 pptfx := @PPC^.apfx[0];

Draw poly bezier here using "PPC^.cpfx" number of points and finally assign

the last point to LastPnt

LastPnt := PPC^.apfx[ppc^.cpfx-1];

             end;

          end;

          dl := 4+SizeOf(TPointFX)*PPC^.cpfx;

          inc(l1,dl);

          inc(l2,dl);

       End;

// You might need to close the path if you want to by calling a drawline

(LastPnt,PPH^.pfxStart); // Close the path

end;