frmlkdemo.pas

Delphi版本的OpenCV头文件库(以及诸多实例)

unit frmLkdemo;
{
    Ejemplo de Tracking de Puntos.
}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,  StdCtrls, ComCtrls, ExtCtrls, Math,
  IPL, OpenCV, jpeg, ImgList, RzShellDialogs, RzButton, RzPanel;

const
    MAX_COUNT = 500;

type
  TfLkdemo = class(TForm)
    Timer1: TTimer;
    Panel2: TPanel;
    Panel1: TPanel;
    formImage: TImage;
    RzToolbar1: TRzToolbar;
    RzToolButton1: TRzToolButton;
    RzOpenDialog1: TRzOpenDialog;
    ImageList1: TImageList;
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure formImageMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure formImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure RzToolButton1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


  TPointsArr = array[0..MAX_COUNT] of CvPoint2D32f;
  PPointsArr = ^TPointsArr;
var
  fLkdemo: TfLkdemo;

  {-----------------------}
  image: pIplImage = 0;
  grey: pIplImage = 0;
  prev_grey: pIplImage = 0;
  pyramid: pIplImage = 0;
  prev_pyramid: pIplImage = 0;
  swap_temp: pIplImage;
  win_size: longint = 10;
  points: array[0..1] of PPointsArr;
  pointsRow1, pointsRow2: TPointsArr;
  swap_points: PCvPoint2D32f ;
  status: array [0..MAX_COUNT] of char;
  count: longint = 0;
  need_to_init: longint = 0;
  night_mode: longint = 0;
  flags: longint = 0;
  add_remove_pt: longint = 0;
  pt: CvPoint ;
  i, k, c: longint;
  {-----------------------}
  capture: PCvCapture;
  frame: PIplImage;
  color: CvScalar;
  bmp: TBitmap;


{*************************************************************************}
implementation

{$R *.dfm}


procedure main_cycle();
var
cs: CvSize;
eig, temp: PIplImage;
quality, min_distance, dx, dy: double;
i: integer;
newpoint: PCvPoint2D32f;
rec: TRect;
aM :CvMemStorage;
begin
        frame := cvQueryFrame( capture );
        if not (assigned(frame)) then
            exit;

        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;
            grey := cvCreateImage( cs, 8, 1 );
            prev_grey := cvCreateImage( cs, 8, 1 );
            pyramid := cvCreateImage( cs, 8, 1 );
            prev_pyramid := cvCreateImage( cs, 8, 1 );

            points[0] := @pointsRow1[0];
            points[1] := @pointsRow2[0];
            flags := 0;
        end;
        cvCopy( frame, image, 0 );
        cvCvtColor( image, grey, CV_BGR2GRAY );

        if( night_mode = 1) then
            cvZero( image );


        if( need_to_init = 1) then
        begin
            //* automatic initialization
            eig := cvCreateImage( cvGetSize(grey), 32, 1 );
            temp := cvCreateImage( cvGetSize(grey), 32, 1 );
            quality := 0.101;
            min_distance := 10.0;

            count := MAX_COUNT;
            cvGoodFeaturesToTrack( grey, eig, temp, @points[1][0], @count,
                                   quality, min_distance, 0, 3, 0, 0.04 );
            cvFindCornerSubPix( grey, @points[1][0], count,
                cvsize_(win_size, win_size), cvSize_(-1, -1),
                cvTermCriteria_(CV_TERMCRIT_ITER or CV_TERMCRIT_EPS, 20, 0.03));
            cvReleaseImage(eig );
            cvReleaseImage(temp );

            add_remove_pt := 0;
        end
        else
          if( count > 0 ) then
          begin
            cvCalcOpticalFlowPyrLK( prev_grey, grey, prev_pyramid, pyramid,
                @points[0][0], @points[1][0], count, cvSize_(win_size,win_size), 3, status, 0,
                cvTermCriteria_(CV_TERMCRIT_ITER or CV_TERMCRIT_EPS,20,0.03), flags );
            flags := flags or CV_LKFLOW_PYR_A_READY;

            k := 0;
            for i:=0 to count -1 do
            begin
                if( add_remove_pt = 1) then
                begin
                    dx := pt.x - points[1][i].x;
                    dy := pt.y - points[1][i].y;

                    if( dx*dx + dy*dy <= 25 ) then
                    begin
                        add_remove_pt := 0;
                        continue;
                    end;
                end;

                if (status[i] = #0) then
                    continue;

                points[1][k] := points[1][i];
                inc(k);
                cvCircle( image, cvPointFrom32f_(points[1][i]), 3, CV_RGB(0,255,0), -1, 8,0);
            end;
            count := k;
        end;

        if (( add_remove_pt = 1) and (count < MAX_COUNT )) then
        begin
            points[1][count] := cvPointTo32f_(pt);
            inc(count);
            // newpoint -> points[1] + count - 1
            newpoint := @points[1][count-1];

            cvFindCornerSubPix( grey, newpoint, 1,
                cvSize_(win_size,win_size), cvSize_(-1,-1),
                cvTermCriteria_(CV_TERMCRIT_ITER or CV_TERMCRIT_EPS,20,0.030));
            add_remove_pt := 0;
        end;

        CV_SWAP( pointer(prev_grey), pointer(grey), pointer(swap_temp) );
        CV_SWAP( pointer(prev_pyramid), pointer(pyramid), pointer(swap_temp) );
        CV_SWAP( pointer(points[0]), pointer(points[1]), pointer(swap_points) );

        need_to_init := 0;
        //cvShowImage( "LkDemo", image );
        {visualize the camera image in the window}
        IplImage2Bitmap(image, bmp);
        rec := fLkdemo.formImage.canvas.ClipRect;
        fLkdemo.formImage.canvas.StretchDraw(rec , bmp);
end;

procedure TfLkdemo.FormCreate(Sender: TObject);
begin
    //----------
end;

procedure TfLkdemo.FormKeyPress(Sender: TObject; var Key: Char);
begin
        if( key = char(27) ) then
        begin
            self.Destroy;
            halt;
        end;
        case key of
        'r': begin
            need_to_init := 1;
            end;
        'c': begin
            count := 0;
            end;
        'n': begin
            night_mode := night_mode xor 1;
            end;
        else
            ;
        end;

end;

procedure TfLkdemo.FormDestroy(Sender: TObject);
begin
    cvReleaseCapture( @capture );
end;

procedure TfLkdemo.Timer1Timer(Sender: TObject);
begin
        main_cycle;
        application.HandleMessage;
end;


procedure TfLkdemo.formImageMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
        xConv, yConv: integer;
begin
    if not assigned(image) then
        // nop
    else begin
        {convert x and y mouse coords to OpenCV image coords}
        xConv := round(x *(image.Width / formImage.Width));
        if( image.Origin <> IPL_ORIGIN_TL ) then
            y :=  formImage.Height - y;
        yConv := round(y *(image.Height / formImage.Height));
       pt := cvPoint_(xconv,yconv);
       add_remove_pt := 1;
    end;
end;

procedure TfLkdemo.formImageMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
end;

{**********************************************************************}
{**********************************************************************}

procedure TfLkdemo.RzToolButton1Click(Sender: TObject);
var tempP : P2PCvCapture;
begin
  if Assigned(capture) then
  begin
    timer1.Enabled := false;
    bmp.free();
    GetMem(tempP, 2);
    tempP^ := capture;
    cvReleaseCapture(tempP);
    cvReleaseImage(image);
  end;

  if RzOpenDialog1.Execute then
  begin
    capture := cvCaptureFromFile(pChar(RzOpenDialog1.Files[0]));
    if not(assigned(capture ))  then
    begin
        MessageDlg('Could not initialize capturing from File!!', mtError, [mbOK], 0);
        halt;
    end;
    MessageDlg('Keys: ESC - quit program;'#10' r - auto-initialize tracking; '#10'c - delete all the points; '#10'n - switch the "night" mode on/off ', mtInformation, [mbOK], 0);

    bmp := TBitmap.Create;
    bmp.PixelFormat :=  pf24bit;
    timer1.enabled := true;

  end;
end;

end.