BitmapEffects.pas

File name
C:\Users\Andreas Rejbrand\Documents\Dev\rtesrc 3.1.2\BitmapEffects\BitmapEffects.pas
Date exported
Time exported
Formatting processor
TPascalFormattingProcessor
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.