logo

.
Thursday 09th of September 2010    

Ankety

Co tu není dobré ?
 

Přihlášení



Provoz stránek

návštěv dnes: 27
návštěv včera: 59
návštěv za měsíc: 513
návštěv celkem: 17817

Home Tipy, triky, návody VZHLED, GRAFIKA Převod obrázek do sépie (odstínů šedi)
Převod obrázek do sépie (odstínů šedi) Tisk Email
Hodnocení uživatelů: / 0
NejhoršíNejlepší 
Napsal uživatel Administrator   
Úterý, 05 Květen 2009 12:52

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;

Zdroj: http://www.swissdelphicenter.ch/en/showcode.php?id=1794 

 

Aktualizováno Čtvrtek, 28 Květen 2009 13:25
 

Přidejte svůj komentář

Vaše jméno:
Titulek:
Komentář:
bottom

top

kolik vás je ?

Právě připojeni - host: 1 

bottom

Založeno na Joomla!. Designed by: Free Joomla 1.5 Template, dns. Valid XHTML and CSS.