frmcamshiftdemo.pas

来自「Delphi版本的OpenCV头文件库(以及诸多实例)」· PAS 代码 · 共 307 行

unit frmCamshiftdemo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs,  StdCtrls, ComCtrls, ExtCtrls, Math,
  IPL, OpenCV, frmHistogram, jpeg;

type
  TfCamshiftdemo = class(TForm)
    Timer1: TTimer;
    Panel2: TPanel;
    Label1: TLabel;
    tbVmin: TTrackBar;
    Label2: TLabel;
    tbVmax: TTrackBar;
    Label3: TLabel;
    tbSmin: TTrackBar;
    Panel1: TPanel;
    formImage: TImage;
    rgImage: TRadioGroup;
    StatusBar1: TStatusBar;
    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 formImageMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure formImageMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure rgImageClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  fCamshiftdemo: TfCamshiftdemo;

{-----------------------}
image: pIplImage = 0;
 hsv: pIplImage = 0;
 hue: pIplImage = 0;
 mask: pIplImage = 0;
 backproject: pIplImage = 0;
 histimg: pIplImage = 0;
 hist: PCvHistogram = 0;
 fcascade : Pointer;
backproject_mode: longint = 0;
select_object: longint = 0;
track_object: longint = 0;
show_hist: longint = 0;

 origin: CvPoint;
 selection: CvRect;
 track_window: CvRect;
 track_box: CvBox2D;
 track_comp: CvConnectedComp;

 hdims: longint = 16;

 storage : pcvMemStorage;

hranges_arr: array[0..1] of float = (0, 180);
hranges: Pfloat = @hranges_arr;

capture: PCvCapture;
frame: PIplImage;
color: CvScalar;
bmp: TBitmap;
faces :pcvSeq;

{-----------------------------}

sector_data : array[0..5] of array[0..2] of longint =
((0,2,1), (1,2,0), (1,0,2), (2,0,1), (2,1,0), (0,1,2));

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

{$R *.dfm}
uses cvCam;






function hsv2rgb(hue: float ): CvScalar ;
var
    rgb : array[0..2] of longint;
    p, sector: longint;
//    sector_data : array[0..5] of array[0..2] of longint;
begin
    hue := hue * 0.033333333333333333333333333333333;
    sector := cvFloor(hue);
    p := cvRound(255*(hue - sector));
    if (sector and 1) <> 0 then
        p := p xor 255
    else
        p := p xor 0;

    rgb[sector_data[sector][0]] := 255;
    rgb[sector_data[sector][1]] := 0;
    rgb[sector_data[sector][2]] := p;
    result := cvScalar_(rgb[2], rgb[1], rgb[0], 0);
end;

procedure doHaar(image : PIplImage;bmp : TBitmap);
var
        i, bin_w: integer;
        r: pCvRect;
begin
       faces := cvHaarDetectObjects( image, fcascade, storage,1.1, 2, CV_HAAR_DO_CANNY_PRUNING, cvSize_(20, 20) );

       for  i :=0 to faces.total-1 do
        begin
          r := pCvRect(cvGetSeqElem( faces, i ));
          cvRectangle( image, cvPoint_(r.x*2,r.y*2),cvPoint_((r.x+r.width)*2,(r.y+r.height)*2),CV_RGB(255,0,0), 3,1,1 );
        end;
        {visualize the camera image in the window}
        IplImage2Bitmap(image, bmp);
end;


procedure main_cycle();
var
        i, bin_w: integer;
        _vmin, _vmax: integer;
        max_val: float;
        val: integer ;
        cs: CvSize;
        r: pCvRect;
        Rec :TRect;
begin
    begin
        frame := cvQueryFrame( capture );
        if not(assigned(frame) ) then     exit;
       if not assigned(image) then
          image:= cvCloneImage(frame);
       cvFlip(frame,image);
       image.origin := 0;
       faces := cvHaarDetectObjects( image, fcascade, storage,1.1, 2, CV_HAAR_DO_CANNY_PRUNING, cvSize_(20, 20) );
       for  i :=0 to faces.total-1 do
        begin
          r := pCvRect(cvGetSeqElem( faces, i ));
          cvRectangle( image, cvPoint_(r.x*2,r.y*2),cvPoint_((r.x+r.width)*2,(r.y+r.height)*2),CV_RGB(255,0,0), 3,1,1 );
        end;
        {visualize the camera image in the window}
        IplImage2Bitmap(image, bmp);
        rec := fCamshiftdemo.formImage.canvas.ClipRect;
        fCamshiftdemo.formImage.canvas.StretchDraw(rec , bmp);
       if (show_hist <> 0) then
       begin
        IplImage2Bitmap(histimg, bmp);
        fHistogram.histimage.canvas.StretchDraw(fHistogram.histimage.canvas.ClipRect , bmp);
       end;
    end;
end;

procedure TfCamshiftdemo.FormCreate(Sender: TObject);
begin
//    capture := cvCaptureFromFile('G:\Trabajo\Semaforos\Prueba3D-0b.avi');
    fcascade := cvLoad('C:\Archivos de programa\OpenCV\data\haarcascades\haarcascade_frontalface_alt2.xml');
    capture := cvCaptureFromCAM( 0);
//    capture := cvCaptureFromFile('G:\Trabajo\c醡ara oficina\22-04 camara oficina.Avi');
    if not(assigned(capture )) or (fcascade = nil)  then
    begin
        MessageDlg('Could not initialize capturing from camera!!', mtError, [mbOK], 0);
        halt;
    end;
       storage := cvCreateMemStorage(0);

       tbVmin.Position := 10;
       tbVmax.Position := 256;
       tbSmin.Position := 30;

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

 fcascade := cvLoad('C:\Archivos de programa\OpenCV\data\haarcascades\haarcascade_frontalface_alt.xml');
 storage := cvCreateMemStorage(0);
 doHaar(cvLoadImage('lena.jpg'),bmp);
 fCamshiftdemo.formImage.width := bmp.width;
 fCamshiftdemo.formImage.height := bmp.height;
 fCamshiftdemo.formImage.canvas.StretchDraw(fCamshiftdemo.formImage.canvas.ClipRect , bmp);  }
end;

procedure TfCamshiftdemo.FormKeyPress(Sender: TObject; var Key: Char);
begin
        if( key = char(27) ) then
        begin
            self.Destroy;
            halt;
        end;
        case key of
        'b':
            backproject_mode := backproject_mode xor 1;
        'c': begin
                track_object := 0;
                cvZero( histimg );
            end;
        'h':
            begin
            show_hist :=  show_hist xor 1;
            if (show_hist=0) then
                fHistogram.Free
            else
            begin
                fHistogram := TfHistogram.Create(self);
                fHistogram.Show;
            end;
            end;
        else
            ;
        end;

end;

procedure TfCamshiftdemo.FormDestroy(Sender: TObject);
begin
    cvReleaseImage(image);
    cvReleaseCapture( @capture );
    if assigned(fHistogram) then
        fHistogram.Destroy;
end;

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


procedure TfCamshiftdemo.formImageMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
        xConv, yConv: integer;
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));
    origin := cvPoint_(xConv ,yConv );
    selection := cvRect_(xConv,yConv,0,0);
    select_object := 1;
end;

procedure TfCamshiftdemo.formImageMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
        xConv, yConv: integer;
begin
    StatusBar1.Panels[0].Text := 'x :'+intToStr(x)+' y:'+intToStr(y);
    if not(assigned(image )) or (select_object =0 ) 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));

        begin
            selection.x := MIN(xConv, origin.x);
            selection.y := MIN(yConv, origin.y);
            selection.width := ABS(xConv - origin.x);
            selection.height := ABS(yConv - 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 );

        end;
     end;
end;

procedure TfCamshiftdemo.formImageMouseUp(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 TfCamshiftdemo.rgImageClick(Sender: TObject);
begin
//--------------
 backproject_mode   := rgImage.itemIndex;
end;

end.