[Admin]

Автор: Метрозацепер
Email: zatseper@mail.ru

Описание: исходник программы для автоматического захвата изображений с Web-камеры.

Программа автоматически захватывает изображения с Web-камеры через библиотеку avicap32.dll, сохраняет их в формате BMP, а также обеспечивает просмотр видео с камеры в реальном времени.

Системные требования: avicap32.dll + драйвер для Web-камеры + Web-камера

Код:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124

//////////////////////////////////////////////////////////////////////////////////// //Захват изображений с Web-камеры через библиотеку avicap32.dll                   // //////////////////////////////////////////////////////////////////////////////////// //Программа автоматически (каждые 1..60 сек.) сохраняет изображение с видеокамеры // //в формате BMP, а также обеспечивает просмотр видео в реальном времени.          // //////////////////////////////////////////////////////////////////////////////////// //(С) Bogomolov Igor (aka Метрозацепер) zatseper@mail.ru                          // ////////////////////////////////////////////////////////////////////////////////////   unit UnitMain;   interface   uses   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,   Dialogs, StdCtrls, ExtCtrls, ComCtrls, XPMan;  // Модуль XPMan.dcu используется для лучшего вида TrackBar.   type   TFormMain = class(TForm)     LabelDescription: TLabel;     PanelVideo: TPanel;     AutoCapturingTimer: TTimer;     RefreshingTimer: TTimer;     TrackBar1: TTrackBar;     LabelInterval: TLabel;     ButtonHelp: TImage;     procedure FormClose(Sender: TObject; var Action: TCloseAction);     procedure FormShow(Sender: TObject);     procedure AutoCapturingTimerTimer(Sender: TObject);     procedure RefreshingTimerTimer(Sender: TObject);     procedure TrackBar1Change(Sender: TObject);     procedure ButtonHelpClick(Sender: TObject);   private     { Private declarations }   public     { Public declarations }   end;   var   FormMain: TFormMain;   hWndC: THandle;   implementation     const   WM_CAP_START = WM_USER;   //WM_CAP_STOP = WM_CAP_START + 68;   WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;    // Подключение драйвера.   WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11; // Отключение драйвера.   WM_CAP_SAVEDIB = WM_CAP_START + 25;           // Сохранение изображения с Web-камеры в формате bmp\dib.   WM_CAP_GRAB_FRAME = WM_CAP_START + 60;        // Обновление кадра.   //WM_CAP_SEQUENCE = WM_CAP_START + 62;   //WM_CAP_SET_PREVIEW = WM_CAP_START + 50;   //WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;   {$R *.dfm}   function capCreateCaptureWindowA(lpszWindowName: PCHAR;   dwStyle: longint;   x: integer;   y: integer;   nWidth: integer;   nHeight: integer;   ParentWin: HWND;   nId: integer): HWND;   stdcall external 'AVICAP32.DLL';   procedure TFormMain.FormClose(Sender: TObject; var Action: TCloseAction); begin   SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0); end;   procedure TFormMain.FormShow(Sender: TObject); begin  hWndC := capCreateCaptureWindowA('My Capture Window',     WS_CHILD or WS_VISIBLE,     PanelVideo.Left,     PanelVideo.Top,     PanelVideo.Width,     PanelVideo.Height,     FormMain.Handle, 0);   if hWndC <> 0 then   begin     SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);     RefreshingTimer.Enabled := True;     // Включение таймера обновления кадра.     AutoCapturingTimer.Enabled := True;  // Включение таймера сохранения файлов.   end; end;   procedure TFormMain.AutoCapturingTimerTimer(Sender: TObject); var   SystemDateCurrent, SystemTimeCurrent: TDateTime;   FileName: string; begin   SystemDateCurrent := Date; SystemTimeCurrent := Time;   FileName := FormatDateTime('dd.mm.yyyy', SystemDateCurrent) + ' ' + FormatDateTime('hh_m_ss', SystemTimeCurrent) + '.bmp';   SendMessage(hWndC, WM_CAP_SAVEDIB, 0, longint(pchar(FileName))) // Сохранение файла в формате bmp. end;   procedure TFormMain.RefreshingTimerTimer(Sender: TObject); begin   // Примечание: чем больше RefreshingTimer.Interval, тем меньше ресурсоёмкость программы, но тем ниже скорость обновления видео (и, как следствие, его качество).   SendMessage(hWndC, WM_CAP_GRAB_FRAME, 0, 0); // Обновление кадра. end;   procedure TFormMain.TrackBar1Change(Sender: TObject); begin   if TrackBar1.Position = 0 then   begin     LabelInterval.Caption := 'Выключено';     AutoCapturingTimer.Interval := 0;     Exit;   end;   LabelInterval.Caption := 'Задержка: ' + IntToStr(TrackBar1.Position) + ' сек.';   AutoCapturingTimer.Interval := TrackBar1.Position * 1000; end;   procedure TFormMain.ButtonHelpClick(Sender: TObject); begin ShowMessage('Автор программы - Bogomolov Igor (aka Метрозацепер), 18.05.2013, zatseper@mail.ru') end;   end.

[M.A.D.M.A.N.]

У нас тут есть подобный исходник, который еще и сравнивает изображения в рантайме.

[nano_bot]

а сам проект можно?