德爾福 - 「懷舊」程序的執行情況任意顏色

Question

我見過的奇怪的常規用於將圖像轉換爲棕褐色版本，像這樣的：

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; 

（從here），但我需要一些爲任意顏色執行此操作的東西 - 例如，它將拍攝一張圖像，據推測可以形成灰度版本，然後將新顏色應用於圖像。這是我遇到的最後一點 - 即用感興趣的顏色替換灰色陰影。

所以我需要

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

（我不知道爲什麼當初被寫了一個布爾函數）。

Answer 1

您的基本算法只是將固定的偏移量添加到灰度值的每個顏色通道。我們可以將其推廣，以便NewColor參數確定每個通道的偏移量。請注意，depth會變得多餘，您可以將其全部刪除。

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;