// uses System.Types; 
 
const 
  Punktfarbe = clRed; 
  Punktradius = 10; 
  Ausbreitung = 6; 
  Ringbreite = 4; 
 
var 
  PunktRGB, GrundRGB: TRGBTriple; 
  Transparenz, Grundfarbe: TColor; 
  F: Array [0 .. pred(Ausbreitung)] of TRGBTriple; 
  Fase, Mitte, MitteM, MitteP, PunktMitteX, PunktMitteY: Integer; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var 
  I, Farbe, Grund, Teiler: Integer; 
begin 
  Timer1.Interval := 0; 
  DoubleBuffered := True; 
  Transparenz := clBlack; 
  Grundfarbe := ColorToRGB(Color); // z.B. 
  if Grundfarbe = Transparenz then 
    if odd(Transparenz) then 
      dec(Transparenz) 
    else 
      inc(Transparenz); 
  with GrundRGB do 
  begin 
    rgbtRed := GetRValue(Grundfarbe); 
    rgbtGreen := GetGValue(Grundfarbe); 
    rgbtBlue := GetBValue(Grundfarbe); 
  end; 
  with PunktRGB do 
  begin 
    rgbtRed := GetRValue(Punktfarbe); 
    rgbtGreen := GetGValue(Punktfarbe); 
    rgbtBlue := GetBValue(Punktfarbe); 
  end; 
  Teiler := Ausbreitung * 2; 
  for I := 0 to pred(Ausbreitung) do 
  begin 
    Farbe := Ausbreitung - I; 
    Grund := Ausbreitung + I; 
    with F[I] do 
    begin 
      rgbtRed := (PunktRGB.rgbtRed * Farbe + GrundRGB.rgbtRed * Grund) 
        div Teiler; 
      rgbtGreen := (PunktRGB.rgbtGreen * Farbe + GrundRGB.rgbtGreen * Grund) 
        div Teiler; 
      rgbtBlue := (PunktRGB.rgbtBlue * Farbe + GrundRGB.rgbtBlue * Grund) 
        div Teiler; 
    end; 
  end; 
  with Image1 do 
  begin 
    Visible := false; 
    AutoSize := True; 
    with Picture.Bitmap, Canvas do 
    begin 
      Brush.Color := Transparenz; 
      Width := (Punktradius + Ausbreitung * Ringbreite) * 2; 
      Height := Width; 
      Mitte := Width div 2; 
      MitteM := Mitte - Punktradius; 
      MitteP := Mitte + Punktradius; 
      Pen.Style := psClear; 
      Brush.Color := Punktfarbe; 
      Ellipse(MitteM, MitteM, MitteP, MitteP); 
      Pen.Style := psSolid; 
      Pen.Width := Ringbreite; 
      Brush.Style := bsClear; 
    end; 
    Transparent := True; 
  end; 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
var 
  Mal, WegFase: Integer; 
  P: TPoint; 
begin 
  with Image1.Picture.Bitmap.Canvas do 
  begin 
    WegFase := pred(Fase); 
    if WegFase < 0 then 
      WegFase := pred(Ausbreitung); 
    Mal := Ringbreite * WegFase; 
    P := point(MitteM - Mal, MitteP + Mal); 
    Pen.Color := Transparenz; 
    Ellipse(P.X, P.X, P.Y, P.Y); 
    if Fase = Ausbreitung then 
    begin 
      Fase := 0; 
      exit; 
    end; 
    P := point(MitteM - Ringbreite * Fase, MitteP + Ringbreite * Fase); 
    Pen.Color := RGB(F[Fase].rgbtRed, F[Fase].rgbtGreen, F[Fase].rgbtBlue); 
    Ellipse(P.X, P.X, P.Y, P.Y); 
  end; 
  inc(Fase); 
end; 
 
 
// Starten 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  PunktMitteX := 150; // z.B. 
  PunktMitteY := 200; // z.B. 
  Fase := 0; 
  with Image1 do 
  begin 
    Left := PunktMitteX - Mitte; 
    Top := PunktMitteY - Mitte; 
    Visible := True; 
  end; 
  Timer1.Interval := 80; 
end; 
 
// Stoppen 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  Timer1.Interval := 0; 
  Image1.Visible := false; 
end; 

//-----------------------------------------------------------

// Variante 2 
// Der Code erzeugt eine gleichmäßigere Erscheinung, kann über ein 
// anderes TImage gelegt werden, und erlaubt eine Pause vor dem 
// nächsten Puls.

const 
  Max = 50; 
  Maxring = 10; 
  Punktradius = 11; // z.B. 
  Pause = 7; // bezieht sich auf Fasen. Also 7 Fasen lang pausierend 
 
type 
  wieweit = 3 .. Max; 
  wiebreit = 2 .. Maxring; 
 
var 
  Ausbreitung: wieweit = 11; 
  Ringbreite: wiebreit = 6; 
  P: Array [0 .. 1] of Integer; 
  Punktfarbe, RingFarbe: TColor; 
  T: Array [0 .. pred(Max)] of Byte; 
  Breite, Fase, Mitte, MitteM, MitteP, PunktX, PunktY: Integer; 
  Hintergrund: TImage; 
  Rct: TRect; 
  hlp: TBitmap; 
  R, G, B: Byte; 
 
procedure Trans(bm: TBitmap; tr: Byte); 
var 
  X, Y, B3: Integer; 
  pbd, pbs: PByteArray; 
  dff: Byte; 
begin 
  dff := 255 - tr; 
  B3 := bm.width * 3; 
  for Y := 0 to pred(bm.Height) do 
  begin 
    X := 0; 
    pbd := bm.ScanLine[Y]; 
    pbs := hlp.ScanLine[Y]; 
    while X < B3 do 
    begin 
      if (pbd[X] = B) and (pbd[X + 1] = G) and (pbd[X + 2] = R) then 
      begin 
        pbd[X] := (pbd[X] * dff + pbs[X] * tr) shr 8; 
        pbd[X + 1] := (pbd[X + 1] * dff + pbs[X + 1] * tr) shr 8; 
        pbd[X + 2] := (pbd[X + 2] * dff + pbs[X + 2] * tr) shr 8; 
      end; 
      inc(X, 3); 
    end; 
  end; 
end; 
 
procedure GrundStellung(cnv: TCanvas); 
begin 
  with cnv do 
  begin 
    Brush.Color := clBlack; 
    FillRect(ClipRect); 
    Pen.Style := psClear; 
    Brush.Color := Punktfarbe; 
    Ellipse(MitteM, MitteM, MitteP, MitteP); 
    Pen.Style := psSolid; 
    Pen.width := Ringbreite; 
    Brush.Style := bsClear; 
  end; 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
var 
  I: Integer; 
begin 
  Timer1.Interval := 0; 
  Hintergrund := Image2; // z.B. 
  DoubleBuffered := True; 
  Breite := Ringbreite div 2; 
  Punktfarbe := clred; 
  if Odd(Punktfarbe) then 
    RingFarbe := Punktfarbe - 1 
  else 
    RingFarbe := Punktfarbe + 1; 
  R := GetRValue(RingFarbe); 
  G := GetGValue(RingFarbe); 
  B := GetBValue(RingFarbe); 
  hlp := TBitmap.create; 
  hlp.pixelformat := pf24bit; 
  with Image1 do 
  begin 
    BringToFront; 
    Visible := false; 
    AutoSize := True; 
    with Picture.Bitmap, Canvas do 
    begin 
      pixelformat := pf24bit; 
      Mitte := (Punktradius + Ausbreitung * Breite); 
      width := Mitte * 2; 
      Height := width; 
      MitteM := Mitte - Punktradius; 
      MitteP := Mitte + Punktradius; 
    end; 
    GrundStellung(Image1.Picture.Bitmap.Canvas); 
    Transparent := True; 
  end; 
  for I := 0 to pred(Ausbreitung) do 
    T[I] := (255 div Ausbreitung) * succ(I); 
 
  // Falls kein TBitmap in Hintergrund ist: 
  hlp.Assign(Hintergrund.Picture.Graphic); 
  Hintergrund.Picture.Assign(hlp); 
  // --------------------------------------- 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  FreeAndNil(hlp); 
end; 
 
procedure TForm1.Timer1Timer(Sender: TObject); 
var 
  Mal, Weg, Fs: Integer; 
begin 
  if Fase < 0 then 
  begin 
    inc(Fase); 
    exit; 
  end; 
  with Image1.Picture.Bitmap.Canvas do 
  begin 
    Weg := pred(Fase); 
    if Weg < 0 then 
      Weg := pred(Ausbreitung); 
    Mal := Breite * Weg + Breite; 
    P[0] := MitteM - Mal; 
    P[1] := MitteP + Mal; 
    Pen.Color := clBlack; 
    Ellipse(P[0], P[0], P[1], P[1]); 
    Fs := Breite * Fase + Breite; 
    P[0] := MitteM - Fs; 
    if P[0] < 1 then 
    begin 
      Fase := -Pause; 
      exit; 
    end; 
    P[1] := MitteP + Fs; 
    Pen.Color := RingFarbe; 
    Ellipse(P[0], P[0], P[1], P[1]); 
  end; 
  Trans(Image1.Picture.Bitmap, T[Fase]); 
  inc(Fase); 
end; 
 
// Starten 
procedure TForm1.Button1Click(Sender: TObject); 
begin 
  if (RingFarbe = clBlack) or (Punktfarbe = clBlack) then 
    showmessage('Unzulässige Farbe') 
  else 
  begin 
    Button1.Enabled := false; 
    PunktX := Mitte + (Hintergrund.width - Image1.width) div 2; // z.B. 
    PunktY := Mitte + (Hintergrund.Height - Image1.Height) div 2; // z.B. 
    Fase := 0; 
    Image1.Left := PunktX - Mitte + Hintergrund.Left; 
    Image1.Top := PunktY - Mitte + Hintergrund.Top; 
    hlp.setsize(Image1.width, Image1.Height); 
    Rct := Rect(PunktX - Mitte, PunktY - Mitte, PunktX + Mitte, PunktY + Mitte); 
    with hlp.Canvas do 
      copyrect(ClipRect, Hintergrund.Canvas, Rct); 
    Image1.Visible := True; 
    Timer1.Interval := 50; 
  end; 
end; 
 
// Stoppen 
procedure TForm1.Button2Click(Sender: TObject); 
begin 
  Timer1.Interval := 0; 
  Image1.Visible := false; 
  Button1.Enabled := True; 
  GrundStellung(Image1.Picture.Bitmap.Canvas); 
end;