Various image XOR effects

Problem/Question/Abstract:

Various image XOR effects

Answer:

Solve 1:

Create a new application, add a button to the form, and add the following code for the button's OnClick event:

{ ... }
var
  bih: TBitmapInfo;
  i, j: Byte;
  ptrBits, ptrTemp: Pointer;
begin
  {Initialise BITMAPINFO structure}
  ZeroMemory(@bih, SizeOf(bih));
  with bih.bmiHeader do
  begin
    biSize := SizeOf(TBitmapInfoHeader);
    biWidth := 256;
    biHeight := 256;
    biPlanes := 1;
    biBitCount := 24;
    biSizeImage := 256 * 256 * 3;
  end;
  {Allocate memory for pixel data}
  ptrBits := GlobalAllocPtr(GMEM_FIXED or GMEM_ZEROINIT, 256 * 256 * 3);
  try
    ptrTemp := ptrBits;
    {Manipulate pixels using XOR operator}
    for j := 0 to 255 do
    begin
      for i := 0 to 255 do
      begin
        PByte(ptrTemp)^ := i xor j; {Blue component}
        Inc(PByte(ptrTemp));
        PByte(ptrTemp)^ := i xor j; {Green component}
        Inc(PByte(ptrTemp));
        PByte(ptrTemp)^ := i xor j; {Red component}
        Inc(PByte(ptrTemp));
      end;
    end;
    {Draw to screen}
    StretchDIBits(Canvas.Handle, 0, 255, 256, -256, 0, 0, 256, 256,
      ptrBits, bih, DIB_RGB_COLORS, SRCCOPY);
  finally
    GlobalFreePtr(ptrBits);
  end;
end;


Solve 2:

Mark, this was a very interesting effect. I first tried your code in a FormCreate but saw nothing. Your code works fine from a ButtonClick method, but will need to be moved to an OnPaint for persistence.

Code using Scanline in my opinion is easier to understand - and like your code will also work in D3 - D6:

procedure TFormXOReffect.ButtonScanlineMethodClick(Sender: TObject);
type
  TRGBTripleArray = array[Word] of TRGBTriple;
  pRGBTripleArray = ^TRGBTripleArray;
var
  Bitmap: TBitmap;
  i: Byte;
  j: Byte;
  row: pRGBTripleArray;
begin
  Bitmap := TBitmap.Create;
  try
    Bitmap.Width := 256;
    Bitmap.Height := 256;
    Bitmap.PixelFormat := pf24bit;
    for j := 0 to 255 do
    begin
      row := Bitmap.Scanline[j];
      for i := 0 to 255 do
      begin
        row[i].rgbtBlue := i xor j;
        row[i].rgbtGreen := i xor j;
        row[i].rgbtRed := i xor j
      end;
    end;
    {Display in 256-by-256 TImage}
    Image1.Picture.Graphic := Bitmap
  finally
    Bitmap.Free
  end;
end;


Solve 3:

I played around with it for a few minutes and came up with a very subtle gradient effect:

{ ... }
  {Shade}
Bmp.Canvas.Brush.Color := clBlack;
Bmp.Canvas.FillRect(Rect(0, 0, Bmp.Width - 1, Bmp.Height - 1));
for j := 0 to Bmp.Height - 1 do
begin
  row := Bmp.Scanline[j];
  for i := 0 to Bmp.Width - 1 do
  begin
    row[i].rgbtBlue := row[i].rgbtBlue xor j;
    row[i].rgbtGreen := row[i].rgbtGreen xor j;
    row[i].rgbtRed := row[i].rgbtRed xor j
  end;
end;
{ ... }

if you change 1 or 2 of the xor j's to XOR i, then it does another nice gradient effect.:

begin
  row[i].rgbtBlue := row[i].rgbtBlue xor i;
  row[i].rgbtGreen := row[i].rgbtGreen xor i;
  row[i].rgbtRed := row[i].rgbtRed xor j
end;


Solve 4:

I like that one, too. And if you add ...

{ ... }
  {now gray scale it}
row[i].rgbtRed := (row[i].rgbtRed + Row[i].rgbtGreen + row[i].rgbtBlue) div 3;
row[i].rgbtGreen := row[i].rgbtRed;
row[i].rgbtBlue := row[i].rgbtRed;

... you get a nice metalic look.