3D эффект шрифта

procedure ExtFont(canvas: TCanvas);
var
  font: HFONT;
  fontName, txt: PChar;
  sSize: Size;
  i: integer;
begin
  fontName := 'Tahoma';
  txt := 'www.codeplace.ru';
  font := CreateFont(
      60, 30, 0, 0, FW_BOLD, 0, 0, 0, DEFAULT_CHARSET,
  OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
  PROOF_QUALITY, DEFAULT_PITCH + FF_DONTCARE, fontName);
  SelectObject(Canvas.Handle, font);
  SetBkMode(Canvas.Handle, TRANSPARENT);
  GetTextExtentPoint32(
      Canvas.Handle, txt, length(txt), sSize);
  BeginPath(Canvas.Handle);
  Canvas.Pen.Color:= clGreen; { Цвет текста}
  i:= 1;
  for i:= 0 to 2 do  {глубина эффекта}
  begin
   { позиция текста на форме }
   TextOut(Canvas.Handle, 5 + i, 10 + i,
      txt, length(Txt));
  end;
  EndPath(Canvas.Handle);
  // Canvas.Pen.Style := psDot;  { Стиль }
  StrokePath(Canvas.Handle);
  SetBkMode(Canvas.Handle, OPAQUE);
  DeleteObject(SelectObject(
      Canvas.Handle, GetStockObject(WHITE_BRUSH)));
  SelectObject(Canvas.Handle,
      GetStockObject(SYSTEM_FONT));
  DeleteObject(font);
end;

Пример использования:

procedure TForm1.FormPaint(Sender: TObject);
begin
  ExtFont(Form1.Canvas);
end;