Delphi-OpenCV/samples/MultiDemo/FrameRecon/FrameRecon.dpr

(* /*****************************************************************
  //                       Delphi-OpenCV Demo
  //               Copyright (C) 2013 Project Delphi-OpenCV
  // ****************************************************************
  // Contributor:
  // laentir Valetov
  // email:laex@bk.ru
  // ****************************************************************
  // You may retrieve the latest version of this file at the GitHub,
  // located at git://github.com/Laex/Delphi-OpenCV.git
  // ****************************************************************
  // The contents of this file are used with permission, subject to
  // the Mozilla Public License Version 1.1 (the "License"); you may
  // not use this file except in compliance with the License. You may
  // obtain a copy of the License at
  // http://www.mozilla.org/MPL/MPL-1_1Final.html
  //
  // Software distributed under the License is distributed on an
  // "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
  // implied. See the License for the specific language governing
  // rights and limitations under the License.
  ******************************************************************* *)
// JCL_DEBUG_EXPERT_GENERATEJDBG OFF
// JCL_DEBUG_EXPERT_INSERTJDBG OFF
// JCL_DEBUG_EXPERT_DELETEMAPFILE OFF
program FrameRecon;

{$APPTYPE CONSOLE}
{$POINTERMATH ON}
{$R *.res}

uses
  System.SysUtils,
  uLibName in '..\..\..\include\uLibName.pas',
  highgui_c in '..\..\..\include\highgui\highgui_c.pas',
  core_c in '..\..\..\include\core\core_c.pas',
  Core.types_c in '..\..\..\include\core\Core.types_c.pas',
  imgproc.types_c in '..\..\..\include\imgproc\imgproc.types_c.pas',
  imgproc_c in '..\..\..\include\imgproc\imgproc_c.pas',
  legacy in '..\..\..\include\legacy\legacy.pas',
  calib3d in '..\..\..\include\calib3d\calib3d.pas',
  imgproc in '..\..\..\include\imgproc\imgproc.pas',
  haar in '..\..\..\include\objdetect\haar.pas',
  objdetect in '..\..\..\include\objdetect\objdetect.pas',
  tracking in '..\..\..\include\video\tracking.pas',
  Core in '..\..\..\include\core\core.pas',
  Mat in '..\..\..\include\core\Mat.pas';

Var
  image: pIplImage = nil;
  imageDiv: pIplImage;
  outImg: pIplImage = nil;
  extractedFrame: pIplImage;
  // gray: pIplImage;
  pgray, pcontor: pIplImage;
  intrinsic: PCvMat;
  distortion: PCvMat;
  obj, pro: PCvMat;
  rot, tra: PCvMat;
  mapMatrix: PCvMat;
  origQuad, quad: array [0 .. 3] of TCvPoint2D32f;
  capture: PCvCapture;
  frame: pIplImage;
  selcam: longint = 0;
  cont: integer;

  // Canny/Threshold parameters
  cbCannyChecked: Boolean = false;
  sePar1Value: Double = 100;
  sePar2Value: Double = 50;
  cbPar3Value: integer = 3;
  // approx poly param.
  cbDisplayContChecked: Boolean = false;
  sePolyPar1Value: Double = 7;
  sePolyPar2Value: integer = 0;
  // max perim ratio difference %
  sePerimRatioDiffValue: Double = 20;

procedure drawPerspective(image: pIplImage);
var
  i: integer;
  pt1, pt2: TCvPoint;
begin

  cvZero(pro);

  cvProjectPoints2(obj, rot, tra, intrinsic, distortion, pro);

  cvCircle(image, cvPoint(round(cvGet(pro, 0, 0)), round(cvGet(pro, 0, 1))), 10, cv_rgb(255, 0, 0));
  for i := 0 to 3 do
  begin
    pt1.x := round(cvGet(pro, i, 0));
    pt1.y := round(cvGet(pro, i, 1));
    if i < 3 then
    begin
      pt2.x := round(cvGet(pro, i + 1, 0));
      pt2.y := round(cvGet(pro, i + 1, 1));
    end
    else
    begin
      pt2.x := round(cvGet(pro, 0, 0));
      pt2.y := round(cvGet(pro, 0, 1));
    end;
    cvLine(image, pt1, pt2, cv_rgb(0, 255, 0), 1, CV_AA, 0);
  end;
end;

procedure extractContours(const origImg, image: pIplImage; const storage: pCvMemStorage; var contList: PCvSeq);
var
  nc: integer;
  contours: PCvSeq;

begin
  // *********** find contours in Canny result image
  // find contours and store them all as a list
  contours := nil;
  if (origImg.NChannels > 1) then
  begin
    pgray := cvCreateImage(cvSize(image.width, image.height), IPL_DEPTH_8U, 1);
    cvCvtColor(origImg, pgray, CV_BGR2GRAY)
  end
  else
    pgray := cvCloneImage(origImg);
  pcontor := cvCreateImage(cvSize(image.width, image.height), IPL_DEPTH_8U, 1);
  if cbCannyChecked then
    cvCanny(pgray, pcontor, sePar1Value, sePar2Value, cbPar3Value)
  else
    cvThreshold(pgray, pcontor, sePar1Value, 255, CV_THRESH_BINARY_INV);
  if (image.NChannels > 1) and (cbDisplayContChecked) then
    cvCvtColor(pcontor, image, CV_GRAY2BGR);
  // warning! findcontours destroy the input image, so display it before the call
  nc := cvFindContours(pcontor, storage, @contours, sizeof(TCvContour), CV_RETR_TREE, CV_CHAIN_APPROX_SIMPLE,
    cvPoint(0, 0));

  if nc = 0 then
    contList := nil
  else
    contList := contours;

  cvReleaseImage(pgray);
  cvReleaseImage(pcontor);
end;

procedure drawFrame(const origImg, image: pIplImage);
var
  nc, i: integer;
  contList, contours: PCvSeq;
  seqResult, hole, hole2: PCvSeq;
  storage: pCvMemStorage;
  a, p: Double;
  bRect: TCvRect;

  nholes: integer;
  bol1, bol2, bol3: Boolean;
  m1, q1: single;
  m2, q2: single;
  vert1, vert2: Boolean;
  mi1, qi1: single;
  mi2, qi2: single;
  vertH1, vertH2: Boolean;

  p1, p2: PCvPoint;
  p1Ext: TCvPoint;
  frame_found: Boolean;

  moments: PCvMoments;
  compactness: Double;
begin
  storage := cvCreateMemStorage(0);
  extractContours(origImg, image, storage, contList);

  // test each contour
  contours := contList;
  while (contours <> nil) do
  begin
    a := cvContourArea(contours, CV_WHOLE_SEQ);
    if (abs(a) > 500) and (contours.total > 3) then
    begin
      seqResult := cvApproxPoly(contours, sizeof(TCvContour), storage, CV_POLY_APPROX_DP, sePolyPar1Value,
        sePolyPar2Value);
      if seqResult.total = 4 then
      begin
        Writeln('ContourArea ', a:2:2);
        Writeln('ApproxPoly total ', seqResult.total);
        frame_found := false;
        // calcola coefficienti delle rette diagonali del contorno esterno
        p1 := PCvPoint(cvGetSeqElem(seqResult, 0));
        p1Ext.x := p1.x;
        p1Ext.y := p1.y;
        p2 := PCvPoint(cvGetSeqElem(seqResult, 2));
        if (p1.x <> p2.x) then
        begin
          vert1 := false;
          m1 := (p2.y - p1.y) / (p2.x - p1.x);
          q1 := (p2.x * p1.y - p1.x * p2.y) / (p2.x - p1.x);
        end
        else
        begin
          vert1 := true;
        end;
        p1 := PCvPoint(cvGetSeqElem(seqResult, 1));
        p2 := PCvPoint(cvGetSeqElem(seqResult, 3));
        if (p1.x <> p2.x) then
        begin
          vert2 := false;
          m2 := (p2.y - p1.y) / (p2.x - p1.x);
          q2 := (p2.x * p1.y - p1.x * p2.y) / (p2.x - p1.x);
        end
        else
        begin
          vert2 := true;
        end;

        // internal contours with CV_RETR_TREE
        hole := contours.v_next;
        nholes := 0;
        // 4) scorre i contorni interni (TREE)
        while (hole <> nil) do
        begin
          inc(nholes);
          if nholes > 1 then
            break;
          if hole.total <= 3 then
            Continue;
          // 4.1) approssima ogni contorno con pilogono
          hole2 := cvApproxPoly(hole, sizeof(TCvContour), storage, CV_POLY_APPROX_DP, sePolyPar1Value, sePolyPar2Value);
          // 4.2) verifica se poligono ha 4 vertici
          if hole2.total <> 4 then
            Continue;
          p1 := PCvPoint(cvGetSeqElem(hole2, 0));

          // 4.3) calcola coefficienti delle rette diagonali
          p2 := PCvPoint(cvGetSeqElem(hole2, 2));
          if (p1.x <> p2.x) then
          begin
            vertH1 := false;
            mi1 := (p2.y - p1.y) / (p2.x - p1.x);
            qi1 := (p2.x * p1.y - p1.x * p2.y) / (p2.x - p1.x);
          end
          else
          begin
            vertH1 := true;
          end;
          p1 := PCvPoint(cvGetSeqElem(hole2, 1));
          p2 := PCvPoint(cvGetSeqElem(hole2, 3));
          if (p1.x <> p2.x) then
          begin
            vertH2 := false;
            mi2 := (p2.y - p1.y) / (p2.x - p1.x);
            qi2 := (p2.x * p1.y - p1.x * p2.y) / (p2.x - p1.x);
          end
          else
          begin
            vertH2 := true;
          end;

          // 4.4) se i coefficienti delle diagonali del poligono interno
          // sono uguali a quelli del poligono esterno, a meno di errore dato,
          // la ricerca e' positiva, uscire dalla funzione
          if (vert1 = vertH1) and (vert2 = vertH2) and (abs(m1 - mi1) / m1 <= (sePerimRatioDiffValue / 100)) and
            (abs(q1 - qi1) / q1 <= (sePerimRatioDiffValue / 100)) and
            (abs(m2 - mi2) / m2 <= (sePerimRatioDiffValue / 100)) and
            (abs(q2 - qi2) / q2 <= (sePerimRatioDiffValue / 100)) then
          begin
            frame_found := true;
            break;
          end;

          hole := hole.h_next;

        end; // while hole
        if (frame_found) then
        begin
          Writeln('frame_found');

          cvZero(rot);
          cvZero(tra);
          // copy projection data to CvMat array
          for i := 0 to 3 do
          begin
            p1 := PCvPoint(cvGetSeqElem(seqResult, i));
            cvSet(pro, i, 0, p1.x);
            cvSet(pro, i, 1, p1.y);
            quad[i].x := p1.x;
            quad[i].y := p1.y;
          end;

          cvFindExtrinsicCameraParams2(obj, pro, intrinsic, distortion, rot, tra);
          Writeln('Z dist. ' + FloatToStr(trunc(cvGet(tra, 0, 2))));

          cvGetPerspectiveTransform(@origQuad, @quad, mapMatrix);
          bRect := pcvcontour(seqResult).rect;

          cvZero(extractedFrame);
          cvWarpPerspective(origImg, extractedFrame, mapMatrix,
            (CV_INTER_LINEAR + CV_WARP_FILL_OUTLIERS + CV_WARP_INVERSE_MAP), cvScalar(0, 0, 0, 0));

          cvDrawContours(image, PCvSeq(seqResult), cv_rgb(255, 0, 0), cv_rgb(0, 255, 0), 0, 4, CV_AA, cvPoint(0, 0));

          break;
        end;
      end; // if seqresult.total=4
    end; // if abs
    // take the next contour
    contours := contours.h_next;
  end;
  cvRelease(contList);
  cvReleaseMemStorage(storage);
end;

procedure main_cycle(frame: pIplImage);
var
  cs: TCvSize;
begin
  if not(assigned(image)) then
  begin
    // * allocate all the buffers
    cs.width := frame.width;
    cs.height := frame.height;
    image := cvCreateImage(cs, 8, 3);
    image.Origin := frame.Origin;
    imageDiv := cvCreateImage(cvSize(cs.width div 2, cs.height div 2), 8, 3);
    imageDiv.Origin := frame.Origin;
    outImg := cvCreateImage(cs, 8, 3);
    outImg.Origin := frame.Origin;
  end;

  cvCopy(frame, image);
  cvSmooth(image, image, CV_GAUSSIAN, 3, 3);

  cvCopy(image, outImg);

  drawFrame(image, outImg);
  if cont = 20 then
  begin
    cont := 1;
    cvShowImage('Paint window', extractedFrame);
  end
  else
    inc(cont);

  drawPerspective(outImg);
  cvCopy(outImg, frame);
end;

procedure Help;
begin
  Writeln('c - CannyChecked');
  Writeln('d - DisplayContChecked');
end;

begin
  try
    ///
    // Calibration: Resource\Calibration_Chess.png
    // Test: Resource\frame.png
    ///

    // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
    capture := cvCreateCameraCapture(CV_CAP_ANY);
    if not assigned(capture) then
      Halt;
    cvNamedWindow('Paint window', 1);
    cvNamedWindow('Original', 1);

    intrinsic := cvLoad('Resource\Intrinsics.xml');
    // multiply by 2 because the matrix is computed on 320x240 image
    cvConvertScale(intrinsic, intrinsic, 2.0, 0);
    distortion := cvLoad('Resource\Distortion.xml');
    obj := cvCreateMat(4, 3, CV_32FC1);
    pro := cvCreateMat(4, 2, CV_32FC1);
    rot := cvCreateMat(1, 3, CV_32FC1);
    tra := cvCreateMat(1, 3, CV_32FC1);
    mapMatrix := cvCreateMat(3, 3, CV_32FC1);
    cvSet(obj, 0, 0, -100);
    cvSet(obj, 0, 1, -100);
    cvSet(obj, 0, 2, 0.0);
    origQuad[0].x := 0;
    origQuad[0].y := 0;

    cvSet(obj, 1, 0, 100.0);
    cvSet(obj, 1, 1, -100);
    cvSet(obj, 1, 2, 0.0);
    origQuad[1].x := 300;
    origQuad[1].y := 0;

    cvSet(obj, 2, 0, 100.0);
    cvSet(obj, 2, 1, 100.0);
    cvSet(obj, 2, 2, 0.0);
    origQuad[2].x := 300;
    origQuad[2].y := 300;

    cvSet(obj, 3, 0, -100);
    cvSet(obj, 3, 1, 100.0);
    cvSet(obj, 3, 2, 0.0);
    origQuad[3].x := 0;
    origQuad[3].y := 300;

    cvSet(rot, 0, 0, 0.0);
    cvSet(rot, 0, 1, 0.0);
    cvSet(rot, 0, 2, 0.0);

    cvSet(tra, 0, 0, 0.0);
    cvSet(tra, 0, 1, 0.0);
    // the Z coord on translation vector is set to focal length
    cvSet(tra, 0, 2, cvGet(intrinsic, 0, 0));

    // appo image for warp perspective
    extractedFrame := cvCreateImage(cvSize(800, 600), 8, 3);

    Help;

    while true do
    begin
      // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
      frame := cvQueryFrame(capture);
      if not assigned(frame) then
        break;
      cvShowImage('Original', frame);
      main_cycle(frame);
      case cvWaitKey(10) of
        27:
          break;
        Ord('c'):
          cbCannyChecked := not cbCannyChecked;
        Ord('d'):
          cbDisplayContChecked := not cbDisplayContChecked;
      end;
    end;

    cvReleaseCapture(capture);
    cvReleaseImage(image);
    cvReleaseImage(outImg);
    cvReleaseImage(extractedFrame);
    cvDestroyAllWindows;
  except
    on e: Exception do
      Writeln(e.ClassName, ': ', e.Message);
  end;

end.