Solved

# Intelligently crop a scanned image

Posted on 2010-09-15
561 Views
I've managed to talk to my scanner and pull in an image, in this case it will be ID cards or passports etc,
but now I need to crop away the background of the scan (which is white or black).
It doesn't need to be a perfect crop, in fact I think it will be a 'suggested crop' and the user can check if it's right and approve it.
0
Question by:rfwoolf

LVL 24

Assisted Solution

jimyX earned 75 total points
ID: 33684420
I am not sure if there is a way that makes you able to detect the white or dark space in a scanned image, but I have another idea which is by matching between a blank scanning and the target scanning you will get the difference highlight, i.e: you can create a standard stored image of the scanner (blank scanning), and whenever you want to make a scan just match between the stored image and the new scanned image and then by detecting the difference between them you can have your target area highlighted. I did not try this with scanner but theoretically it should work.

Again from efg Lab:
``````function Min(a, b: Longint): Longint;
begin
if a > b then
Result := b
else
Result := a;
end;

function Max(a, b: Longint): Longint;
begin
if a > b then
Result := a
else
Result := b;
end;

function ScanImages(previous:TBitmap;current:TBitmap;var Changed:TRect):Boolean;
var
ix, iy, idiff : INTEGER;
minx, maxx, miny, maxy : INTEGER;
tempPixel1, tempPixel2 : TColor;

function ProbablyNoise (xPos, yPos : INTEGER) : BOOLEAN;
const
noiseThreshhold = 3;
var
jx, jy : INTEGER;
nDiff : INTEGER;
nearPixel1, nearPixel2 : TColor;
begin
nDiff := 0;
for jx := Max(0,xPos-2) to Min(xPos+2,Form1.Blank.Width) do
begin
for jy := Max(0,yPos-2) to Min(yPos+2,Form1.Blank.Height) do
begin
nearPixel1 := Form1.Blank.Canvas.Pixels[jx,jy];
nearPixel2 := Form1.ScannedImage.Canvas.Pixels[jx,jy];
if (nearPixel1 <> nearPixel2) then
INC(nDiff);
end {FOR};
end {FOR};
if nDiff > noiseThreshhold then
result := false
else result := true;
end {ProbablyNoise};

begin
//  RESULT :=  FALSE;
{ Make sure they are the same shape }
if (previous.Height <> current.Height)or(previous.Width  <> current.Width) then
begin
RESULT := FALSE;
EXIT;
end {IF};

{ We'll work with the pixels because we want to bounding TRect }
minx := previous.Width; maxx := -1;
miny := previous.Height; maxy := -1;
iDiff := 0;
for iy := 0 to previous.Height-1 do
begin
for ix := 0 to previous.Width-1 do
begin
tempPixel1 := previous.Canvas.Pixels[ix,iy];
tempPixel2 := current.Canvas.Pixels[ix,iy];
if (tempPixel1 <> tempPixel2) and not ProbablyNoise(ix,iy) then
begin
inc(iDiff);
minx := Min(minx,ix);
maxx := Max(maxx,ix);
miny := Min(miny,iy);
maxy := Max(maxy,iy);
end {IF};
end {FOR};
end {FOR};
if (iDiff <= 0) then
RESULT := FALSE
else
begin
result := TRUE;
Changed.Left := minx;
Changed.Right := maxx;
Changed.Top := miny;
Changed.Bottom := maxy;
end {IF};
end {ScanImages};

procedure TForm1.Button1Click(Sender: TObject);
var
A:TRect;
begin
if ScanImages(Blank.Picture.Bitmap, ScannedImage.Picture.Bitmap,A) then
begin
ScannedImage.Canvas.DrawFocusRect(A);
end;
end;
``````
0

LVL 25

Accepted Solution

epasquier earned 425 total points
ID: 33684897
Here is a matching color function based on the RGB value, with a tolerance value
That tolerance value is the maximum "distance"
``````function ColorMatch(C1,C2:TColor;Tolerance:Single):Boolean;

Var

R1,B1,C1:Byte;

R2,B2,C2:Byte;

begin

C1:=ColorToRGB(C1);

R1:=C1 And \$FF;

G1:=(C1 SHR 8)And \$FF;

B1:=(C1 SHR 16) And \$FF;

C2:=ColorToRGB(C2);

R2:=C2 And \$FF;

G2:=(C2 SHR 8)And \$FF;

B2:=(C2 SHR 16) And \$FF;

Result:= Sqrt(sqr(R1-R2)+ (sqr(G1-G2)+(sqr(B1-B2))<=Tolerance;

end;
``````
0

## Featured Post

Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…
This video shows how to remove a single email address from the Outlook 2010 Auto Suggestion memory. NOTE: For Outlook 2016 and 2013 perform the exact same steps. Open a new email: Click the New email button in Outlook. Start typing the address: …