![]() |
|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
||||
|
||||
![]() Автор: Метрозацепер
Email: zatseper@mail.ru Описание: исходник программы для автоматического захвата изображений с Web-камеры. Программа автоматически захватывает изображения с Web-камеры через библиотеку avicap32.dll, сохраняет их в формате BMP, а также обеспечивает просмотр видео с камеры в реальном времени. Системные требования: avicap32.dll + драйвер для Web-камеры + Web-камера ![]() Код:
//////////////////////////////////////////////////////////////////////////////////// //Захват изображений с 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. |