Разработка системы видеонаблюдения на базе компьютера с использованием Delphi 2012

var

Form1: TForm1;

IniFile: TIniFile;

FileName: string;

RecMode:boolean;

DeviceName: OleVariant;

PropertyName: IPropertyBag;

pDevEnum: ICreateDEvEnum;

pEnum:IEnumMoniker;

pMoniker:IMoniker;

MArray1: array of IMoniker;

FGraphBuilder: array[1..4]of IGraphBuilder;

FCaptureGraphBuilder:array[1..4]of

ICaptureGraphBuilder2;

FMux: array[1..4]of IBaseFilter;

FSink: array[1..4]of IFileSinkFilter;

FMediaControl: array[1..4]of IMediaControl;

FVideoWindow:array[1..4]of IVideoWindow;

FVideoCaptureFilter: array[1..4]of IBaseFilter;

FAudioCaptureFilter: array[1..4]of IBaseFilter;

FVideoRect: array[1..4]of TRect;

FBaseFilter: array[1..4]of IBaseFilter;

FSampleGrabber: array[1..4]of ISampleGrabber;

MediaType: AM_MEDIA_TYPE;

n,kk: integer;

d,disk: string;

bit1: tbitmap;

//Это список моникеров, из которого мы потом будем получать необходмый моникер

//Интерфейсы

//Область вывода изображения

function TForm1.Initializ: HResult;

begin

Result:=CoCreateInstance(CLSID_SystemDeviceEnum, NIL, CLSCTX_INPROC_SERVER,

IID_ICreateDevEnum, pDevEnum);

if Result<>S_OK then EXIT;

Result:=pDevEnum.CreateClassEnumerator(CLSID_VideoInputDeviceCategory, pEnum, 0);

if Result<>S_OK then EXIT;

setlength(MArray1,0);

while (S_OK=pEnum.Next(1,pMoniker,Nil)) do

begin

setlength(MArray1,length(MArray1)+1);

MArray1[length(MArray1)-1]:=pMoniker;

Result:=pMoniker.BindToStorage(NIL, NIL, IPropertyBag, PropertyName);

if FAILED(Result) then Continue;

Result:=PropertyName.Read('FriendlyName', DeviceName, NIL);

if FAILED(Result) then Continue;

Listbox1.Items.Add(DeviceName);

end;

if ListBox1.Count=0 then

begin

ShowMessage('Камера не обнаружена');

Result:=E_FAIL;;

Exit;

end;

Listbox1.ItemIndex:=-1;

Result:=S_OK;

end;

function TForm1.CreateGraph(n:integer):HResult;

var

pConfigMux: IConfigAviMux;

begin

FVideoCaptureFilter[n]:= NIL;

FVideoWindow[n]:= NIL;

FMediaControl[n]:= NIL;

FSampleGrabber[n]:= NIL;

FBaseFilter[n]:= NIL;

FCaptureGraphBuilder[n] := NIL;

FGraphBuilder[n]:= NIL;

Result:=CoCreateInstance(CLSID_FilterGraph, NIL, CLSCTX_INPROC_SERVER, IID_IGraphBuilder, FGraphBuilder[n]);

if FAILED(Result) then EXIT;

Result:=CoCreateInstance(CLSID_SampleGrabber, NIL, CLSCTX_INPROC_SERVER, IID_IBaseFilter, FBaseFilter[n]);

if FAILED(Result) then EXIT;

Result:=CoCreateInstance(CLSID_CaptureGraphBuilder2, NIL, CLSCTX_INPROC_SERVER, IID_ICaptureGraphBuilder2, FCaptureGraphBuilder[n]);

if FAILED(Result) then EXIT;

Result:=FGraphBuilder[n].AddFilter(FBaseFilter[n], 'GRABBER');

if FAILED(Result) then EXIT;

Result:=FBaseFilter[n].QueryInterface(IID_ISampleGrabber, FSampleGrabber[n]);

if FAILED(Result) then EXIT;

if FSampleGrabber[n] <> NIL then

begin

ZeroMemory(@MediaType, sizeof(AM_MEDIA_TYPE));

with MediaType do

begin

majortype:= MEDIATYPE_Video;

subtype:= MEDIASUBTYPE_RGB32;

formattype:= FORMAT_VideoInfo;

end;

FSampleGrabber[n].SetMediaType(MediaType);

FSampleGrabber[n].SetBufferSamples(TRUE);

FSampleGrabber[n].SetOneShot(FALSE);

end;

Result:=FCaptureGraphBuilder[n].SetFiltergraph(FGraphBuilder[n]);

if FAILED(Result) then EXIT;

if Listbox1.Count>n-1 then

begin

MArray1[n-1{Listbox1.ItemIndex}].BindToObject (NIL, NIL, IID_IBaseFilter, FVideoCaptureFilter[n]);

FGraphBuilder[n].AddFilter(FVideoCaptureFilter[n], 'VideoCaptureFilter');

end;

Result:=FCaptureGraphBuilder[n].RenderStream(@PIN_CATEGORY_PREVIEW, nil, FVideoCaptureFilter[n] ,FBaseFilter[n] ,nil);

if FAILED(Result) then EXIT;

Result:=FGraphBuilder[n].QueryInterface(IID_IVideoWindow, FVideoWindow[n]);

if FAILED(Result) then EXIT;

FVideoWindow[n].put_WindowStyle(WS_CHILD or WS_CLIPSIBLINGS);

case n of

1:begin

FVideoWindow[n].put_Owner(Panel1.Handle);

FVideoRect[n]:=Panel1.ClientRect;

end;

2:begin

FVideoWindow[n].put_Owner(Panel2.Handle);

FVideoRect[n]:=Panel2.ClientRect;

end;

3:begin

FVideoWindow[n].put_Owner(Panel3.Handle);

FVideoRect[n]:=Panel3.ClientRect;

end;

4:begin

FVideoWindow[n].put_Owner(Panel4.Handle);

FVideoRect[n]:=Panel4.ClientRect;

end;

end;

FVideoWindow[n].SetWindowPosition(FVideoRect[n].Left,FVideoRect[n].Top, FVideoRect[n].Right - FVideoRect[n].Left,FVideoRect[n].Bottom - FVideoRect[n].Top);

FVideoWindow[n].put_Visible(TRUE);

Result:=FGraphBuilder[n].QueryInterface(IID_IMediaControl, FMediaControl[n]);

if FAILED(Result) then Exit;

FMediaControl[n].Run();

end;

function TForm1.CaptureBitmap(n:integer): HResult;

var

bSize: integer;

pVideoHeader: TVideoInfoHeader;

MediaType: TAMMediaType;

BitmapInfo: TBitmapInfo;

Buffer: Pointer;

tmp: array of byte;

Bitmap: TBitmap;

JpegIm: TJpegImage;

begin

Result := E_FAIL;

if FSampleGrabber[n] = NIL then EXIT;

Result := FSampleGrabber[n].GetCurrentBuffer(bSize, NIL);

if (bSize <= 0) or FAILED(Result) then EXIT;

Bitmap := TBitmap.Create;

try

ZeroMemory(@MediaType, sizeof(TAMMediaType));

Result := FSampleGrabber[n].GetConnectedMediaType(MediaType);

if FAILED(Result) then EXIT;

pVideoHeader := TVideoInfoHeader(MediaType.pbFormat^);

ZeroMemory(@BitmapInfo, sizeof(TBitmapInfo));

CopyMemory(@BitmapInfo.bmiHeader, @pVideoHeader.bmiHeader, sizeof(TBITMAPINFOHEADER));

Buffer := NIL;

Bitmap.Handle := CreateDIBSection(0, BitmapInfo, DIB_RGB_COLORS, Buffer, 0, 0);

SetLength(tmp, bSize);

try

FSampleGrabber[n].GetCurrentBuffer(bSize, @tmp[0]);

CopyMemory(Buffer, @tmp[0], MediaType.lSampleSize);

bitmap.Canvas.TextOut(3,3,d+' '+timetostr(now));

case n of

1:bit1.Canvas.CopyRect(rect(0,0,640,480),bitmap.Canvas,rect(0,0,640,480));

2:bit1.Canvas.CopyRect(rect(0,480,640,960),bitmap.Canvas,rect(0,0,640,480));

3:bit1.Canvas.CopyRect(rect(640,0,1280,480),bitmap.Canvas,rect(0,0,640,480));

4:bit1.Canvas.CopyRect(rect(640,480,1280,960),bitmap.Canvas,rect(0,0,640,480));

end;

except

Result := E_FAIL;

end;

finally

SetLength(tmp, 0);

Bitmap.Free;

end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

var t,h,m,s:string;

begin

t:=timetostr(now) ;

CaptureBitmap(1);

if n>1 then CaptureBitmap(2);

if n>2 then CaptureBitmap(3);

if n>3 then CaptureBitmap(4);

h:=GetToken(t,':',1);

m:=GetToken(t,':',2);

s:=GetToken(t,':',3);

try

ForceDirectories(disk+h+'\');

finally

saveJP(disk+h+'\'+m+'_'+s,bit1);

end;

end;

procedure TForm1.Timer2Timer(Sender: TObject);

begin

spinedit1.Value:=kk;

end;

procedure TForm1.Timer3Timer(Sender: TObject);

begin

timer1.Enabled:=true; timer3.Enabled:=false;

end;

function DelDir(dir: string): Boolean; var fos: TSHFileOpStruct; begin ZeroMemory(@fos, SizeOf(fos)); with fos do begin wFunc := FO_DELETE; fFlags := FOF_SILENT or FOF_NOCONFIRMATION; pFrom := PChar(dir + #0); end; Result := (0 = ShFileOperation(fos)); end;

procedure TForm1.FormCreate(Sender: TObject);

var i:integer; Year, Month, Day: Word;

begin

bit1:=Tbitmap.Create;

bit1.Width:=1280;

bit1.Height:=960;

for i:=1 to 4 do RecMode:=False;

CoInitialize(nil);

if FAILED(Initializ) then Begin //ShowMessage('Внимание! Произошла ошибка при инициализации');

Exit; End;

n:=Listbox1.Count;

for I := 1 to n do

begin

if FAILED(CreateGraph(i)) then Exit;

// ShowMessage('Внимание! Произошла ошибка при построении графа фильтров');

end;

label1.Caption:='Кол-во камер - '+inttostr(n);

LoadIniFiles;

SpinEdit1.Value:=kk;

DecodeDate(Now, Year, Month, Day);

d:=datetostr(now);

for I := 1 to strtoint(IntToStr(day))-spinedit2.Value do DelDir(disk+inttostr(i));

for I := strtoint(IntToStr(day))+1 to 31 do DelDir(disk+inttostr(i));

disk:=disk+ //IntToStr(year)+'\'+IntToStr(Month) +'\'+'\'+IntToStr(day)+'\';

timer3.Enabled:=true;

begin

checklistbox1.Items:=Listbox1.Items;

end;

end;

procedure TForm1.FormDestroy(Sender: TObject);

var i:integer;

begin

bit1.Free;

begin

pEnum := NIL;

pDevEnum := NIL;

pMoniker := NIL;

PropertyName := NIL;

DeviceName:=Unassigned;

end;

CoUninitialize;

SaveIniFiles;

IniFile.Free;

end;

procedure TForm1.LoadIniFiles;

begin

IniFile:=TIniFile.Create(ExtractFilePath(Application.ExeName)+'config.ini');

disk:=IniFile.ReadString('Options','disk','C:\VideoCam\');

kk:=IniFile.Readinteger('Options','kachestvo',90);

SpinEdit2.Value:=IniFile.Readinteger('Options','kol-vo dnei',3);

end;

procedure TForm1.SaveIniFiles;

begin

IniFile.WriteInteger('Options','kachestvo',SpinEdit1.Value);

IniFile.WriteInteger('Options','kol-vo dnei', SpinEdit2.Value);

end;

end.

//Находим камеры

//Создаем объект для перечисления устройств

//Перечислитель устройств Video

//Пускаем массив по списку устройств

//Запоминаем моникер в масиве

//Получаем имя устройства

//Добавляем имя устройства в списки

//Выбираем из спика камеру №1

//Создаем граф фильтров

//Чистим граф

//Создаем объект для графа фильтров

// Создаем объект для граббинга

//Создаем объект для графа захвата

// Добавляем фильтр в граф

// Получаем интерфейс фильтра перехвата

// Устанавливаем формат данных для фильтра перехвата

// Данные будут записаны в буфер в том виде, в котором они проходят через фильтр

// Граф не будет остановлен для получения кадра

//Задаем граф фильтров

//выбор устройства

//получаем устройство для захвата видео из списка моникеров

//добавляем устройство в граф фильтров

//Задаем, что откуда будем получать и куда оно должно выводиться

//Получаем интерфейс управления окном видео

//Задаем стиль окна вывода

//Накладываем окно вывода на Panel1

//Задаем размеры окна во всю панель

//Накладываем окно вывода на Panel2

//Накладываем окно вывода на Panel3

//Накладываем окно вывода на Panel4

//показываем окно

//Запрашиваем интерфейс управления графом

//Запускаем отображение просмотра с вебкамер

//Сохранение картинки с камеры

// Если отсутствует интерфейс фильтра перехвата изображения, то завершаем работу

//Получаем размер кадра

//Создаем изображение

//Получаем тип медиа потока на входе у фильтра перехвата

//Копируем заголовок изображения

//Создаем побитовое изображение

// Выделяем память во временном массиве

//Читаем данные из медиа потока

в изображение

//Записываем дату и время на изображение

//Склеиваем 4 изображения с камер на одно изображение

// Освобождаем память

//Сохраняем формат даты

//Создаем директорию на диске

//Сохраняем изображение на диск

//Обнуляем степень сжатия

//Удаляем устаревшие записи

Инициализировать OLE COM

//вызываем процедуру поиска и инициализации устройств захвата видео и звука

// Освобождаем память

// деинициализировать OLE COM

//загрузка настроек из inifile

//сохраняем настройки в inifile