type 
  TForm1 = class(TForm) 
    procedure FormCreate(Sender: TObject); 
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure FormDestroy(Sender: TObject); 
    procedure FormShow(Sender: TObject); 
  private 
   { Private-Deklarationen } 
  public 
    procedure minmax(var aMsg: TWMGetMinMaxInfo); message WM_GETMINMAXINFO; 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.DFM} 
 
var 
  rgn: Hrgn; 
  dy, dx, breite, hoehe: integer; 
  sl: TStringlist; 
  sz: TSize; 
 
procedure RegionText(h: hdc; x, y: integer; t: TStrings; f: THandle); 
var i: integer; 
begin 
  selectobject(h, f); 
  setBkMode(h, TRANSPARENT); 
  BeginPath(h); 
  for i := 0 to t.count - 1 do 
    textout(h, x, y + i * sz.cy, pchar(t[i]), length(t[i])); 
  EndPath(h); 
  rgn := PathToRegion(h); 
end; 
 
procedure TForm1.minmax(var aMsg: TWMGetMinMaxInfo); 
begin 
  inherited; 
  with aMsg.MinMaxInfo^ do begin 
    ptMinTrackSize.x := breite; 
    ptMinTrackSize.y := hoehe; 
  end; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var d: integer; 
begin 
  cursor := crHandpoint; 
  d := GetSystemMetrics(SM_CYFRAME); 
  dy := GetSystemMetrics(SM_CYCAPTION) + d; 
  dx := GetSystemMetrics(SM_CXFRAME); 
  sl := TStringlist.create; 
  sl.add('Das ist ein Test'); 
  sl.add('Das ist ein Versuch'); 
  sl.add('DELPHI ist OK'); 
  sl.add('DBR.Software');
  sl.add(''); 
  sl.add('Verschieben mit linker Maustaste.'); 
  sl.add('Schließen mit Rechtsklick.'); 
  color := clFuchsia; 
  with Canvas do begin 
    Font.size := 30; 
    Font.name := 'Arial'; // muss TrueTyp sein 
    Font.style := [fsBold]; 
    Font.color := clred; 
    sz := textextent(sl[5]); // längste Zeile 
    breite := sz.cx + dx * 2; 
    hoehe := sz.cy * sl.count + dy + d; 
    setbounds(0, -dy, breite, hoehe); 
    RegionText(handle, dx, dy, sl, Font.handle); 
  end; 
  setwindowRgn(handle, rgn, true); 
end; 
 
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if button = mbleft then begin 
    releaseCapture; 
    perform(WM_SysCommand, $F012, 0); 
  end; 
end; 
 
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if button = mbright then close; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  sl.free; 
end; 
 
procedure TForm1.FormShow(Sender: TObject); 
begin 
  setwindowpos(handle, hwnd_topmost, 0, 0, 0, 0, swp_nosize or swp_nomove); 
end;