Esta funcion permite tratar de forma independiente cada canal de color de una imagen, esto permite cambiar el color de la imagen o si todos los canales se multiplican por el mismo valor se cambia el brillo.
Puede tratar cualquier imagen soportada por un TPicture (bmp, ico, wmf, emf y jpeg si se añade Jpeg a las uses), aunque la imagen resultante siempre es un bitmap.
Código Delphi
[-]
type
Triple = array[1..3]of Byte;
function Multiplicar(b: Byte; x: Integer): byte;
begin
x:= (x * b);
x:= x shr 7;
if x > 255 then Result:= 255
else Result:= x;
end;
procedure Canales(Imagen: TPicture; Rojo, Verde, Azul: Byte);
var
Bitmap: TBitmap;
P: ^Triple;
i, j: Integer;
begin
if not (Imagen.Graphic is TBitmap) then
begin
Bitmap:= TBitmap.Create;
try
Bitmap.Width:= Imagen.Width;
Bitmap.Height:= Imagen.Height;
Bitmap.Canvas.Draw(0,0,Imagen.Graphic);
Imagen.Assign(Bitmap);
finally
Bitmap.Free;
end;
end;
Imagen.Bitmap.PixelFormat:= pf24bit;
for j:= 0 to Imagen.Bitmap.Height - 1 do
begin
P:= Imagen.Bitmap.ScanLine[j];
for i:= 0 to Imagen.Bitmap.Width - 1 do
begin
P^[1]:= Multiplicar(P^[1],Azul);
P^[2]:= Multiplicar(P^[2],Verde);
P^[3]:= Multiplicar(P^[3],Rojo);
inc(P);
end;
end;
end;
Ejemplos de uso:
Código Delphi
[-]
Canales(Image1.Picture,64,64,64);
Canales(Image1.Picture,192,192,192);
Canales(Image1.Picture,128,128,128);
var
Imagen: TPicture;
Jpeg: TJPEGImage;
begin
Imagen:= TPicture.Create;
Jpeg:= TJPEGImage.Create;
try
Imagen.LoadFromFile('d:\1.jpg');
Canales(Imagen,192,128,64);
Jpeg.Assign(Imagen.Bitmap);
Jpeg.SaveToFile('d:\2.jpg');
finally
Imagen.Free;
Jpeg.Free;
end;
end;