Delphi - Implementation of "sepia" routine for an arbitrary color

Question

I've seen the odd routine for converting an image to a sepia-tone version, like this one:

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;

(from here) but I need something that does this for an arbitrary color - i.e. it will take an image, presumably form a gray-scale version of it, and then apply the new colour to the image. It's the last bit I'm having trouble with - i.e. the replacement of the shades of gray with the color of interest.

So I need

procedure BmpToOneColor (const bmp      : TBitmap ;
                               depth    : Integer ; 
                               NewColor : TColor) ;

(I have no idea why the original was written as a boolean function).

Also, use [`ScanLine`](http://docwiki.embarcadero.com/Libraries/XE2/en/Vcl.Graphics.TBitmap.ScanLine) instead of [`Pixels`](http://docwiki.embarcadero.com/Libraries/XE3/en/Vcl.Graphics.TCustomCanvas.Pixels). Latter is very inefficient when you're working with more pixels. — TLama, Nov 22 '12 at 17:35

score 3 · Accepted Answer · answered Nov 20 '12 at 22:36

Your base algorithm is just adding fixed offsets to each color channel of the gray value. We can generalize this so that the NewColor parameter determines the offset for each channel. Notice that depth becomes redundant and you can leave it out entirely.

rbase:=getrvalue(NewColor);
gbase:=getgvalue(NewColor);
bbase:=getbvalue(NewColor);
base:=min(rbase,min(gbase,bbase));
rdepth:=rbase-base;
gdepth:=gbase-base;
bdepth:=bbase-base;

rr:=r+rdepth;
gg:=g+gdepth;
bb:=b+bdepth;
if rr < rdepth then
    rr:=255;
if gg < gdepth then
    gg:=255;
if bb < bdepth then
    bb:=255;

Delphi - Implementation of "sepia" routine for an arbitrary color

1 Answers1