Bitmap - clareando e escurecendo bitmaps

Top  Previous  Next

// clareando e escurecendo bitmaps... use valores negativos para escurecer...

procedure WhiteWash(src: TBitmap; ARect : TRect; WhiteWashValue : integer = 128);

 

  function IntToByte(const I:Integer):Byte;

  begin

    if i > 255 then Result := 255

    else

      if i < 0 then

        Result:= 0

      else

        Result:= i;

  end;

 

  function GetPixel(const x,y : integer) : pRGBTriple;

  var

    line: pbytearray;

  begin

    line   := src.ScanLine[y];

    result := @line[x*3];

  end;

 

var

  x,y: integer;

begin

  src.PixelFormat:= pf24bit;

  if ARect.Top    < 0 then exit;

  if ARect.left   < 0 then exit;

  if ARect.bottom > src.Height then exit;

  if ARect.right  > src.Width  then exit;

 

  for y := ARect.top to ARect.bottom-1  do

    for x := ARect.left to Arect.right-1 do

    begin

      getpixel(x,y).rgbtRed   := IntToByte(WhiteWashValue + getpixel(x,y).rgbtRed   );

      getpixel(x,y).rgbtGreen := IntToByte(WhiteWashValue + getpixel(x,y).rgbtGreen );

      getpixel(x,y).rgbtBlue  := IntToByte(WhiteWashValue + getpixel(x,y).rgbtBlue  );

    end;

end;

 

procedure TForm1.Button1Click(Sender: TObject);

var

  A: TRect;

begin

   A.Left := 0;

   A.Top  := 0;

   A.Bottom := Image1.Height;

   A.Right  := Image1.Width;

   WhiteWash(Image1.Picture.Bitmap, A, -58);

end;