opencv.pas

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

 function cvCreateImage;                  external cxCore name 'cvCreateImage';
 function cvGetSize;                      external cxCore name 'cvGetSize';
 procedure cvCopy;                        external cxCore name 'cvCopy';
 procedure cvInRangeS;                    external cxCore name 'cvInRangeS';
 procedure cvSetZero;                     external cxCore name 'cvSetZero';
 procedure cvZero;                        external cxCore name 'cvSetZero';
 procedure cvSetImageROI;                 external cxCore name 'cvSetImageROI';
 procedure cvResetImageROI;               external cxCore name 'cvResetImageROI';
 procedure cvConvertScale;                external cxCore name 'cvConvertScale';
 procedure cvSplit;                       external cxCore name 'cvSplit';
 procedure cvFlip;                     external cxCore name 'cvFlip';
 procedure cvSubRS ;                       external cxCore name 'cvSubRS';
 procedure cvAnd;                         external cxCore name 'cvAnd';
 procedure cvSub;                         external cxCore name 'cvSub';
 procedure cvXOR;                         external cxCore name 'cvXor';
 function cvGetReal1D;                    external cxCore name 'cvGetReal1D';
 function cvGetReal2D;                    external cxCore name 'cvGetReal2D';
 function cvGetReal3D;                    external cxCore name 'cvGetReal3D';
 function cvGetRealND;                    external cxCore name 'cvGetRealND';

 procedure cvSet1D;                       external cxCore name 'cvSet1D';
 procedure cvSet2D;                       external cxCore name 'cvSet2D';

 procedure cvSetReal1D;                    external cxCore name 'cvSetReal1D';
 procedure cvSetReal2D;                    external cxCore name 'cvSetReal2D';

 procedure cvXorS;                        external cxCore name 'cvXorS';
 procedure cvRectangle;                   external cxCore name 'cvRectangle';
 procedure cvEllipse;                     external cxCore name 'cvEllipse';


 function cvCreateHist;                   external cvDLL name 'cvCreateHist';
 procedure cvCalcArrHist;                 external cvDLL name 'cvCalcArrHist';
 procedure cvGetMinMaxHistValue;          external cvDLL name 'cvGetMinMaxHistValue';
 procedure cvCalcArrBackProject;          external cvDLL name 'cvCalcArrBackProject';
 function cvCamShift;                     external cvDLL name 'cvCamShift';


 function cvCaptureFromFile;              external HighGUI_DLL name 'cvCreateFileCapture';
 function cvGrabFrame;                    external HighGUI_DLL name 'cvGrabFrame';
 function cvRetrieveFrame;                external HighGUI_DLL name 'cvRetrieveFrame';
 function cvQueryFrame;                   external HighGUI_DLL name 'cvQueryFrame';
 procedure cvReleaseCapture;              external HighGUI_DLL name 'cvReleaseCapture';

 {----------------------------------------------------}
 Procedure cvMatMul( A,B,D : PCvArr );
 begin
    cvMatMulAdd(A,B,nil,D);
 end;


 function CV_MAT_TYPE( flags : integer): integer;
 begin
    Result:=(flags and CV_MAT_TYPE_MASK);
 end;

 function CV_MAT_DEPTH( flags : integer): integer;
 begin
    Result:=(flags and CV_MAT_DEPTH_MASK);
 end;

 function CV_MAT_CN( flags : integer): integer;
 begin
    Result:=((flags and CV_MAT_CN_MASK) shr 3)+1;
 end;

 function CV_ELEM_SIZE( type_ : integer): integer;
 begin
    Result:=(CV_MAT_CN(type_) shl (($e90 shr CV_MAT_DEPTH(type_)*2) and 3));
 end;

 function cvMat_( rows : Integer; cols : Integer; type_: Integer; data : Pointer) : CvMat ;
 begin
    type_:= CV_MAT_TYPE(type_);
    Result.type_:= CV_MAT_MAGIC_VAL or CV_MAT_CONT_FLAG or type_;
    Result.cols := cols;
    Result.rows := rows;
    Result.step := Result.cols*CV_ELEM_SIZE(type_);
    Result.ptr := PUCHAR(data);
    Result.refcount := nil;
 end;

 
 Function cvmGet( const mat : PCvMat; i, j : integer): Single;
 var
  type_ : integer;
  ptr   : PUCHAR;
  pf    : PSingle;
 begin
    type_:= CV_MAT_TYPE(mat.type_);
    assert(  ( i<mat.rows) and (j<mat.cols) );

    if type_ = CV_32FC1 then begin
       ptr:=mat.ptr;
       inc(ptr, mat.step*i+ sizeOf(Single)*j);
       pf:=PSingle(ptr);
       Result:=pf^;
    end;

 end;


 Procedure cvmSet( mat : PCvMat; i, j : integer; val: Single  );
 var
  type_ : integer;
  ptr   : PUCHAR;
  pf    : PSingle;
 begin
    type_:= CV_MAT_TYPE(mat.type_);
    assert(  ( i<mat.rows) and (j<mat^.cols) );

    if type_ = CV_32FC1 then begin
       ptr:=mat.ptr;
       inc(ptr, mat.step*i+ sizeOf(Single)*j);
       pf:=PSingle(ptr);
       pf^:=val;
    end;

 end;

 Function cvPseudoInverse( const src : PCvArr; dst : PCvArr ) : double;
 begin
    cvInvert( src, dst, CV_SVD );
 end;


 Function cvSize_( width, height : integer ) : TcvSize;
 begin
    Result.width:=width;
    Result.height:=height;
 end;

{-----------------------------------}
procedure cvCalcHist(image:P2PIplImage; hist:PCvHistogram; accumulate:longint; mask:PCvArr);
begin
//      cvCalcArrHist( (CvArr**)image, hist, accumulate, mask );
      cvCalcArrHist(p2pCvArr(image), hist, accumulate, mask );

end;

procedure cvCalcBackProject(image:P2PIplImage; dst:PCvArr; hist:PCvHistogram);
begin
  cvCalcArrBackProject(P2PCvArr(image), dst, hist);
end;


function cvScalar_(val0:double; val1:double; val2:double; val3:double):CvScalar;
var
      scalar: CvScalar ;
begin
      scalar.val[0] := val0; scalar.val[1] := val1;
      scalar.val[2] := val2; scalar.val[3] := val3;
      result := scalar;
end;

function cvScalarAll_(val0123:double):CvScalar;
var
        scalar: CvScalar;
begin
      scalar.val[0] := val0123;
      scalar.val[1] := val0123;
      scalar.val[2] := val0123;
      scalar.val[3] := val0123;
      result := scalar;
end;



function cvRound(value:double):longint;
var
        temp: double;

begin
      {*
       the algorithm was taken from Agner Fog's optimization guide
       at http://www.agner.org/assem
       *}
    //  temp := value + 6755399441055744.0;
    //  result := (int)*((uint64*)&temp);
      result := round(value);

end;

function cvFloor(value:double):longint;
begin
        result := floor(value);
end;

function cvPoint2D32f_(  x, y: single ): cvPoint2D32f;
begin
    result.x := x;
    result.y := y;
end;

function cvPoint_( x, y: longint ): CvPoint;
var
    p: CvPoint;
begin
    p.x := x;
    p.y := y;

    result := p;
end;

function  cvTermCriteria_( type_: longint; max_iter: longint; epsilon: double ): CvTermCriteria;
var
    t: CvTermCriteria;
begin
    t.type_ := type_;
    t.maxIter := max_iter;
    t.epsilon := epsilon;

    result := t;
end;

function CV_RGB(r,g,b : longint) : CvScalar;
begin
   CV_RGB := cvScalar_(b,g,r,0);
end;

procedure CV_SWAP(var a, b, t: pointer);
begin
        t := a;
        a := b;
        b := t;
end;


function  cvPointFrom32f_( point: CvPoint2D32f ): CvPoint;
var
    ipt: CvPoint;
begin
    ipt.x := cvRound(point.x);
    ipt.y := cvRound(point.y);

    result := ipt;
end;


procedure cvEllipseBox(img:PCvArr; box:CvBox2D; color:CvScalar; thickness:longint;
              line_type:longint; shift:longint);
var
      axes: CvSize;
begin
      axes.width := cvRound(box.size.height *0.5);
      axes.height := cvRound(box.size.width *0.5);

      cvEllipse( img, cvPointFrom32f_( box.center ), axes, (box.angle*180/pi),
                 0, 360, color, thickness, line_type, shift );
end;

function  cvRect_( x, y, width, height: longint ): CvRect;
var
    r: CvRect;
begin
    r.x := x;
    r.y := y;
    r.width := width;
    r.height := height;

    result := r;
end;


function  cvPointTo32f_(point: CvPoint ):  CvPoint2D32f;
var
    ipt: CvPoint2D32f;
begin
    ipt.x := point.x;
    ipt.y := point.y;
    result := ipt;
end;


function hsv2rgb(  hue : float )  :CvScalar ;
var rgb : array [0..2] of integer;
    p,sector  :integer;
    const sector_data : array [0..5,0..2] of integer=
        ((0,2,1), (1,2,0), (1,0,2), (2,0,1), (2,1,0), (0,1,2));

begin
    hue :=hue *  0.033333333333333333333333333333333;
    sector := cvFloor(hue);
    p := cvRound(255*(hue - sector));
    if (sector and 1) = 1 then p := 255
    else p := 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;

 function CV_IS_HAAR_CLASSIFIER(haar : pointer) : boolean;
 begin
    result := false;
    result :=  (haar <>nil) and
       ( ( pCvHaarClassifierCascade(haar).flags and CV_MAGIC_MASK ) = CV_HAAR_MAGIC_VAL  ) ;
 end;
{-----------------------------------------------------------------------------
  Procedure:  IplImage2Bitmap
  Author:     De Sanctis
  Date:       23-set-2005
  Arguments:  iplImg: PIplImage; bitmap: TBitmap
  Description: convert a IplImage to a Windows bitmap
-----------------------------------------------------------------------------}
procedure IplImage2Bitmap(iplImg: PIplImage; var bitmap: TBitmap);
  VAR
    i        :  INTEGER;
    j        :  INTEGER;
    offset   :  longint;
    dataByte :  PByteArray;
    RowIn    :  pByteArray;
    channelsCount : integer;
BEGIN
  TRY


   // assert((iplImg.Depth = 8) and (iplImg.NChannels = 3),
    //            'IplImage2Bitmap: Not a 24 bit color iplImage!');

    bitmap.Height := iplImg.Height;
    bitmap.Width := iplImg.Width;
    FOR j := 0 TO Bitmap.Height-1 DO
    BEGIN
      // origin BL = Bottom-Left
      if (iplimg.Origin = IPL_ORIGIN_BL) then
              RowIn  := Bitmap.Scanline[bitmap.height -1 -j ]
      else
              RowIn  := Bitmap.Scanline[j ];

      offset := longint(iplimg.ImageData) + iplImg.WidthStep * j;
      dataByte := pbytearray( offset);

      if (iplImg.ChannelSeq = 'BGR') then
      begin
        {direct copy of the iplImage row bytes to bitmap row}
        CopyMemory(rowin, dataByte, iplImg.WidthStep);
      end
      else
      if  (iplImg.ChannelSeq =  'GRAY') then
          FOR i := 0 TO Bitmap.Width-1 DO
          begin
                RowIn[3*i] := databyte[i];
                RowIn[3*i+1] := databyte[i];
                RowIn[3*i+2] := databyte[i];
          end
      else
          FOR i := 0 TO 3*Bitmap.Width-1 DO
            begin
                RowIn[i] := databyte[i+2] ;
                RowIn[i+1] := databyte[i+1] ;
                RowIn[i+2] := databyte[i];
            end;
    END;

  Except

  END
END; {IplImage2Bitmap}

{****************************************************************************}
end.