unit BitmapEffects; interface uses Windows, SysUtils, Types, Classes, Controls, Graphics; type TBitmapEffect = (beNone, beGrayscale, beInvert, bePixelWhite, bePixelBlack); const BitmapEffectsNames: array[TBitmapEffect] of string = ('None', 'Grayscale', 'Invert', 'Add white pixels', 'Add black pixels'); procedure BitmapEffect(ABitmap: TBitmap; AEffect: TBitmapEffect); overload; procedure BitmapEffect(AControl: TControl; ACanvas: TCanvas; AEffect: TBitmapEffect); overload; procedure BitmapEffect(AControl: TControl; ACanvas: TCanvas; const ARect: TRect; AEffect: TBitmapEffect); overload; implementation uses RColors; procedure BitmapEffect(ABitmap: TBitmap; AEffect: TBitmapEffect); type PRGBTripleArray = ^TRGBTripleArray; TRGBTripleArray = array[word] of TRGBTriple; var SL: PRGBTripleArray; y: Integer; x: Integer; begin if AEffect = beNone then Exit; ABitmap.PixelFormat := pf24bit; for y := 0 to ABitmap.Height - 1 do begin SL := ABitmap.ScanLine[y]; for x := 0 to ABitmap.Width - 1 do with SL[x] do case AEffect of beGrayscale: FillChar(rgbtBlue, 3, (rgbtBlue + rgbtGreen + rgbtRed) div 3); beInvert: begin rgbtRed := 255 - rgbtRed; rgbtGreen := 255 - rgbtGreen; rgbtBlue := 255 - rgbtBlue; end; bePixelWhite: if Odd(x) xor Odd(y) then SL[x] := RGBToRGBTriple(RGB(1, 1, 1)); bePixelBlack: if Odd(x) xor Odd(y) then SL[x] := RGBToRGBTriple(RGB(0, 0, 0)); end; end; end; procedure BitmapEffect(AControl: TControl; ACanvas: TCanvas; AEffect: TBitmapEffect); begin BitmapEffect(AControl, ACanvas, AControl.ClientRect, AEffect); end; procedure BitmapEffect(AControl: TControl; ACanvas: TCanvas; const ARect: TRect; AEffect: TBitmapEffect); overload; var bm: TBitmap; begin if AEffect = beNone then Exit; bm := TBitmap.Create; try bm.SetSize(RectWidth(ARect), RectHeight(ARect)); BitBlt(bm.Canvas.Handle, 0, 0, bm.Width, bm.Height, ACanvas.Handle, ARect.Left, ARect.Top, SRCCOPY); BitmapEffect(bm, AEffect); BitBlt(ACanvas.Handle, ARect.Left, ARect.Top, bm.Width, bm.Height, bm.Canvas.Handle, 0, 0, SRCCOPY); finally bm.Free; end; end; end.