delphi grachics, How to get the value of the edges

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)

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?)

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 -

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;
 As 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?

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

Actually I based on this link;
https://www.experts-exchange.com/questions/20913287/Detect-ellipse-in-complex-background-face-detection.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
 

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

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;

Select allOpen in new window

when crop it looks like this; only;
 But 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.

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.

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

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.

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;
 
good result; (with black background) with dark background color
 
bad result,
what if the background is a light color, so the result is white background;
 

epasquier?, are you listening?

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


Thanks

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

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

I'm sorry I couldn't do it today, I'll try tomorrow

Ok;
I think I have to wait until you have finalize it.


Thanks

hi epasquier;
Do you think its hard to continue the code? the problem is only the white background,   black background has no problem.

Oh, you just invert the value?
Ok;

Thanks a lot epasquier