Various image XOR effects (Views: 27)
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. |