Coloca un componente Image en tu formulario, cárgale un mapa de bits y prueba este código:
procedure TForm1.Button1Click(Sender: TObject);
var
i, k, r, c: integer;
row: pbytearray;
begin
with Image1.Picture do
for i := 25 downto 0 do begin
k := i + 1;
for r := 0 to Bitmap.Height - 1 do begin
row := Bitmap.Scanline[r];
for c := 0 to Bitmap.Width * 3 - 1 do
row[c] := (integer(row[c]) * i + 255) div k;
end;
Image1.Repaint;
sleep(55);
end;
end;
El mapa de bits se fundirá hacia el blanco. Cambia 255 por 192, y la imagen tenderá hacia un gris claro, y con 0 irá al negro. Si quieres que la imagen tienda hacia una versión en tonos de grises de la misma imagen, o hacia otra imagen, tienes que tener esa otra imagen por separado y en vez de poner un "número mágico" como 255 o 192, pones el valor de la componente de color correspondiente del pixel correspondiente a esa imagen:
procedure TForm1.Button2Click(Sender: TObject);
var
i, k, r, c: integer;
row, row2: pbytearray;
Bitmap2: TBitmap;
begin
Bitmap2 := Image2.Picture.Bitmap;
with Image1.Picture.Bitmap do begin
for i := 24 downto 0 do begin
k := i + 1;
for r := 0 to Height - 1 do begin
row := Scanline[r];
row2 := Bitmap2.Scanline[r];
for c := 0 to Width * 3 - 1 do
row[c] := (integer(row[c]) * i + row2[c]) div k;
end;
Image1.Repaint;
sleep(55);
end;
end;
end;
Las imágenes tienen que ser mapas de bits de 24 bits por pixel para que el código funcione.
Ernesto De Spirito
http://www.latiumsoftware.com/es/index.php