Solved

delphi grachics, How to get the value of the edges

Posted on 2010-11-29
22
545 Views
Last Modified: 2012-05-10
Question connected from this link;
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_26642735.html
Answered by ThievingSix;

hi
Wanna get the value from top, left and right,   assuming that the RED line is not there.
 first last top left right line of image
0
Comment
Question by:systan
  • 12
  • 9
22 Comments
 
LVL 25

Expert Comment

by:epasquier
ID: 34237608
let me rephrase : you want to be able to crop your image to the most probable frame containing the face.
You will want also the bottom line, the one above the shoulders.
So the input of the function is a grayscaled bitmap, and the output is a TRect, defined by :
- above the shoulders
- all the head is contained (a few hairs could be cut)
0
 
LVL 25

Expert Comment

by:epasquier
ID: 34237814
the idea would be create an algo that detects line/column density changes and using a threshold value, will detect the shoulder line and the frame around the head.

can you post here the original image so that we can play ?
(aside question : is that your picture?)
0
 
LVL 8

Expert Comment

by:lomo74
ID: 34237966
have a look at OpenCV project.
I worked with it years ago, I had to detect two holes into a piece to detect alignment, image was acquired by firewire camera --
it is written in C but has many language bindings - maybe Delphi too.
it is trivial, anyway, to translate C headers to Delphi syntax. tha hard task here is face detection.
anyway OpenCV also has face detection algorithms, I doubt that they would work on a b/w image like that though -
0
 
LVL 14

Author Comment

by:systan
ID: 34238700
I know open cv and a lot of samples, but there's no stable version for delphi.
Let us do this in our own way, not using open cv.

Oh, hi epasquier
>>let me rephrase : you want to be able to crop your image to the most probable frame containing the face.
YES

>>You will want also the bottom line, the one above the shoulders.
NO, on the chin only, BUT if can be done, why not also

>>So the input of the function is a grayscaled bitmap, and the output is a TRect, defined by :
- above the shoulders
- all the head is contained (a few hairs could be cut)
I'm not sure what to answer

>>the idea would be create an algo that detects line/column density changes and using a threshold value, will detect the shoulder line and the frame around the head.
Yes
can you post here the original image so that we can play ? NO, sorry
(aside question : is that your picture?) yes and no

Ok;
Original background of the curtain is Red, when pictured?, Red and dots(its normal)
here's what I did, I convert the colored picture to monochrome gray-scale, then soften to 2x2x2, then here's the result;
 mypic2As you can see the background now is Real White

Detecting from White to another/any color is the point here, so when it scans from white to another/any color?, it means, its the beginning of the point.  Well scan from top, left, right.
How will we do that?
0
 
LVL 25

Expert Comment

by:epasquier
ID: 34239194
When I said the original picture, I was more talking about the reversed grayscaled picture in your question without the red frame and comments, not your original picture before any transformation. Even if you seem pretty enough to indulge your picture being posted here ;)

I have worked on the basis you are able to produce such a cleaned image with "white" dots containing information. I suppose we could work on that second kind of picture you just posted by adapting some of the code.

Before I post the code, here is the screenshot of the resulting app I've made. Tell me if that could be what you are looking for
DetectHead.gif
0
 
LVL 14

Author Comment

by:systan
ID: 34239337
Actually I based on this link;
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_20913287.html

epasquier, I think you got it, the problem is how to determined the values from top left right, how do we get the fix area that I want?
I think this is the steps;
get the area of x and y, and top, and down
remove area from top, remove area from right, remove area left, remove area down

This is the exact angle(the picture
 thanksforthecomplement goodhead
0
 
LVL 25

Expert Comment

by:epasquier
ID: 34239715
as you can see (green rectangle), the application is able to detect the frame around the head. After that, a simple crop could be applied to get only the image inside.

It does so by first preparing 2 images called vertical-scan and horizontal-scan, which represent the "amount of relevant information" in a zone, which is for one of the image more precise on the line, and on the column for the other. They are a good midway step that allows quicker detection of the lines we want.

For example, to detect the "shoulder line", I use the vertical-scan (first small image),
a) for the 1/4 bottom lines I find what is the minimum line width of this set (width=line width triming black pixels on each side). That detects the minimum width of your neck, or of your hairs around it in your case.
b) I find from bottom to top the first line which width is <=5/4 (+25%) of this minimum width.

Obviously 5/4 is a parameter, it will give different results with say +50% or the mean between Min Width and Max Width (original picture width).
Same goes with the "grids" resolution that can be changed, and the color & density thresholds that I use to create the scan pictures.

I do the same to detect the top of your head, but from top to first quarter of image

Then I use the other scan image (better resolution on X axis) to detect the sides of your head.

And here I trace the green rectangle with those detected lines.

I tried the same algo on your second image (I just inverted it before), and it works equally well. I have tried different parameters, it is just a matter of getting the right ones which will give the best results with a wide range of images.
DetectHead2.gif
0
 
LVL 25

Expert Comment

by:epasquier
ID: 34239834
Here is the code.
type

  TLogPal = record

   lpal : TLogPalette;

   colorSpace : Array[1..255] of TPaletteEntry; // This allocate room to

                                                 // new palette colors

                                                 // since palPalEntry member of

                                                 // TLogPalette is declared as

                                                 // Array [0..0] of TPaletteEntry

   Created:Boolean;

  end;



Var Pal:TLogPal;



function CreateGreyscaleBMP:TBitmap;

Var

 i:integer;

begin

 if Not Pal.Created then

  begin

   // Create a 256 gray-scale palette

   Pal.lpal.palVersion:=$300;

   Pal.lpal.palNumEntries := 256;

   for i := 0 to 255 do with pal.lpal.palPalEntry[i] do

    begin

     peRed := i;

     peGreen := i;

     peBlue := i;

    end;

   Pal.Created:=True;

  end;

 Result := TBitmap.Create;

 Result.PixelFormat := pf8bit;

 Result.Palette := CreatePalette(pal.lpal);

end;



function DensityToColor(D:Cardinal):Byte;

begin

 if D>255 then Result:=255 Else Result:=D;

end;



procedure ScanGrid(BMP:TBitmap;GridNb,GridWidth,ColorThreshold,DensityThreshold:Integer;Var VertGrid,HorzGrid:TBitmap);

Var

 X,Y,CW,DX,DY,Ofs,DA,D:integer;

 TempArray:Array of Byte;

 ScanLine:pByteArray;

begin

 HorzGrid:=CreateGreyscaleBMP;

 HorzGrid.Width:=GridNb;

 HorzGrid.Height:=(BMP.Height+GridWidth-1) Div GridWidth;

 VertGrid:=CreateGreyscaleBMP;

 VertGrid.Width:=(BMP.Width+GridWidth-1) Div GridWidth;

 VertGrid.Height:=GridNb;

 ColorThreshold:=ColorThreshold*256 Div 100;



 SetLength(TempArray,HorzGrid.Width*HorzGrid.Height);

 FillChar(TempArray[0],Length(TempArray),0);

 CW:=(BMP.Width+GridNb-1) Div GridNb;

 for Y := 0 to BMP.Height - 1 do

  begin

   ScanLine:=BMP.ScanLine[Y];

   DY:=Y Div GridWidth;

   Ofs:=DY*HorzGrid.Width;

   for X := 0 to BMP.Width - 1 do

    begin

     DX:=X Div CW;

     if ScanLine^[X]>ColorThreshold

      Then Inc(TempArray[Ofs+DX]);

    end;

  end;

 Ofs:=0;

 DA:=CW*GridWidth;//Div 128;

 for Y := 0 to HorzGrid.Height-1 do

  begin

   ScanLine:=HorzGrid.ScanLine[Y];

   for X := 0 to HorzGrid.Width-1 do

    begin

     D:=TempArray[Ofs]*128;

     if D>=DA*DensityThreshold

      then ScanLine^[X]:=DensityToColor(D*8 Div DA)

      Else ScanLine^[X]:=0;

     Inc(Ofs);

    end;

  end;



 SetLength(TempArray,VertGrid.Width*VertGrid.Height);

 FillChar(TempArray[0],Length(TempArray),0);

 CW:=(BMP.Height+GridNb-1) Div GridNb;

 for Y := 0 to BMP.Height - 1 do

  begin

   ScanLine:=BMP.ScanLine[Y];

   DY:=Y Div CW;

   Ofs:=DY*VertGrid.Width;

   for X := 0 to BMP.Width - 1 do

    begin

     DX:=X Div GridWidth;

     if ScanLine^[X]>ColorThreshold

      Then Inc(TempArray[Ofs+DX]);

    end;

  end;

 Ofs:=0;

 DA:=CW*GridWidth;//Div 128;

 for Y := 0 to VertGrid.Height-1 do

  begin

   ScanLine:=VertGrid.ScanLine[Y];

   for X := 0 to VertGrid.Width-1 do

    begin

     D:=TempArray[Ofs]*128;

     if D>=DA*DensityThreshold

      then ScanLine^[X]:=DensityToColor(D*8 Div DA)

      Else ScanLine^[X]:=0;

     Inc(Ofs);

    end;

  end;

end;



function DetectMinLine(BMP:TBitmap;ScanFrom,ScanTo:Integer):Integer;

Var

 X,X1,X2,Y:Integer;

 ScanLine:pByteArray;

 LoopStep,MinW:Integer;

 HeadWidth:Array of Integer;

 Last:Boolean;

begin

 MinW:=BMP.Width;

 SetLength(HeadWidth,BMP.Height);

 Y:=ScanFrom;

 if ScanFrom<ScanTo Then LoopStep:=1 Else LoopStep:=-1;

 Repeat

  Last:=Y=ScanTo;

  ScanLine:=BMP.ScanLine[Y];

  X1:=-1;

  X2:=-1;

  for X := 0 to BMP.Width Div 2-1 do

   begin

    if (X1<0) And (ScanLine^[X]>0) then X1:=X;

    if (X2<0) And (ScanLine^[BMP.Width-1-X]>0) then X2:=BMP.Width-1-X;

    if (X1>=0) And (X2>=0) then break;

   end;

  if X1<0 then X1:=0;

  if X2<0 then X2:=BMP.Width-1;

  HeadWidth[Y]:=X2-X1+1;

  if HeadWidth[Y]<MinW then MinW:=HeadWidth[Y];

  Y:=Y+LoopStep;

 Until Last;

 Y:=ScanFrom;

 MinW:=MinW*5 Div 4; // +25%

 Repeat

  Last:=Y=ScanTo;

  if HeadWidth[Y]<=MinW then

   begin

    Result:=Y;

    Exit;

   end;

  Y:=Y+LoopStep;

 Until Last;

end;



function DetectNonEmptyCol(BMP:TBitmap;ScanFrom,ScanTo,Y1,Y2:Integer):Integer;

Var

 LoopStep,X,Y:Integer;

begin

 if ScanFrom<ScanTo Then LoopStep:=1 Else LoopStep:=-1;

 X:=ScanFrom;

 Repeat

  for Y := Y1 to Y2 do if pByteArray(BMP.ScanLine[Y])^[X]>0 then

   begin

    Result:=X;

    Exit;

   end;

  X:=X+LoopStep;

 Until False;

end;



procedure TfrmHeadFrame.btnOkClick(Sender: TObject);

Var

 Frame:TRect;

 VertGrid,HorzGrid:TBitmap;

begin

 ScanGrid(Image.Picture.Bitmap,seNbZone.Value,seZoneWidth.Value,seColorThreshold.Value,seDensityThreshold.Value,VertGrid,HorzGrid);

 pnlGrid.Width:=Image.Picture.Bitmap.Height Div 2+16;

 imgHorzScan.Picture.Assign(HorzGrid);

 imgHorzScan.Width:=Image.Picture.Bitmap.Width Div 2;// HorzGrid.Height;

 imgHorzScan.Height:=Image.Picture.Bitmap.Height Div 2;

 imgVertScan.Top:=imgHorzScan.Top+imgHorzScan.Height+8;

 imgVertScan.Picture.Assign(VertGrid);

 imgVertScan.Width:=imgHorzScan.Width;

 imgVertScan.Height:=imgHorzScan.Height;

 shpFrame.Top:=DetectMinLine(HorzGrid,0,HorzGrid.Height Div 4)*seZoneWidth.Value+seZoneWidth.Value Div 2;

 shpFrame.Height:=DetectMinLine(HorzGrid,HorzGrid.Height-1,HorzGrid.Height-HorzGrid.Height Div 4)*seZoneWidth.Value+seZoneWidth.Value Div 2-shpFrame.Top;

 shpFrame.Left:=DetectNonEmptyCol(VertGrid,

     0,imgVertScan.Width Div 4,

     shpFrame.Top*5*VertGrid.Height Div (4*Image.Picture.Bitmap.Height),

     shpFrame.BoundsRect.Bottom*3*VertGrid.Height Div (4*Image.Picture.Bitmap.Height)

   )*seZoneWidth.Value+seZoneWidth.Value Div 2;

 shpFrame.Width:=DetectNonEmptyCol(VertGrid,

     VertGrid.Width-1,VertGrid.Width-VertGrid.Width Div 4,

     shpFrame.BoundsRect.Top*5*VertGrid.Height Div (4*Image.Picture.Bitmap.Height),

     shpFrame.BoundsRect.Bottom*3*VertGrid.Height Div (4*Image.Picture.Bitmap.Height)

   )*seZoneWidth.Value+seZoneWidth.Value Div 2-shpFrame.Left;

 shpFrame.Visible:=True;

end;



function ConvertGreyScale(Var BMP:TBitmap):TBitmap;

begin

 Result:=CreateGreyscaleBMP;

 Result.Width:=BMP.Width;

 Result.Height:=BMP.Height;

 Result.Canvas.Draw(0,0,BMP);

 BMP.Free;

 BMP:=Result;

end;



procedure TfrmHeadFrame.edtBMPNameChange(Sender: TObject);

Var

 BMP:TBitmap;

begin

 if FileExists(edtBMPName.FileName) then

  begin

   BMP:=CreateGreyscaleBMP;

   BMP.LoadFromFile(edtBMPName.FileName);

   Image.Picture.Assign(ConvertGreyScale(BMP));

   BMP.Free;

  end;

end;

Open in new window

0
 
LVL 14

Author Comment

by:systan
ID: 34239867
when crop it looks like this; only;
 yeeBut include the crop of the green line so, no green will be seen
Its good, but you got to share that code, and since your a true delphi genius, I hope you let it go.
I can wait in my box.


Thanks
The only problem for me is the complete understanding of how that works, seems I'm not a Delphi genius, I have too study everything that you wrote, including the link I pointed.
0
 
LVL 14

Author Comment

by:systan
ID: 34239908
Oh,
You got the code attached, please attach a file together with the dpr,pas and dfm, maybe a zip will do.

Thanks
Points increase.
0
 
LVL 25

Expert Comment

by:epasquier
ID: 34240159
Here you are.

I know it's a bit complex to get from the detailed code, it's full of math calculations. But don't bother too much, if you understood the principles I explained and conclude that it is what you need, then take the algorithm as it is, play with the parameters to see how it impacts the result, and fix those for your application when you found some that works as you wish with all images.

I wish you happy code reading ;o)
DetectHead.zip
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 14

Author Comment

by:systan
ID: 34241201
Ok;

epasquier;
I test some images, why is not doing the right way
whew, can you just include the code the way you got it from turning it from colored to monochrome/gray-scale, then to the exact square that I want, please, it seems I have a problem in my code from turning it to monochrome/gray-scale/black&white.
0
 
LVL 14

Author Comment

by:systan
ID: 34242360
Hey, I got it now, I used the black and white,  But why it only gets a black background?  
in White background it does not?
Wheres the problem of the code?

orig;
 z0
good result; (with black background) with dark background color
 z1
bad result,
what if the background is a light color, so the result is white background;
 z2
0
 
LVL 14

Author Comment

by:systan
ID: 34258062
epasquier?, are you listening?
0
 
LVL 14

Author Comment

by:systan
ID: 34259514
epasquier,  would you finish what you've started, please
the problem only gets the black background, but on white it doesn't.


Thanks
0
 
LVL 25

Expert Comment

by:epasquier
ID: 34259710
of course it does not work on white background, the algo suppose that white pixels (or grey) are relevant.
You have to normalize the picture so that the background is black.
Or I'll tell you later how to revert a picture, if for example the top-left pixel is (almost) white
0
 
LVL 14

Author Comment

by:systan
ID: 34259934
Ok;
I hope you well get it right.

I am only concern about the  1 persons picture to be faced detected or head detected.


Thanks
0
 
LVL 25

Expert Comment

by:epasquier
ID: 34268595
I'm sorry I couldn't do it today, I'll try tomorrow
0
 
LVL 14

Author Comment

by:systan
ID: 34279968
Ok;
I think I have to wait until you have finalize it.


Thanks
0
 
LVL 14

Author Comment

by:systan
ID: 34281809
hi epasquier;
Do you think its hard to continue the code? the problem is only the white background,   black background has no problem.
0
 
LVL 25

Accepted Solution

by:
epasquier earned 500 total points
ID: 34288096
Sorry to make you wait, I wanted the best solution for you
And that is detection and conversion right in the Grey scale conversion, using standard accelerated functions & parameters (CopyMode)
function ColorToGrey(Const C:TColor):Byte;

Var C2:Cardinal;

begin

 C2:=ColorToRGB(C);

 C2:=((C2 AND $FF)+((C2 SHR 8) AND $FF)+(C2 SHR 16)) DIV 3;

 Result:=C2;

end;



function ConvertGreyScale(Var BMP:TBitmap):TBitmap;

begin

 Result:=CreateGreyscaleBMP;

 Result.Width:=BMP.Width;

 Result.Height:=BMP.Height;



//== THIS IS NEW ==

 if ColorToGrey(BMP.Canvas.Pixels[0,0])>$A0  // test for *light grey*

  then Result.Canvas.CopyMode:=cmNotSrcCopy // invert copy

  Else Result.Canvas.CopyMode:=cmSrcCopy;   // normal copy

//==================

 Result.Canvas.Draw(0,0,BMP); // copy (will also take care of palette translation from color to greyspace)



 BMP.Free;

 BMP:=Result;

end;



procedure TfrmHeadFrame.edtBMPNameChange(Sender: TObject);

Var

 BMP:TBitmap;

begin

 if FileExists(edtBMPName.FileName) then

  begin

   BMP:=CreateGreyscaleBMP;

   BMP.LoadFromFile(edtBMPName.FileName);

   Image.Picture.Assign(ConvertGreyScale(BMP));

   BMP.Free;

  end;

end;

Open in new window

0
 
LVL 14

Author Closing Comment

by:systan
ID: 34288199
Oh, you just invert the value?
Ok;

Thanks a lot epasquier
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…
This tutorial demonstrates a quick way of adding group price to multiple Magento products.

707 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now