hintergrundefekt

[xaromz]

Hallo,

im Grunde brauchst Du dafür drei Funktionen:
Eine, die ein Graustufenbild erzeugt.
Eine, die zwei Bilder überlagert
Eine, die diese Überlagerung in einer Schleife widerholt.

Ich hab mal diese drei Funktionen geschrieben. Du brauchst nur noch ein TImage und einen Button:

Delphi-Quellcode:

procedure ToGray(const Bitmap: TBitmap);
var
  Trip: PRGBTriple;
  P: PByte;
  PixelCount: Integer;
  C: Integer;
  Gray: Byte;
  Alignment: Byte;
begin
  if not (Bitmap.PixelFormat in [pf24Bit, pf32Bit]) then
    Exit;

  // Vorbereitungen
  P := Bitmap.ScanLine[Bitmap.Height - 1];

  // Alignment berechnen
  if (Bitmap.PixelFormat = pf24Bit) then
    Alignment := (4 - (Bitmap.Width * 3) mod 4) mod 4
  else
    Alignment := 0;

  // In einer Schleife alle Pixel durchgehen
  PixelCount := Bitmap.Width * Bitmap.Height;
  for C := 0 to PixelCount - 1 do
  begin
    //Pixel holen
    Trip := PRGBTriple(P);

    // Graustufenberechnung
    Gray := Round(Trip.rgbtBlue * 0.114 + Trip.rgbtGreen * 0.578 + Trip.rgbtRed * 0.299);
    Trip.rgbtBlue := Gray;
    Trip.rgbtGreen := Gray;
    Trip.rgbtRed := Gray;

    // Nächster Pixel
    Inc(P, 3);
    if Bitmap.PixelFormat = pf32Bit then
      Inc(P);

    // Alignment am Ende der Zeile
    if (C > 0) and (C mod Bitmap.Width = 0) then
      Inc(P, Alignment);
  end;
end;

function Fade(const Bitmap1, Bitmap2: TBitmap; Delta: Byte): TBitmap;
var
  Trip1, Trip2, TripR: PRGBTriple;
  P1, P2, PR: PByte;
  PixelCount: Integer;
  C: Integer;
  Alignment1, Alignment2, AlignmentR: Byte;

begin
  Result := nil;
  if (Bitmap1 = nil) or (Bitmap2 = nil) or
     (Bitmap1.Width <> Bitmap2.Width) or (Bitmap1.Height <> Bitmap2.Height) or
     not (Bitmap1.PixelFormat in [pf24Bit, pf32Bit]) or
     not (Bitmap2.PixelFormat in [pf24Bit, pf32Bit]) then
  Exit;

  // Vorbereiten
  Result := TBitmap.Create;
  Result.PixelFormat := pf24Bit;
  Result.Width := Bitmap1.Width;
  Result.Height := Bitmap1.Height;

  P1 := Bitmap1.ScanLine[Bitmap1.Height - 1];
  P2 := Bitmap2.ScanLine[Bitmap2.Height - 1];
  PR := Result.ScanLine[Result.Height - 1];

  // Alignment berechnen
  if (Bitmap1.PixelFormat = pf24Bit) then
    Alignment1 := (4 - (Bitmap1.Width * 3) mod 4) mod 4
  else
    Alignment1 := 0;

  if (Bitmap2.PixelFormat = pf24Bit) then
    Alignment2 := (4 - (Bitmap2.Width * 3) mod 4) mod 4
  else
    Alignment2 := 0;

  AlignmentR := (4 - (Result.Width * 3) mod 4) mod 4;

  // In einer Schleife alle Pixel durchgehen
  PixelCount := Result.Width * Result.Height;
  for C := 0 to PixelCount - 1 do
  begin
    // Pixel holen
    Trip1 := PRGBTriple(P1);
    Trip2 := PRGBTriple(P2);
    TripR := PRGBTriple(PR);

    // Faden
    TripR.rgbtBlue := Round((Trip1.rgbtBlue * Delta + Trip2.rgbtBlue * (255 - Delta)) / 255);
    TripR.rgbtGreen := Round((Trip1.rgbtGreen * Delta + Trip2.rgbtGreen * (255 - Delta)) / 255);
    TripR.rgbtRed := Round((Trip1.rgbtRed * Delta + Trip2.rgbtRed * (255 - Delta)) / 255);

    // Nächster Pixel
    Inc(P1, 3);
    Inc(P2, 3);
    Inc(PR, 3);
    if Bitmap1.PixelFormat = pf32Bit then
      Inc(P1);
    if Bitmap2.PixelFormat = pf32Bit then
      Inc(P2);

    // Alignment am Ende der Zeile
    if (C > 0) and (C mod Result.Width = 0) then
    begin
      Inc(P1, Alignment1);
      Inc(P2, Alignment2);
      Inc(PR, AlignmentR);
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  B1, B2: TBitmap;
  I: Integer;
  Count, Delta: Integer;
begin
  try
    Screen.Cursor := crHourglass;
    // Bilder vorbereiten
    B1 := TBitmap.Create;
    B1.Assign(Image1.Picture.Bitmap);
    B2 := TBitmap.Create;
    B2.Assign(B1);
    ToGray(B2);

    // Die Schleife
    // einfach mal mit den Werten spielen,
    // aber (Count - 1) * Delta darf nicht größer sein als 255!
    Count := 20;
    Delta := 12;
    for I := 0 to Count - 1 do
    begin
      Image1.Picture.Bitmap := Fade(B1, B2, 255 - I * Delta);
      Image1.Update;
    end;
  finally
    B2.Free;
    B1.Free;
    Screen.Cursor := crDefault;
  end;
end;

Gruß
xaromz