// Mit dem folgenden Code kann man einen String wellenförmig
// auf einem Canvas ausgeben. Bei einem positiven Wert für amplitude
// beginnt die Welle absteigend, bei einem negativen Wert aufsteigend.

// Getestet mit D4 unter WinME
 
type 
  ausschlag = -20..20; 
 
procedure WaveTextOut(cnv: TCanvas; x, y: integer; 
  amplitude: ausschlag; txt: string); 
var 
  a, i, j, z, lg: integer; 
  s: TSize; 
begin 
  lg := length(txt); 
  if lg = 0 then exit; 
  a := abs(amplitude); 
  with cnv do begin 
    s := TextExtent(txt); 
    fillrect(rect(x - 2, y - a, x + s.cx + 2, y + s.cy + a)); 
    z := y; 
    j := 2; 
    moveto(x, y); 
    for i := 0 to lg - 1 do begin 
      if txt[i + 1] <> #32 then 
        z := trunc(y + sin(i - j) * amplitude) else inc(j); 
      textout(penpos.x, z, txt[i + 1]); 
    end; 
  end; 
end; 
 
// Beispielaufruf 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  with canvas do begin 
    brush.color := clblack; 
    font.color := $33CCFF; 
    font.name := 'Courier New'; 
    font.size := 11; 
  end; 
end; 
 
procedure TForm1.FormPaint(Sender: TObject); 
begin 
  WaveTextOut(canvas, 25, 100, 7, 'Das ist ein Test für den Wellentext'); 
end;

type 
  ausschlag = -20..20; 
 
const 
  bewegung: integer = 0; 
 
procedure WaveTextOut(cnv: TCanvas; x, y: integer; 
  amplitude: ausschlag; txt: string); 
var 
  a, i, j, z, lg: integer; 
  s: TSize; 
begin 
  lg := length(txt); 
  if lg = 0 then exit; 
  a := abs(amplitude); 
  with cnv do begin 
    s := TextExtent(txt); 
    fillrect(rect(x - 2, y - a, x + s.cx + 2, y + s.cy + a)); 
    z := y; 
    j := 0; 
    moveto(x, y); 
    for i := 0 to lg - 1 do begin 
      if txt[i + 1] <> #32 then 
        z := trunc(y + sin(i - j - bewegung) * amplitude) else inc(j); 
      textout(penpos.x, z, txt[i + 1]); 
    end; 
  end; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  Timer1.interval := 110; 
  with canvas do begin 
    brush.color := clmaroon; 
    font.color := clyellow; 
    font.name := 'Fixedsys'; 
  end; 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
  if bewegung = 6 then bewegung := 1 else inc(bewegung); 
  WaveTextOut(canvas, 25, 100, -6, 
    'Das ist ein Beispiel für bewegten Wellentext'); 
end;