How to mirror and rotate bitmaps (Views: 29)
Problem/Question/Abstract: How to mirror and rotate bitmaps Answer: {Turn off Range Checking because of ARRAY[0..0] construct below} {$R-} unit Bitmap; interface uses Windows, Graphics; procedure MirrorHorizontal(Bitmap: TBitmap); procedure MirrorVertical(Bitmap: TBitmap); procedure Rotate90Degrees(Bitmap: TBitmap); procedure Rotate270Degrees(Bitmap: TBitmap); procedure Rotate180Degrees(Bitmap: TBitmap); implementation uses dialogs, Classes, SysUtils; type EBitmapError = class(Exception); TRGBArray = array[0..0] of TRGBTriple; pRGBArray = ^TRGBArray; procedure MirrorHorizontal(Bitmap: TBitmap); var i, j, w: Integer; RowIn: pRGBArray; RowOut: pRGBArray; begin w := bitmap.width * sizeof(TRGBTriple); GetMem(rowin, w); for j := 0 to Bitmap.Height - 1 do begin move(Bitmap.Scanline[j]^, rowin^, w); rowout := Bitmap.Scanline[j]; for i := 0 to Bitmap.Width - 1 do rowout[i] := rowin[Bitmap.Width - 1 - i]; end; bitmap.Assign(bitmap); FreeMem(rowin); end; procedure MirrorVertical(Bitmap: TBitmap); var j, w: Integer; help: TBitmap; begin help := TBitmap.Create; help.Width := Bitmap.Width; help.Height := Bitmap.Height; help.PixelFormat := Bitmap.PixelFormat; w := Bitmap.Width * sizeof(TRGBTriple); for j := 0 to Bitmap.Height - 1 do move(Bitmap.Scanline[j]^, Help.Scanline[Bitmap.Height - 1 - j]^, w); Bitmap.Assign(help); help.free; end; type THelpRGB = packed record rgb: TRGBTriple; dummy: byte; end; procedure Rotate270Degrees(Bitmap: TBitmap); var aStream: TMemorystream; header: TBITMAPINFO; dc: hDC; P: ^THelpRGB; x, y, b, h: Integer; RowOut: pRGBArray; begin aStream := TMemoryStream.Create; aStream.SetSize(Bitmap.Height * Bitmap.Width * 4); with header.bmiHeader do begin biSize := SizeOf(TBITMAPINFOHEADER); biWidth := Bitmap.Width; biHeight := Bitmap.Height; biPlanes := 1; biBitCount := 32; biCompression := 0; biSizeimage := aStream.Size; biXPelsPerMeter := 1; biYPelsPerMeter := 1; biClrUsed := 0; biClrImportant := 0; end; dc := GetDC(0); P := aStream.Memory; GetDIBits(dc, Bitmap.Handle, 0, Bitmap.Height, P, header, dib_RGB_Colors); ReleaseDC(0, dc); b := bitmap.Height; {rotate} h := bitmap.Width; {rotate} bitmap.Width := b; bitmap.height := h; for y := 0 to (h - 1) do begin rowOut := Bitmap.ScanLine[(h - 1) - y]; P := aStream.Memory; {reset pointer} inc(p, y); for x := (b - 1) downto 0 do begin rowout[x] := p^.rgb; inc(p, h); end; end; aStream.Free; end; procedure Rotate90Degrees(Bitmap: TBitmap); var aStream: TMemorystream; header: TBITMAPINFO; dc: hDC; P: ^THelpRGB; x, y, b, h: Integer; RowOut: pRGBArray; begin aStream := TMemoryStream.Create; aStream.SetSize(Bitmap.Height * Bitmap.Width * 4); with header.bmiHeader do begin biSize := SizeOf(TBITMAPINFOHEADER); biWidth := Bitmap.Width; biHeight := Bitmap.Height; biPlanes := 1; biBitCount := 32; biCompression := 0; biSizeimage := aStream.Size; biXPelsPerMeter := 1; biYPelsPerMeter := 1; biClrUsed := 0; biClrImportant := 0; end; dc := GetDC(0); P := aStream.Memory; GetDIBits(dc, Bitmap.Handle, 0, Bitmap.Height, P, header, dib_RGB_Colors); ReleaseDC(0, dc); b := bitmap.Height; {rotate} h := bitmap.Width; {rotate} bitmap.Width := b; bitmap.height := h; for y := 0 to (h - 1) do begin rowOut := Bitmap.ScanLine[y]; P := aStream.Memory; {reset pointer} inc(p, y); for x := 0 to (b - 1) do begin rowout[x] := p^.rgb; inc(p, h); end; end; aStream.Free; end; procedure Rotate180Degrees(Bitmap: TBitmap); var i, j: Integer; rowIn: pRGBArray; rowOut: pRGBArray; help: TBitmap; begin help := TBitmap.Create; help.Width := Bitmap.Width; help.Height := Bitmap.Height; help.PixelFormat := Bitmap.PixelFormat; < {only pf24bit for now} for j := 0 to Bitmap.Height - 1 do begin rowIn := Bitmap.ScanLine[j]; rowOut := help.ScanLine[Bitmap.Height - j - 1]; for i := 0 to Bitmap.Width - 1 do rowOut[Bitmap.Width - i - 1] := rowIn[i] end; bitmap.assign(help); help.free; end; end. |