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 :)