This post was migrated from my old blog delphi-snippets.blogspot.com, for explanation about this switch see my introduction post. I have created a lot of program’s which needed to do some operations on Bitmaps, most of them are pretty simple, but recently I needed some auto cropping due to the fact I could not calculate the width and height without a lot of calculation, but the maximum could easily be calculated/estimated, therefor I needed an algorithm for cropping these bitmap automatically.

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.

Tags: delphi