Everyone who uses Delphi and Bitmaps should have at least heard about scanlines, and in particularly efg’s pages on the topic. In short:
The ScanLine property, new in Delphi 3, allows quick access to individual pixels, but you must know what PixelFormat you're working with before you can access the pixels correctly.
Because I almost always work with 24bit bitmaps, I didn’t adapt the code for other pixel formats, but it should really just be editing the “procedure AutoCropBitmap(InputBitmap, OutputBitmap: TBitmap; iBleeding : Integer; BackColor: TColor);” overload to start the right sub functions for each pixel format.
The current function will always translate it to an 24bit bitmap, which can be a processor and memory heavy job, the advise is therefor directly after creating the bitmap set the PixelFormat to pf24bit.
You might notice the overloads, well thats just one part of me being lazy again, sometimes I haven’t got the time to create an extra variable and assign the property’s etc. The overloads allow the choice of which input and output you’ll like.
unit unBitmapCropping;
interface
uses
Windows, Graphics, Dialogs, SysUtils, Math, Classes;
const
PixelCountMax = 32768;
type
pRGBArray = ^TRGBArray;
TRGBArray = array[0..PixelCountMax-1] of TRGBTriple;
procedure AutoCropBitmap(InputBitmap, OutputBitmap: TBitmap; iBleeding : Integer); overload;
procedure AutoCropBitmap(InputBitmap, OutputBitmap: TBitmap; iBleeding : Integer; BackColor: TColor); overload;
procedure AutoCropBitmap(BitMapToCrop: TBitmap; iBleeding : Integer); overload;
procedure AutoCropBitmap(BitMapToCrop: TBitmap; iBleeding : Integer; BackColor: TColor); overload;
procedure AutoCropBmp(const sFileName : String; iBleeding : Integer); overload;
procedure AutoCropBmp(const sFileName : String; iBleeding : Integer; BackColor: TColor); overload;
implementation
procedure AutoCropBitmap(BitMapToCrop: TBitmap; iBleeding : Integer);
var bmpTmp : TBitmap;
begin
bmpTmp := TBitmap.Create;
try
AutoCropBitmap(BitMapToCrop,bmpTmp,iBleeding);
BitMapToCrop.Assign(bmpTmp);
finally
bmpTmp.Free;
end;
end;
procedure AutoCropBitmap(BitMapToCrop: TBitmap; iBleeding : Integer; BackColor: TColor);
var bmpTmp : TBitmap;
begin
bmpTmp := TBitmap.Create;
try
AutoCropBitmap(BitMapToCrop,bmpTmp,iBleeding, BackColor);
BitMapToCrop.Assign(bmpTmp);
finally
bmpTmp.Free;
end;
end;
procedure AutoCropBitmap(InputBitmap, OutputBitmap: TBitmap; iBleeding : Integer);
begin
AutoCropBitmap(InputBitmap,OutputBitmap, iBleeding, InputBitmap.Canvas.Pixels[0,0]);
end;
procedure AutoCropBitmap(InputBitmap, OutputBitmap: TBitmap; iBleeding : Integer; BackColor: TColor);
var Row : pRGBArray;
MyTop, MyBottom, MyLeft,
i, j, MyRight : Integer;
begin
MyTop := InputBitmap.Height;
MyLeft := InputBitmap.Width;
MyBottom := 0;
MyRight := 0;
InputBitmap.PixelFormat := pf24bit;
OutputBitmap.PixelFormat := pf24Bit;
{ Find Top }
for j := 0 to InputBitmap.Height-1 do
begin
if j > MyTop then
Break;
Row := pRGBArray(InputBitmap.Scanline[j]);
for i:= InputBitmap.Width - 1 downto 0 do
if ((Row[i].rgbtRed <> GetRvalue(BackColor)) or
(Row[i].rgbtGreen <> GetGvalue(BackColor)) or
(Row[i].rgbtBlue <> GetBvalue(BackColor))) then
begin
MyTop := j;
Break;
end;
end;
if MyTop = InputBitmap.Height then
{ Empty Bitmap }
MyTop := 0;
{ Find Bottom }
for j := InputBitmap.Height-1 Downto MyTop do
begin
if (j + 1) < MyBottom then
Break;
Row := pRGBArray(InputBitmap.Scanline[j]);
for i:= InputBitmap.Width - 1 downto 0 do
if ((Row[i].rgbtRed <> GetRvalue(BackColor)) or
(Row[i].rgbtGreen <> GetGvalue(BackColor)) or
(Row[i].rgbtBlue <> GetBvalue(BackColor))) then
begin
MyBottom := j+1;
Break;
end;
end;
{ Find Left }
for j := MyTop to MyBottom-1 do
begin
Row := pRGBArray(InputBitmap.Scanline[j]);
for i:= 0 to MyLeft-1 do
if ((Row[i].rgbtRed <> GetRvalue(BackColor)) or
(Row[i].rgbtGreen <> GetGvalue(BackColor)) or
(Row[i].rgbtBlue <> GetBvalue(BackColor))) then
begin
MyLeft := i;
Break;
end;
end;
if MyLeft = InputBitmap.Width then
{ Empty Bitmap }
MyLeft := 0;
{ Find Right }
for j := MyTop to MyBottom -1 do
begin
Row := pRGBArray(InputBitmap.Scanline[j]);
for i:= InputBitmap.Width-1 downto MyRight do
if ((Row[i].rgbtRed <> GetRvalue(BackColor)) or
(Row[i].rgbtGreen <> GetGvalue(BackColor)) or
(Row[i].rgbtBlue <> GetBvalue(BackColor))) then
begin
MyRight := i+1;
Break;
end;
end;
if (MyRight = 0) or (MyBottom = 0) then
{ Empty Bitmap }
iBleeding := 0;
OutputBitmap.Width := MyRight - MyLeft + (iBleeding * 2);
OutputBitmap.Height := MyBottom - MyTop + (iBleeding * 2);
OutputBitmap.Canvas.Brush.Color := BackColor;
OutputBitmap.Canvas.FillRect(Rect(0,0,OutputBitmap.Width,OutputBitmap.Height));
BitBlt(OutputBitmap.canvas.Handle, -MyLeft + iBleeding,
-MyTop + iBleeding,MyLeft + MyRight,MyTop + MyBottom,
InputBitmap.Canvas.Handle, 0, 0, SRCCOPY);
end;
procedure AutoCropBmp(const sFileName : String; iBleeding : Integer);
var InputBitmap, OutputBitmap : TBitmap;
begin
if not FileExists(sFileName) then
raise Exception.Create('File doesn''s exists.');
InputBitmap := TBitmap.Create;
OutputBitmap := TBitmap.Create;
try
InputBitmap.LoadFromFile(sFileName);
OutputBitmap.PixelFormat := InputBitmap.PixelFormat;
AutoCropBitmap(InputBitmap, OutputBitmap,iBleeding);
OutputBitmap.SaveToFile(sFileName);
finally
OutputBitmap.Free;
InputBitmap.Free;
end;
end;
procedure AutoCropBmp(const sFileName : String; iBleeding : Integer; BackColor: TColor);
var InputBitmap, OutputBitmap : TBitmap;
begin
if not FileExists(sFileName) then
raise Exception.Create('File doesn''s exists.');
InputBitmap := TBitmap.Create;
OutputBitmap := TBitmap.Create;
try
InputBitmap.LoadFromFile(sFileName);
OutputBitmap.PixelFormat := InputBitmap.PixelFormat;
AutoCropBitmap(InputBitmap, OutputBitmap,iBleeding, BackColor);
OutputBitmap.SaveToFile(sFileName);
finally
OutputBitmap.Free;
InputBitmap.Free;
end;
end;
end.
I started off with an example found on efg’s site, and started optimizing it’s algorithm:
- Dismissed the Temp variables and the counter variable.
- Making the loops downto 0 as many as possible (this will make the loop slightly faster).
- Making sure no extra round on the loop is used (adding breaks).
- Decreasing the number of core operations (removing if’s)
With this I created a >400% speed gain.
Writing this article, I got the following ideas for a little more speedup:
- Storing the GetXvalue results, as to decrease the recalculation in each for loop.
- Maybe running loops for 0 till the end will make it faster because of better page alignment
But I will try that out an other time.