Listing 8

//Demo fkt. nicht für alle Zeichen, muß für Sonderzeichen modifiziert werden
unit FontOutline;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ExtCtrls, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    procedure GetMultiPolygon(s: string);
    procedure SetMultiPolygonA;
    procedure SetMultiPolygonB;
  public
    { Public-Deklarationen }
  end;

type
     TPkt = array[0..0] of TPoint;
     TByte = array[0..0] of Byte;

var
  Form1: TForm1;
  SymbolPkt: ^TPkt;
  SymbolByte: ^TByte;
  SymbolPktCount: Integer;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
ReAllocMem(SymbolPkt, sizeof(TPoint));
ReAllocMem(SymbolByte, 1);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
ReAllocMem(SymbolPkt, 0);
ReAllocMem(SymbolByte, 0);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Canvas.Brush.Color:=Color;
Canvas.FillRect(ClientRect);
GetMultiPolygon('A');
SetMultiPolygonA;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
Canvas.Brush.Color:=Color;
Canvas.FillRect(ClientRect);
GetMultiPolygon('A');
SetMultiPolygonB;
end;

procedure TForm1.GetMultiPolygon(s: string);
var nu: Integer;

begin
nu:=0;
s:=s[1];

BeginPath(Canvas.handle); //Pfaddefinition starten
Canvas.Brush.Style:=bsClear;
Canvas.TextOut(50,50,s); //Punkte der Pfaddefinition hinzufügen (hier also die des Textes)
EndPath(Canvas.handle); //Pfaddefinition beenden

FlattenPath(Canvas.handle); //Glätten: Kurven der Pfaddef. werden in Linienfolgen umgewandelt

//Punktanzahl ermitteln: nCount auf 0 setzen
SymbolPktCount:=GetPath(Canvas.handle, nu, nu, 0);

//Speicher für Linien- und Kontrollpunkte reservieren
ReAllocMem(SymbolPkt, SymbolPktCount*sizeof(TPoint));
ReAllocMem(SymbolByte, SymbolPktCount);

//Linien- und Kontrollpunkte werden in Speicher kopiert
GetPath(Canvas.handle, SymbolPkt^[0], SymbolByte^[0], SymbolPktCount);

AbortPath(Canvas.handle); //Pfad verwerfen
end;

procedure TForm1.SetMultiPolygonA;
var cv, vv, za: Integer;

begin

cv:=-1; vv:=0; za:=0;
while vv<=SymbolPktCount-1 do
begin

//PT_CLOSEFIGURE gibt an: Figur schließen
if (SymbolByte^[vv] and PT_CLOSEFIGURE)=PT_CLOSEFIGURE then
begin

if za=0 then
begin
   Canvas.Brush.Color:=clRed;
   Polygon(Canvas.handle, SymbolPkt^[cv+1], vv-cv) //hier wird für 'A' die Außenfigur ausgegeben
end
else
begin
   Canvas.Brush.Color:=Color;
   Polygon(Canvas.handle, SymbolPkt^[cv+1], vv-cv); //hier wird für 'A' der Durchschuß in Hintergrundfarbe ausgegeben
end;

cv:=vv; za:=za+1;
end;

vv:=vv+1;
end;

end;

procedure TForm1.SetMultiPolygonB;
var Region1, Region2: HRgn;
    cv, vv, za: Integer;

begin

cv:=-1; vv:=0; za:=0;
while vv<=SymbolPktCount-1 do
begin

if (SymbolByte^[vv] and PT_CLOSEFIGURE)=PT_CLOSEFIGURE then
begin

if za=0 then
   Region1:=CreatePolygonRgn(SymbolPkt^[cv+1], vv-cv, WINDING) //hier wird für 'A' die Region der Außenfigur ermittelt
else
begin
   Region2:=CreatePolygonRgn(SymbolPkt^[cv+1], vv-cv, WINDING);
   CombineRgn(Region1, Region1, Region2, RGN_DIFF); //hier wird für 'A' die Region des Durchschuß ermittelt und mit der Außenfigur kombiniert
end;

cv:=vv; za:=za+1;
end;

vv:=vv+1;
end;

//gefüllte Region ausgegeben
Canvas.Brush.Color:=clRed;
FillRgn(Canvas.handle, Region1, Canvas.Brush.handle);

//Rahmen um Region ausgeben
Canvas.Brush.Color:=clBlack;
FrameRgn(Canvas.handle, Region1, Canvas.Brush.handle, Canvas.Pen.Width, Canvas.Pen.Width);

//Regionen freigeben
DeleteObject(Region1);
DeleteObject(Region2);
end;

end.

Zurück zur Hauptseite