unit Unit1;
{$mode delphi}{$H+}
interface
uses
{$ifdef MSWINDOWS}Windows, unGetWinVersion,
{$endif}
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
StdCtrls, Spin, ExtCtrls,
ipl, opencv;
const
MAX_COUNT = 500;
type
PRGB32Array = ^TRGB32Array;
TRGB32Array = packed array[0..MaxInt div SizeOf(TRGBQuad) - 1] of TRGBQuad;
type
{ TForm1 }
TForm1 = class(TForm)
Abort: TButton;
Image2: TImage;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
VideoSettings: TButton;
AutoInit: TButton;
DeletePoints: TButton;
Night: TButton;
FrameRate: TFloatSpinEdit;
Image1: TImage;
Label1: TLabel;
Timer1: TTimer;
procedure AbortClick(Sender: TObject);
procedure AutoInitClick(Sender: TObject);
procedure DeletePointsClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FrameRateChange(Sender: TObject);
procedure NightClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure VideoSettingsClick(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
TPointsArr = array[0..MAX_COUNT] of CvPoint2D32f;
PPointsArr = ^TPointsArr;
var
Counter :integer;
kalib :double;
Form1: TForm1;
image: pIplImage = nil;
grey: pIplImage = nil;
image1: pIplImage = nil;
grey1: pIplImage = nil;
prev_grey: pIplImage = nil;
pyramid: pIplImage = nil;
prev_pyramid: pIplImage = nil;
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 ;
nframe: integer;
i, k, c: longint;
{-----------------------}
capture1,capture: PCvCapture;
frame1,frame: PIplImage;
cframe: integer = 0;
selcam: longint = 0;
color: CvScalar;
bmp,bmp1: TBitmap;
implementation
{$R *.lfm}
procedure main_cycle();
var
cs: CvSize;
eig, temp: PIplImage;
quality, min_distance, dx, dy: double;
i: integer;
newpoint: PCvPoint2D32f;
frame: PIplImage;
,img : pIplImage;
x,y,w,h,ii, total: Integer;
szary, najjasniejszy : double;
sl: PRGB32Array;
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, 4, 1 );
flags := 0;
end;
cvCopy( frame, image, 0 );
cvCvtColor( image, grey, CV_BGR2GRAY );
inc(Counter);
form1.Label5.Caption:=inttostr(Counter);
if( night_mode = 1) then
cvZero( image );
{visualize the camera image in the window}
IplImage2Bitmap(image, bmp);
Form1.Image1.Picture.bitmap.assign(bmp);
{ najjasniejszy := 0;
w := form1.image1.Width;
h := form1.image1.Height;
for y := 1 to h - 1 do
begin
sl := form1.image1.Picture.Bitmap.ScanLine[y];
for x := 1 to w - 1 do
with sl[x] do
begin
szary := (rgbBlue + rgbGreen + rgbRed);
if szary > KALIBRACJA then
KALIBRACJA := szary;
end;
end;}
form1.Label2.Caption:=floattostr(szary);
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var
nselCam, parm, n: longint;
begin
try
{$ifdef MSWINDOWS} CorrectDSPackForVista; {$endif}
capture := cvCaptureFromCAM(0);
except
on ex : exception do
begin
ShowMessage('Start capturing error - '+ex.message);
halt;
end;
end;
if not(assigned(capture )) then
begin
ShowMessage('Could not initialize capturing from camera!!');
halt;
end;
cvSetCaptureProperty(capture, CV_CAP_PROP_FRAME_WIDTH, 640);
cvSetCaptureProperty(capture, CV_CAP_PROP_FRAME_HEIGHT, 480);
bmp := TBitmap.Create;
//fsetup := tsetupfo.create(self);
//fsetup.hide;
//fsetup.brightness := round(cvGetCaptureProperty(capture, CV_CAP_PROP_BRIGHTNESS));
//fsetup.contrast := round(cvGetCaptureProperty(capture, CV_CAP_PROP_CONTRAST));
//fsetup.saturation := round(cvGetCaptureProperty(capture, CV_CAP_PROP_SATURATION));
nframe := 0;
timer1.enabled := true;
end;
procedure TForm1.AutoInitClick(Sender: TObject);
begin
need_to_init := 1;
end;
procedure TForm1.AbortClick(Sender: TObject);
begin
self.Destroy;
halt;
end;
procedure TForm1.DeletePointsClick(Sender: TObject);
begin
count := 0;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
cvReleaseCapture( @capture );
end;
procedure TForm1.FrameRateChange(Sender: TObject);
begin
Timer1.Interval := Round(1000/FrameRate.Value);
end;
procedure TForm1.NightClick(Sender: TObject);
begin
night_mode := night_mode xor 1;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
inc(nframe);
// if (nframe>=seInterval.Value) then
begin
nframe := 1;
main_cycle;
end;
application.processMessages;
end;
procedure TForm1.VideoSettingsClick(Sender: TObject);
begin
end;
end.