formmain.pas

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

unit formMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure onIdle(sender : TObjecT; var done : boolean);
  end;

var
  Form1: TForm1;

implementation
uses   IPL ,   OpenCV ,Math,
  highGui ,   cvCAm ;
{$R *.dfm}
const w =  500 ;
var  nCams : integer;
     VAL : integer;
     vMin, vMax, sMin : integer;
     frame : pIplImage;
     image : pIplImage = nil;
     i, bin_w, c : integer;
     capture :pCvCapture= nil;
     hsv , hue, mask,backproject,histimg : pIplImage;
     hist :  pCvHistogram;
     hdims : integer = 16;
     hranges_arr : array [0..1] of float  = (0,180);
     hranges : P2PFloat;
     backproject_mode : integer= 0;
     select_object: integer = 0;
     track_object : integer= 0;
     show_hist : integer= 1;
     vcolor :  CvScalar;
     origin : CvPoint;
     selection : CvRect;
     track_window : CvRect;
     track_box : CvBox2D;
     _vmin, _vMax : integer;
     track_comp : CvConnectedComp;
     max_val : float;
     bmp: TBitmap;

procedure TForm1.onIdle(sender : TObjecT; var done : boolean);
var rec :TRect;
begin
      try
        frame := 0;
        frame := cvQueryFrame( capture );
        if( frame = nil) then exit ;


        if( image  = nil) then
        begin
            // allocate all the buffers
            image := cvCreateImage( cvSize_(frame.Width,frame.Height), 8, 3 );
            image.origin := frame.origin;
            hsv := cvCreateImage( cvSize_(frame.Width,frame.Height), 8, 3 );
            hue := cvCreateImage( cvSize_(frame.Width,frame.Height), 8, 1 );
            mask := cvCreateImage( cvSize_(frame.Width,frame.Height), 8, 1 );
            backproject := cvCreateImage( cvSize_(frame.Width,frame.Height), 8, 1 );
            hist := cvCreateHist( 1, @hdims, CV_HIST_ARRAY, hranges, 1 );
            histimg := cvCreateImage( cvSize_(320,200), 8, 3 );
            cvZero( histimg );
        end;

        cvCopy( frame, image, 0 );
        cvCvtColor( image, hsv, CV_BGR2HSV );


        if( track_object <>  0 ) then
        begin
            cvInRangeS( hsv, cvScalar_(0,smin,MIN(_vmin,_vmax),0),
                             cvScalar_(180,256,MAX(_vmin,_vmax),0), mask );
            cvSplit( hsv, hue, 0, 0, 0 );

            if( track_object < 0 ) then
            begin
                max_val := 0.0;
                cvSetImageROI( hue, selection );
                cvSetImageROI( mask, selection );
                cvCalcHist( @hue, hist, 0, mask );
                cvGetMinMaxHistValue( hist, 0, @max_val, 0, 0 );
                if  max_val <> 0 then
                  cvConvertScale( hist.bins, hist.bins,  255. / max_val , 0 )
                else
                  cvConvertScale( hist.bins, hist.bins, 0, 0 ) ;

                cvResetImageROI( hue );
                cvResetImageROI( mask );
                track_window := selection;
                track_object := 1;

                cvZero( histimg );
                bin_w := histimg.width div hdims;
                for i := 0 to hdims-1 do
                begin

                    val := cvRound( cvGetReal1D(hist.bins,i)*histimg.height/255 );
                    vcolor := hsv2rgb(i*180.0/hdims);
                    cvRectangle( histimg, cvPoint_(i*bin_w,histimg.height),
                                 cvPoint_((i+1)*bin_w,histimg.height - val),
                                 vcolor, -1, 8, 0 );
                end;
            end;

            cvCalcBackProject( @hue, backproject, hist );
            cvAnd( backproject, mask, backproject, 0 );
            cvCamShift( backproject, track_window,
                        cvTermCriteria_( CV_TERMCRIT_EPS or CV_TERMCRIT_ITER, 10, 1 ),
                        @track_comp, @track_box );
            track_window := track_comp.rect;
            
            if( backproject_mode = 1 )  then
                cvCvtColor( backproject, image, CV_GRAY2BGR );
            if( image.origin = 1)then
                track_box.angle := -track_box.angle;
            cvEllipseBox( image, track_box, CV_RGB(255,0,0), 3, CV_AA, 0 );
         end;

        if( select_object=1) and  (selection.width > 0) and  (selection.height > 0 )then
        begin
            cvSetImageROI( image, selection );
            cvXorS( image, cvScalarAll_(255), image, 0 );
            cvResetImageROI( image );
        end;
        //cvShowImage( 'CamShiftDemo', image );
        {visualize the camera image in the window}
        IplImage2Bitmap(image, bmp);
        rec := image1.canvas.ClipRect;
        image1.canvas.StretchDraw(rec , bmp);


     except
      on E:Exception do
      begin
        if (capture<>nil) then
          cvReleaseCapture( @capture );
        cvDestroyWindow('CamShiftDemo');
        showMessage(E.Message);
        exit;
      end;
     end;
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
        if( key = char(27) ) then
        begin
            self.Destroy;
            halt;
        end;
        case key of
        'r': begin

            end;
        'c': begin

            end;
        'n': begin

            end;
        else
            ;
        end;
end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    if( image = nil) then exit;
    if( image.origin<>0 ) then
      y := image.height - y;
    origin := cvPoint_(x,y);
    selection := cvRect_(x,y,0,0);
    select_object := 1;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
    select_object := 0;
    if( selection.width > 0) and  (selection.height > 0 ) then
        track_object := -1;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   selection.x := 0; selection.y := 0;
   selection.width := 100; selection.height := 100;
   ncams := cvcamGetCamerasCount( );
   capture := cvCaptureFromCAM(1);
   if (nCams>0) and (capture<>nil) then
//     Application.OnIdle := self.onIdle
   else exit;
   bmp := TBitmap.Create;
   bmp.PixelFormat :=  pf24bit;
   timer1.Enabled := True;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if (capture<>nil) then
    cvReleaseCapture( @capture );
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var done : boolean;
begin
   self.onIdle(sender,done);
end;

procedure TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
 if image = nil then exit;
 if( select_object = 1 ) then
    begin
      if( image.origin<>0 ) then
         y := image.height - y;

        selection.x := MIN(x,origin.x);
        selection.y := MIN(y,origin.y);
        selection.width := selection.x + abs(x - origin.x);
        selection.height := selection.y + abs(y - origin.y);

        selection.x := MAX( selection.x, 0 );
        selection.y := MAX( selection.y, 0 );
        selection.width := MIN( selection.width, image.width );
        selection.height := MIN( selection.height, image.height );
        selection.width := selection.width - selection.x;
        selection.height := selection.height - selection.y;
    end;
end;

end.