19.05.2013, 18:00
|
|
Администратор
|
|
Регистрация: 03.10.2005
Адрес: Россия, Москва
Сообщения: 1,564
Версия Delphi: Delphi 7
Репутация: выкл
|
|
[ Исходник ] - Web Cam Capture
Автор: Метрозацепер
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.
|