Delphi-OpenCV/samples/VCLDemo/vclChessboardCorners/MainForm.pas

(* /*****************************************************************
  //                       Delphi-OpenCV Demo
  //               Copyright (C) 2013 Project Delphi-OpenCV
  // ****************************************************************
  // Contributor:
  // Samuele Trentin
  // ****************************************************************
  // 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
unit MainForm;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, highgui_c, core.types_c, Vcl.ExtCtrls, Vcl.StdCtrls;

type
  TFormMain = class(TForm)
    ImageOut: TImage;
    Panel1: TPanel;
    ButtonClose: TButton;
    ButtonAR: TButton;
    ImageCaptured: TImage;
    ButtonShow: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ButtonCloseClick(Sender: TObject);
    procedure ButtonARClick(Sender: TObject);
    procedure ButtonShowClick(Sender: TObject);
  private
    { Private declarations }
    FCamCapture: pCvCapture;
    FFrameBitmap: TBitmap;
    FOverlaySize: TCvSize;
    FbAR2D: boolean;
    FCorner: array[0..100] of TCvPoint2D32f;
    FOverlayImage: pIplImage;
    procedure OnIdle(Sender: TObject; var Done: boolean);
  public
    { Public declarations }
  end;

var
  FormMain: TFormMain;

implementation

{$R *.dfm}
uses
  core_c, cvUtils, calib3d_c, imgproc_c, imgproc.types_c;

const
  nWidthGrid= 9;
  nHeightGrid = 6;

procedure TFormMain.ButtonCloseClick(Sender: TObject);
begin
  Application.OnIdle := nil;
  FbAR2D := False;
  Close;
end;

procedure TFormMain.FormCreate(Sender: TObject);
begin
  ButtonShowClick(Self);

  // Initialization
  FbAR2D := False;
  FOverlaySize.height := nHeightGrid - 1;
  FOverlaySize.width := nWidthGrid - 1;
  FOverlayImage := cvLoadImage('Resource\baboon.jpg');

  // Link to the first camera available
  FCamCapture := cvCreateCameraCapture(CV_CAP_ANY);
  if Assigned(FCamCapture) then
  begin
    // Structure for treating the images captured by camera
    FFrameBitmap := TBitmap.Create;
    FFrameBitmap.PixelFormat := pf24bit;

    // Show frame captured..
    Application.OnIdle := OnIdle;
  end;
end;

procedure TFormMain.FormDestroy(Sender: TObject);
begin
  // Free camera and structure..
  if Assigned(FCamCapture) then
    cvReleaseCapture(FCamCapture);
  if Assigned(FFrameBitmap) then
    FFrameBitmap.Free;
  cvReleaseImage(FOverlayImage);
end;

procedure TFormMain.OnIdle(Sender: TObject; var Done: boolean);
Var
  frame: pIplImage;
  nResult: Integer;
  resizeImg, blankImg, negImg, copyImg, greyImg: pIplImage;
  p, q: pCvPoint2D32f;
  warp_matrix: pCvMat;
begin
  // Retrieve frame
  frame := cvQueryFrame(FCamCapture);
  if Assigned(frame) then
  begin
    // Show input
    if ImageCaptured.Visible then
    begin
      IplImage2Bitmap(frame, FFrameBitmap);
      ImageCaptured.Picture.Bitmap.Assign(FFrameBitmap);
    end;

    // Overlay image..
    if FbAR2D then
    begin
      try
        // Create gray image from source
        greyImg := cvCreateImage(cvGetSize(frame), IPL_DEPTH_8U, 1);
        cvCvtColor(frame, greyImg, CV_BGR2GRAY);
        nResult := cvCheckChessboard(greyImg, CvSize(nWidthGrid, nHeightGrid));
        if nResult > 0 then
        begin
          nResult := cvFindChessboardCorners(greyImg, FOverlaySize, @FCorner);
          if nResult > 0 then
          begin
            try
              // Identifies the pattern from the gray image and saves the valid group of corners
              cvFindCornerSubPix(greyImg, @FCorner, 40, CvSize(11,11), CvSize(-1,-1), CvTermCriteria(CV_TERMCRIT_EPS+CV_TERMCRIT_ITER, 40, 0.1));

              // Set the source points
              q := AllocMem(SizeOf(TCvPoint2D32f) * 4);
              // Src Top left
              q[0].x := 0;
              q[0].y := 0;
              // Src Top right
              q[1].x := FOverlayImage.width - 1;
              q[1].y := 0;
              // Src Bottom left
              q[2].x := 0;
              q[2].y := FOverlayImage.height - 1;
              // Src Bot right
              q[3].x := FOverlayImage.width - 1;
              q[3].y := FOverlayImage.height - 1;

              // Set the destination points
              p := AllocMem(SizeOf(TCvPoint2D32f) * 4);
              // Src Top right
              p[0].x := FCorner[0].x;
              p[0].y := FCorner[0].Y;
              // Src Top left
              p[1].x := FCorner[nWidthGrid - 2].x;
              p[1].y := FCorner[nWidthGrid - 2].y;
              // Src Bottom left
              p[2].x := FCorner[(nWidthGrid - 1) * (nHeightGrid - 2)].x;
              p[2].y := FCorner[(nWidthGrid - 1) * (nHeightGrid - 2)].y;
              // Src Bot right
              p[3].x := FCorner[(nWidthGrid - 1) * (nHeightGrid - 1) -1].x;
              p[3].y := FCorner[(nWidthGrid - 1) * (nHeightGrid - 1) -1].y;


              // Create the transformation matrix
              warp_matrix := cvCreateMat(3, 3, CV_32FC1);
              cvGetPerspectiveTransform(q, p, warp_matrix);


              // Support structures
              blankImg := cvCreateImage(cvGetSize(FOverlayImage), FOverlayImage.depth, FOverlayImage.nChannels);
              negImg := cvCreateImage(cvGetSize(frame), frame.depth, frame.nChannels);
              copyImg := cvCreateImage(cvGetSize(frame), frame.depth, frame.nChannels);

              // Transform overlay image
              cvWarpPerspective(FOverlayImage, negImg, warp_matrix, CV_INTER_LINEAR or CV_WARP_FILL_OUTLIERS, cvScalarAll(0));

              // Set to white
              cvSet(blankImg, cvScalarAll(255));
              // Transform blank image
              cvWarpPerspective(blankImg, copyImg, warp_matrix, CV_INTER_LINEAR or CV_WARP_FILL_OUTLIERS, cvScalarAll(0));

              // Invert image
              cvNot(copyImg, copyImg);

              // Join Frame and overlay image
              cvAnd(copyImg, frame, copyImg);
              cvOr(copyImg, negImg, frame);

              // Show output
              IplImage2Bitmap(frame, FFrameBitmap);
              ImageOut.Picture.Bitmap.Assign(FFrameBitmap);
            finally
              FreeMem(q);
              FreeMem(p);
              cvReleaseImage(blankImg);
              cvReleaseImage(negImg);
              cvReleaseImage(copyImg);
            end;
          end;
        end;
      except
        on E: Exception do
      end;
    end;
    Done := False;
  end
  else
    Application.OnIdle := nil;
end;

procedure TFormMain.ButtonARClick(Sender: TObject);
begin
  // Start / Stop
  if not FbAR2D then
    ButtonAR.Caption := 'Disable'
  else
    ButtonAR.Caption := 'Active';
  FbAR2D := not FbAR2D;
end;

procedure TFormMain.ButtonShowClick(Sender: TObject);
begin
  ImageCaptured.Visible := not ImageCaptured.Visible;
  // Show / hide captured frame..
  if ImageCaptured.Visible then
  begin
    ButtonShow.Caption := '<< Hide cap.';
    Self.Width := 1384;
  end
  else
  begin
    ButtonShow.Caption := 'Show cap. >>';
    Self.Width := 746;
  end;
end;

end.