Pasar un JPEG en color a sepia

[pampitasnowman]

Encontré el siguiente código en la página que me mandaste Gydba:

//This function adds a sepia effect to a bitmap.
//the 'depth' sets the colour intensity of the red-brown colour
//greater numbers set a higher intensity.
//To create a greyscale effect instead, set 'depth' to 0

function bmptosepia(const bmp: TBitmap; depth: Integer): Boolean;
var
color,color2:longint;
r,g,b,rr,gg:byte;
h,w:integer;
begin
  for h := 0 to bmp.height do
  begin
    for w := 0 to bmp.width do
    begin
//first convert the bitmap to greyscale
    color:=colortorgb(bmp.Canvas.pixels[w,h]);
    r:=getrvalue(color);
    g:=getgvalue(color);
    b:=getbvalue(color);
    color2:=(r+g+b) div 3;
    bmp.canvas.Pixels[w,h]:=RGB(color2,color2,color2);
//then convert it to sepia
    color:=colortorgb(bmp.Canvas.pixels[w,h]);
    r:=getrvalue(color);
    g:=getgvalue(color);
    b:=getbvalue(color);
    rr:=r+(depth*2);
    gg:=g+depth;
    if rr <= ((depth*2)-1) then
    rr:=255;
    if gg <= (depth-1) then
    gg:=255;
    bmp.canvas.Pixels[w,h]:=RGB(rr,gg,b);
    end;
  end;
end;

//Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
  bmptosepia(image1.picture.bitmap, 20);
end;

La cosa es que clickeo en el botón y la imagen desaparece, o se pone negra, no lo sé. Tendrá algo que ver que la imagen original es un JPG? Osea, Image1.Picture es un JPG.
Y tampoco entiendo porque es una función que retorna un buleano y sin el codigo "return". Bueno, espero que alguno se de cuenta donde está el error o que hago mal. Muchas gracias.

[Neftali [Germán.Estévez]]

Empezado por pampitasnowman

...La cosa es que clickeo en el botón y la imagen desaparece, o se pone negra, no lo sé. Tendrá algo que ver que la imagen original es un JPG? Osea, Image1.Picture es un JPG.

La función "funciona" (valga la redundancia) perfectamente si la utilizas con un BMP; Prueba a convertir primero el JPG a BMP y luego "pasarle" la función. En cuanto al Result, tienes razón, supongo que debe ser un olvido, aunque no afecta al funcionamiento (conversión).

Antes de que lo preguntes...

Convert JPEG to BMP

[pampitasnowman]

Por fin! Muchas gracias a todos por responder mis inquietudes. Probé las dos funciones que estaban en cuestión y funcionaron las dos perfectamente. Nuevamente, gracias a todos por responderme este post. Saludos, Nacho.

PD: Había que pasar nomás el JPG a BITMAP.

[[Héctor Randolph]]

Hola Nacho!

Recibí tu correo en donde me pides que te explique como puedes modificar la escala de tonos sepia que puse como ejemplo en el código.

Voy a publicar el código que utilicé para crearla, por si le interesa a alguien más.

Con esta función puedes llenar un arreglo con un gradiente de colores.

Código Delphi [-]
type
  TEscala= array[0..255] of TColor;
//Crea un gradiente entre tres colores fijos
//La función está limitada a tres colores pero puede adaptarse para cuatro o más
function TForm1.CrearGradiente(Colors: array of TColor):TEscala;
type
  RGBArray = array[0..2] of Byte;
var
  x, y, z, mx, bis, faColorsh: Integer;
  Factor: double;
  A: RGBArray;
  B: array of RGBArray;
  Escala: TEscala;
  I:Integer;
begin
  mx := High(Colors);
  if (mx <1) or ( mx>2) then
    raise Exception.Create('El número de colores debe estar entre 2..3');
  SetLength(b, mx + 1);
  for x := 0 to mx do
  begin
    Colors[x] := ColorToRGB(Colors[x]);
    b[x][0] := GetRValue(Colors[x]);
    b[x][1] := GetGValue(Colors[x]);
    b[x][2] := GetBValue(Colors[x]);
  end;
  faColorsh := Round(255 / mx);
  I:=0;

  for y := 0 to mx - 1 do
  begin
    if y = mx - 1 then
      bis := 255 - y * faColorsh - 1
    else
      bis := faColorsh;
    for x := 0 to bis do
    begin
      Factor := x / bis;
      for z := 0 to 3 do
        a[z] := Trunc(b[y][z] + ((b[y + 1][z] - b[y][z]) * Factor));
      Escala[i]:= RGB(a[0], a[1], a[2]);
      Inc(I);
    end;
  end;
  b := nil;
  Result:=Escala;
end;

Con esta función lo puedes enviar a un archivo de texto para después incluirla en el código.

Código Delphi [-]
//  Guarda la escala en un archivo de texto

procedure TForm1.GuardarEnTxt(Escala:TEscala;FileName: String);
var
 I: Integer;
 S: String;
 Stream:TFileStream;
begin
  Stream:=TFileStream.Create(FileName,fmCreate);
  S:='const'+#13+'TTonos: array[0..255] of TColor=('+#13;
  Stream.Write(PChar(S)^,Length(S));
  S:=' ';
  for I:=0 to 255 do
  begin
    S:=S+'$'+IntToHex(Escala[i],6);
    if I=255 then
    begin
      S:=S+');';
      Stream.Write(PChar(S)^,Length(S));
    end
    else
    begin
      S:=S+',';
      if (I mod 8)=7 then
      begin
        S:=S+#13;
        Stream.Write(PChar(S)^,Length(S));
        S:='  ';
      end;
    end;
  end;
  Stream.Free;
end;

Un ejemplo de como puedes llamar la función.

Código Delphi [-]

procedure TForm1.Button1Click(Sender: TObject);
var
  Escala:TEscala;
begin
  //Crea una escala de tonos en ROJO
  Escala:=CrearGradiente([clBlack, clRed, clWhite]);
  GuardarEnTxt(Escala,'c:\escala.txt');
end;

Con este ejemplo creas una escala de tonos que comienza en NEGRO, pasando por ROJO y que termina en BLANCO.

Puedes experimentar con otros colores para obtener mejores efectos.

Un saludo.

[pampitasnowman]

Nuevamente muchas gracias!