function RandText(bm: TBitmap; txt, fontname: string; fontsize: integer; 
  fontstyle: TFontstyles; untergrund: TColor; 
  farben: array of Tcolor; rand: byte; transparenz: boolean): boolean; 
var 
  lg, x, y, z, br: integer; 
  sz: TSize; 
  p, pm, pp: PBytearray; 
  r, g, b, rf, gf, bf, r2, g2, b2: byte; 
  procedure linksoben; 
  begin 
    if ((pm[x - 3] <> b) or (pm[x - 2] <> g) or (pm[x - 1] <> r)) 
      and ((pm[x - 3] <> bf) or (pm[x - 2] <> gf) or (pm[x - 1] <> rf)) 
      then begin 
      pm[x - 3] := b2; 
      pm[x - 2] := g2; 
      pm[x - 1] := r2; 
    end; 
  end; 
  procedure rechtsoben; 
  begin 
    if ((pm[x + 3] <> b) or (pm[x + 4] <> g) or (pm[x + 5] <> r)) 
      and ((pm[x + 3] <> bf) or (pm[x + 4] <> gf) or (pm[x + 5] <> rf)) 
      then begin 
      pm[x + 3] := b2; 
      pm[x + 4] := g2; 
      pm[x + 5] := r2; 
    end; 
  end; 
  procedure linksunten; 
  begin 
    if ((pp[x - 3] <> b) or (pp[x - 2] <> g) or (pp[x - 1] <> r)) 
      and ((pp[x - 3] <> bf) or (pp[x - 2] <> gf) or (pp[x - 1] <> rf)) 
      then begin 
      pp[x - 3] := b2; 
      pp[x - 2] := g2; 
      pp[x - 1] := r2; 
    end; 
  end; 
  procedure rechtsunten; 
  begin 
    if ((pp[x + 3] <> b) or (pp[x + 4] <> g) or (pp[x + 5] <> r)) 
      and ((pp[x + 3] <> bf) or (pp[x + 4] <> gf) or (pp[x + 5] <> rf)) 
      then begin 
      pp[x + 3] := b2; 
      pp[x + 4] := g2; 
      pp[x + 5] := r2; 
    end; 
  end; 
  procedure rechts; 
  begin 
    if ((p[x + 3] <> b) or (p[x + 4] <> g) or (p[x + 5] <> r)) 
      and ((p[x + 3] <> bf) or (p[x + 4] <> gf) or (p[x + 5] <> rf)) 
      then begin 
      p[x + 3] := b2; 
      p[x + 4] := g2; 
      p[x + 5] := r2; 
    end; 
  end; 
  procedure links; 
  begin 
    if ((p[x - 3] <> b) or (p[x - 2] <> g) or (p[x - 1] <> r)) 
      and ((p[x - 3] <> bf) or (p[x - 2] <> gf) or (p[x - 1] <> rf)) 
      then begin 
      p[x - 3] := b2; 
      p[x - 2] := g2; 
      p[x - 1] := r2; 
    end; 
  end; 
  procedure oben; 
  begin 
    if ((pm[x] <> b) or (pm[x + 1] <> g) or (pm[x + 2] <> r)) 
      and ((pm[x] <> bf) or (pm[x + 1] <> gf) or (pm[x + 2] <> rf)) 
      then begin 
      pm[x] := b2; 
      pm[x + 1] := g2; 
      pm[x + 2] := r2; 
    end; 
  end; 
  procedure unten; 
  begin 
    if ((pp[x] <> b) or (pp[x + 1] <> g) or (pp[x + 2] <> r)) 
      and ((pp[x] <> bf) or (pp[x + 1] <> gf) or (pp[x + 2] <> rf)) 
      then begin 
      pp[x] := b2; 
      pp[x + 1] := g2; 
      pp[x + 2] := r2; 
    end; 
  end; 
begin 
  result := false; 
  lg := high(farben); 
  if (txt = '') or (lg < 0) then exit; 
  farben[0] := ColorToRGB(farben[0]); 
  untergrund := ColorToRGB(untergrund); 
  for x := 1 to lg do begin 
    farben[x] := ColorToRGB(farben[x]); 
    if (farben[x] = untergrund) or (farben[x] = farben[x - 1]) then exit; 
  end; 
  bm.pixelformat := pf24bit; 
  try 
    with bm.canvas do begin 
      Font.name := fontname; 
      Font.size := fontsize; 
      Font.style := fontstyle; 
      Font.color := farben[0]; 
      sz := TextExtent(txt); 
      bm.height := sz.cy + 2 + lg * 2 + rand * 2; 
      bm.width := sz.cx + 2 + ord(fsItalic in fontstyle) * (fontsize div 5) + 
        lg * 2 + rand * 2; 
      brush.color := untergrund; 
      fillrect(cliprect); 
      brush.style := bsClear; 
      textout(1 + rand + lg, 1 + rand + lg, txt); 
    end; 
    br := bm.width * 3 - rand * 3; 
    for z := 0 to lg - 1 do begin 
      r := getrvalue(farben[z]); 
      g := getgvalue(farben[z]); 
      b := getbvalue(farben[z]); 
      r2 := getrvalue(farben[z + 1]); 
      g2 := getgvalue(farben[z + 1]); 
      b2 := getbvalue(farben[z + 1]); 
      rf := getrvalue(farben[z - 1]); 
      gf := getgvalue(farben[z - 1]); 
      bf := getbvalue(farben[z - 1]); 
      for y := rand + 1 to bm.height - 2 - rand do begin 
        p := bm.scanline[y]; 
        pm := bm.scanline[y - 1]; 
        pp := bm.scanline[y + 1]; 
        x := rand * 3; 
        while x < br do begin 
          if (p[x] = b) and (p[x + 1] = g) and (p[x + 2] = r) 
            then begin 
            links; 
            oben; 
            rechts; 
            unten; 
            linksoben; 
            linksunten; 
            rechtsoben; 
            rechtsunten; 
          end; 
          inc(x, 3); 
        end; 
      end; 
    end; 
    bm.transparentcolor := untergrund; 
    bm.transparent := transparenz; 
  except 
    exit; 
  end; 
  result := true; 
end; 
 
 

// Beispielaufruf

procedure TForm1.Button5Click(Sender: TObject);  
var  
  bm: TBitmap;  
begin  
  bm := TBitmap.create;  
  if RandText(bm, 'Test', 'Arial', 30, [fsBold], clBlack,  
    [$99FF, clLime, clBlue, clRed], 0, true) then  
    canvas.draw(10, 10, bm) else  
    showmessage('FEHLER');  
  bm.free;  
end;