var 
  Fontname: string = 'Courier New'; 
  Fontstyle: TFontstyles = []; 
  Fontsize: Integer = 12; 
  Fontcolor: TColor = clBlue; 
 
procedure 
  SchraegTextOut(cnv: TCanvas; x, y: Integer; txt: string; steigung: byte); 
var i, j, b3, z: integer; 
  p: pbytearray; 
  hlp: TBitmap; 
  sz: TSize; 
  z3, interv: single; 
begin 
  hlp := TBitmap.create; 
  hlp.pixelformat := pf24bit; 
  interv := steigung / 255; 
  with hlp.canvas do begin 
    font.name := Fontname; 
    font.size := Fontsize; 
    font.color := ColorToRGB(Fontcolor); 
    font.style := Fontstyle; 
    sz := textextent(txt); 
    sz.cx := sz.cx * 2; 
    b3 := sz.cx * 3 - 3; 
    hlp.width := sz.cx; 
    hlp.height := sz.cy; 
    if odd(font.color) then 
      brush.color := font.color - 1 
    else brush.color := font.color + 1; 
    fillrect(cliprect); 
    textout(1, 0, txt); 
  end; 
  z3 := interv; 
  for j := 1 to sz.cy - 1 do begin 
    p := hlp.scanline[j]; 
    z := round(z3) * 3; 
    z3 := z3 + interv; 
    i := b3; 
    while (i > 0) do begin 
      if (i - z < 0) then begin 
        p[i] := p[i - z + b3]; 
        p[i + 1] := p[i + 1 - z + b3]; 
        p[i + 2] := p[i + 2 - z + b3]; 
      end else begin 
        p[i] := p[i - z]; 
        p[i + 1] := p[i + 1 - z]; 
        p[i + 2] := p[i + 2 - z]; 
      end; 
      dec(i, 3); 
    end; 
  end; 
  hlp.transparentcolor := hlp.canvas.brush.color; 
  hlp.transparent := true; 
  cnv.Draw(x - 1, y, hlp); 
  hlp.free; 
end; 
 
// Beispielaufruf 
 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  SchraegTextOut(Canvas, 10, 50, 'Schrägschrift, Steigung 60', 60); 
 
  // und als Gegenstück: 
  with canvas do begin 
    font.name := Fontname; 
    font.size := Fontsize; 
    font.color := ColorToRGB(Fontcolor); 
    font.style := Fontstyle + [fsItalic]; 
    brush.style := bsClear; 
    TextOut(10, 80, 'Kursivschrift mittels Italic'); 
  end; 
end;