DBR Delphi-Ecke

// Variante 1:
// Hiermit wird Text im Outline-Look und in verschiedenen Winkeln dargestellt.
// Allerdings sollten nur Schriftgrößen ab 20 aufwärts verwendet werden, da bei
// kleinerer Schrift der Fülleffekt kaum noch wahrzunehmen ist. Es dürfen nur
// TrueType Schriften verwendet werden('MS Sans Serif' z.B. geht nicht).
// Ein weiterer Tip zu Text mit Effekt siehe: Text mit Bitmap-Füllung ausgeben

EffektText(
C,        // TCanvas (Zeichenfläche: TForm.Canvas, TPaintbox.Canvas...)
x,        // Integer (linke Textposition)
y,        // Integer (obere Textposition)
groesse, // Integer (Schriftgröße)
winkel,   // Integer (in Grad; negative Werte drehen den Text im Uhrzeigersinn)
txt,      // String (auszugebender Text)
fontname, // String (Name der zu verwendenden Schrift)
Stift,    // TColor (Farbe der Außenlinie)
Pinsel,   // TColor (Farbe der Fläche)
effekt)   // Byte    (0..5, wählt einen der 6 Effekte)

// Getestet mit D4 unter Win98

unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  StdCtrls, Grids, ExtCtrls; 
 
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    procedure FormPaint(Sender: TObject); 
    procedure Button1Click(Sender: TObject); 
  private 
{ Private-Deklarationen} 
  public 
{ Public-Deklarationen} 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
const 
  da: boolean = false; 
 
procedure EffektText(c: TCanvas; x, y, fontsize, winkel: integer; txt, fontname: string; 
  stift, pinsel: TColor; effekt: byte); 
var 
  f, h, lg: integer; 
  p, b: TColor; 
  zs: string[1]; 
begin 
  p := c.pen.color; 
  b := c.brush.color; 
  c.pen.color := stift; 
  c.brush.color := pinsel; 
  h := c.handle; 
  f := CreateFont(-muldiv(fontsize, getdevicecaps(h, logpixelsy), 72), 0, winkel * 10, 
    winkel * 10, FW_HEAVY, 0, 0, 0, DEFAULT_CHARSET, OUT_TT_PRECIS, $10, default_quality, 
    default_pitch, pchar(fontname)); 
  if effekt and 1 = 0 then begin 
    setBkMode(h, TRANSPARENT); 
    zs := ''; lg := 0; 
  end else begin 
    zs := #32; lg := 2; 
  end; 
  selectobject(h, f); 
  BeginPath(h); 
  textout(h, x, y, pchar(zs + txt + zs), length(txt) + lg); 
  EndPath(h); 
  if effekt and 6 = 2 then strokepath(h) else 
    if effekt and 6 = 4 then fillpath(h) else 
      strokeandfillPath(h); 
  deleteobject(f); 
  c.pen.color := p; 
  c.brush.color := b; 
end; 
 
procedure TForm1.FormPaint(Sender: TObject); 
begin 
  if da then 
    EffektText(canvas, 10, 275, 20, 45, 'Das ist ein Test-Satz.', 'Arial', clred, $0099FF, 0); 
end; 
 
 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  da := true; // als Erstes aufrufen, da sonst nicht gezeichnet wird 
  paint; 
//Wenn sich der Text mit anderen Komponenten überschneidet, 
//ist repaint besser, da der Text hinter die anderen 
//Komponenten gelegt werden muss. 
end;

//---------------------------------------------------------------------------

// Variante 2:
// Bei dieser Variante muss man keinen neuen Font erstellen, um Outline-Text
// auszugeben. Allerdings kann man den Text normalerweise nur waagerecht ausgeben.
// Siehe aber Schrift drehen

procedure OutlineTextOut(Cnv: TCanvas; x, y: Integer; Txt: string; 
  Rand, Flaeche: TColor); 
var 
  i, j: integer; 
begin 
  with Cnv do begin 
    Font.color := Rand; 
    brush.style := bsclear; 
    for i := -1 to 1 do 
      for j := -1 to 1 do 
        textout(x + i, y + j, Txt); 
    Font.color := Flaeche; 
    textout(x, y, Txt); 
  end; 
end; 
 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  canvas.Font.name := 'Arial'; 
  canvas.Font.size := 20; 
end; 
 
procedure TForm1.FormPaint(Sender: TObject); 
begin 
  outlinetextout(canvas, 25, 20, 'Das ist ein Test', clred, clyellow); 
end;