Algorytmy

Rozjaśnianie i Przyciemnianie

Pragnę na początku zaznaczyć, że poniższe procedury nie są mojego autorstwa (nie wiem też kogo :)). Oto dwie procedury które rozjaśnią/przyciemnią kolor:
function Darker(Col: TColor; Percent: Byte): TColor;
var
  R, G, B: Byte;
begin
  R := GetRValue(Col);
  G := GetGValue(Col);
  B := GetBValue(Col);
  R := Round(R*Percent/100);
  G := Round(G*Percent/100);
  B := Round(B*Percent/100);
  Result := RGB(R, G, B);
end;
 
function Lighter(Col: TColor; Percent: Byte): TColor;
var
  R, G, B: Byte;
begin
  R := GetRValue(Col);
  G := GetGValue(Col);
  B := GetBValue(Col);
  R := Round(R*Percent/100) + Round(255 - Percent/100*255);
  G := Round(G*Percent/100) + Round(255 - Percent/100*255);
  B := Round(B*Percent/100) + Round(255 - Percent/100*255);
  Result := RGB(R, G, B);
end;


Jak łatwo się domyśleć pierwsza z nich przyciemnia druga rozjaśnia podany w parametrze kolor o "Percent" procent.

Oto sposób na wykorzystanie któregoś z tych sposobów:
procedure TForm1.Button1Click(Sender: TObject);
var
  Pic : TBitmap;
  I, J : Integer;
begin
  Pic := TBitmap.Create;
  try
    Pic.Assign(Image1.Picture.Graphic);
    for I := 0 to Pic.Width do
      for J := 0 to Pic.Height do
        Pic.Canvas.Pixels[i, j] := Darker(Pic.Canvas.Pixels[i, j], 50);
 
    Image1.Picture.Graphic := Pic;
  finally
    Pic.Free;
  end;
end;


Szybkość tego algorytmu zależy od prędkości Twojego procesora oraz od rozmiarów bitmapy. Ten kod wczytuje najpierw obrazek do pamięci, a później edytuje każdy piksel obrazka w pamięci, aby na końcu przypisać zmodyfikowany już obrazek do komponentu Image.

Jednakże Dryobates przesłał mi szybszy algorytm (dzięki!) - oto on:
interface
 
type 
  TTriple = record
    B,G,R:byte;
  end;
 
function Lighter(Col: TTriple; Percent: Byte): TTriple;
function Darker(Col: TTriple; Percent: Byte): TTriple;
 
var
  Form1: TForm1;
  Pic : TBitmap;
 
implementation
 
{$R *.DFM}
 
function Darker(Col: TTriple; Percent: Byte): TTriple;
begin
  Col.B:=Trunc(Col.B*percent/100);
  Col.G:=Trunc(Col.G*percent/100);
  Col.R:=Trunc(Col.R*percent/100);
  Result:=col;
end;
 
function Lighter(Col: TTriple; Percent: Byte): TTriple;
begin
  Col.R := Round(Col.R*(Percent-1)/100) + Round(255 - Percent/100*255);
  Col.G := Round(Col.G*(Percent-1)/100) + Round(255 - Percent/100*255);
  Col.B := Round(Col.B*(Percent-1)/100) + Round(255 - Percent/100*255);
  Result := Col;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
type 
  TTablica=array [0..$FFFFFF] of TTriple;
  PTablica=^TTablica;
var
  I, J : Integer;
  P:PTablica;
  paleta:array[0..255]of TPaletteEntry;
  pal:PLogPalette;
  hpal:HPALETTE;
  kolor:TTriple;
begin
  Pic := TBitmap.Create;
  try
    Pic.Assign(Image1.Picture.Graphic);
    if Pic.PixelFormat=pf24bit then //jeżeli bez palety
      for I := 0 to Pic.Height-1 do begin
        P:=Pic.ScanLine[i];
        for J := 0 to Pic.Width-1 do
          P[j] := Darker(P[j], 50);
        end
    else begin //jeżeli z paletą
      GetPaletteEntries(Pic.Palette,0,255,paleta);
      GetMem(pal, sizeof(TLogPalette) + sizeof(TPaletteEntry) * 255);
      pal.palVersion := $300;
      pal.palNumEntries := 256;
      for i := 0 to 255 do
      begin
        kolor.R:=paleta[i].peRed;
        kolor.G:=paleta[i].peGreen;
        kolor.B:=paleta[i].peBlue;
        kolor:=Darker(kolor,50);
        pal.palPalEntry[i].peRed := kolor.R;
        pal.palPalEntry[i].peGreen :=kolor.G;
        pal.palPalEntry[i].peBlue :=kolor.B;
      end;
      hpal := CreatePalette(pal^);
      if hpal <> 0 then
        Pic.Palette := hpal;
      FreeMem(pal);
    end;
    Image1.Picture.Graphic := Pic;
  finally
    Pic.Free;
  end;
end;
 
end.
 


To właściwie wszystko :)

4 komentarze

sekcja2 2003-08-01 15:58

Na to samo wychodzi... :)

brodny 2003-05-07 09:19

Ciekawe, ciekawe...

KiteK 2003-04-28 15:36

Pochwalony! Adam, zdaje mi się iż w pierwszym przykładzie (nie sprawdzałem drugiego :P ), dokładniej w funkcji Darker jest błąd. Powinna ona tak wyglądać:

function TForm1.Darker(kol: TColor; Cot: Integer): TColor;
var
R, G, B: Byte;
begin
R := GetRValue(kol);
G := GetGValue(kol);
B := GetBValue(kol);
R := R - Round(R * (Cot / 100));
G := G - Round(G * (Cot / 100));
B := B - Round(B * (Cot / 100));
Result := RGB(R, G, B);

end;

(sorki za inne parametry :) ). Jeżeli chcemy przyciemniać O DANY PROCENT, trzeba od aktualnego koloru odjąć ten procent. :)

RedChiro 2007-06-08 11:32

Fajny Art :) ale w przypadku rozjasniania wychodziły mi dziwne kolory (w przypadku jasnych)
I dodalem taki warnek na końcu funkcji:

if r>255 then r:=255;
if g>255 then g:=255;
if b>255 then b:=255;

Wg mnie tak jest lepiej.
Pozdro :)