怎么用摄像头来做监控？

Question

手中有摄像头，麦克风。想利用摄像头把某一段时间的图象、声音录下来保存为可以播放的文件。用Delphi怎么编程呢？有源代码最好。

Answer 1

搜索一下吧，許多的。大富翁，有許多人提到。DSPack

Answer 2

只有摄像头是不够的，还得有图像捕捉卡。这个大多数厂家都有现成的程序或SDK。

Answer 3

{下面是我的DLL代码}
{其中'vfw.pas'需要自己加}
{可以实现连接，抓图，录像，停止录像，断开连接}
{D6下编译通过}
--------------------------------------
library VideoCap;{ Important note about DLL memory management: ShareMem must be the
  first unit in your library's USES clause AND your project's (select
  Project-View Source) USES clause if your DLL exports any procedures or
  functions that pass strings as parameters or function results. This
  applies to all strings passed to and from your DLL--even those that
  are nested in records and classes. ShareMem is the interface unit to
  the BORLNDMM.DLL shared memory manager, which must be deployed along
  with your DLL. To avoid using BORLNDMM.DLL, pass string information
  using PChar or ShortString parameters. }uses
  ShareMem,
  SysUtils,
  ExtCtrls,
  ComCtrls,
  Classes,
  Dialogs,
  windows,
  VFW in 'vfw.pas';
///
var
  ghCapWnd:HWND;
{$R *.res}
function capCreateCaptureWindowA(lpszwindowname:pchar;dstyle:longint;x:integer;y:integer;nwidth:integer;
                                  Nheight:integer;parentwin:HWND;nid:integer):HWND; stdcall external 'AVICAP32.dll';
///
function StartCap(VideoWind:TPanel):boolean;export;
begin
  StartCap := false;
  ghCapWnd:=CapCreateCaptureWindowA(Pchar('QingHuntSoft'),
                                    WS_CHILD or WS_VISIBLE,
                                    0,
                                    0,
                                    VideoWind.Width,
                                    VideoWind.Height,
                                    VideoWind.Handle,
                                    10);
   if ghCapWnd<>0 then
   try
     SendMessage(ghcapwnd,WM_CAP_DRIVER_CONNECT,0,0);
     sendmessage(ghcapwnd,WM_CAP_SET_SCALE,1,1);
     sendmessage(ghcapwnd,WM_CAP_SET_PREVIEWRATE,1,1);
     sendmessage(ghcapwnd,WM_CAP_SET_OVERLAY,1,0);
     sendmessage(ghcapwnd,WM_CAP_SET_PREVIEW,1,1);
     StartCap := true;
   Except
     StartCap := false;
     Abort;
   end;
end;
///
procedure StopCap;export;
begin
  sendmessage(ghcapwnd,WM_CAP_DRIVER_DISCONNECT,0,0);
end;
///
procedure SaveCap(SavePath:string);export;
var
  Year, Month, Day, Hour, Min, Sec, MSec: Word;
  CapParms: PCaptureParms;
  Present: TDateTime;
  PathStr,MM,DD,HH:string;
  CapFileName:String;
begin
  Present:=now;
  DecodeDate(Present,Year,Month,Day);
  DecodeTime(Present, Hour, Min, Sec, MSec);
  if Month<10 then MM:=inttostr(0)+inttostr(Month) else MM:=inttostr(month);
  if Day<10   then DD:=inttoStr(0)+inttostr(day)   else DD:=inttostr(day) ;
  if Hour<10  then HH:=inttostr(0)+inttostr(Hour)  else HH:=inttostr(Hour);
  PathStr:=SavePath+'\'+MM+'月'+DD+'日';
  if Not DireCtoryExists(PathStr) then  ForceDirectories(PathStr);
  CapFileName:=DD+'-'+HH+'.Avi';
  if GhcapWnd<>0 then
   begin
     CapCaptureGetSetup(ghCapWnd,CapParms,sizeof(TCAPTUREPARMS));
     CapParms.fLimitEnabled := false;
     CapParms.fYield := TRUE;
     CapParms.vKeyAbort := VK_ESCAPE;
     CapParms.fAbortLeftMouse := FALSE;
     CapParms.fAbortRightMouse := FALSE;
     CapCaptureSetSetup(ghCapWnd,CapParms,sizeof(TCAPTUREPARMS));
     sendmessage(ghcapwnd,WM_CAP_FILE_SET_CAPTURE_FILE,0,Longint(Pchar(PathStr+'\'+Capfilename)));
     sendmessage(ghcapwnd,WM_CAP_SEQUENCE,0,0);
   end;
end;
///
procedure StopSaveCap;export;
begin
  sendmessage(ghcapwnd,WM_CAP_STOP,0,0);
end;
///
procedure SaveCapImage(SaveDialog:TSaveDialog);export;
begin
  if ghCapWnd<>0 then
  begin
    SaveDialog.DefaultExt:='bmp';
    Savedialog.Filter:='Bitmap Files (*.Bmp)|*.bmp';
    if SaveDialog.Execute   then
       Sendmessage(ghCapWnd,WM_CAP_FILE_SAVEDIB,0,Longint(Pchar(Savedialog.FileName)));
  end;
end;
///
exports
  StartCap,
  StopCap,
  SaveCap,
  StopSaveCap,
  SaveCapImage;
begin
end.

Answer 4

Kshape(伟大的大伟//[现在的人发帖、一点分数含量都没有!]) ：
vfw.pas是干什么用的？有没有具体的代码？

Answer 5

不用控件的摄头操作,希望对你有点用处,代码已经在d7+winxp下调试通过了
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    SaveDialog1: TSaveDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
  hWndC : THandle;
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  const WM_CAP_START = WM_USER;
const WM_CAP_STOP = WM_CAP_START + 68;
const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
const WM_CAP_SAVEDIB = WM_CAP_START + 25;
const WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
const WM_CAP_SEQUENCE = WM_CAP_START + 62;
const WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
const WM_CAP_SEQUENCE_NOFILE =WM_CAP_START+ 63;
const WM_CAP_SET_OVERLAY =WM_CAP_START+ 51 ;
const WM_CAP_SET_PREVIEW =WM_CAP_START+ 50  ;
const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START +6;
const WM_CAP_SET_CALLBACK_ERROR=WM_CAP_START +2;
const WM_CAP_SET_CALLBACK_STATUSA= WM_CAP_START +3;
const WM_CAP_SET_CALLBACK_FRAME= WM_CAP_START +5;
const WM_CAP_SET_SCALE=WM_CAP_START+ 53 ;
const WM_CAP_SET_PREVIEWRATE=WM_CAP_START+ 52  ;function capCreateCaptureWindowA(lpszWindowName : PCHAR;
dwStyle : longint;x : integer;y : integer;nWidth : integer;
nHeight : integer;ParentWin : HWND;nId : integer): HWND;
STDCALL EXTERNAL 'AVICAP32.DLL';
implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);   //打开摄头
begin
hWndC := capCreateCaptureWindowA('My Own Capture Window',WS_CHILD or WS_VISIBLE ,Panel1.Left,Panel1.Top,Panel1.Width,Panel1.Height,Form1.Handle,0);hWndC := capCreateCaptureWindowA('My Own Capture Window',WS_CHILD or WS_VISIBLE ,Panel1.Left,Panel1.Top,Panel1.Width,Panel1.Height,Form1.Handle,0);
if hWndC <> 0 then
begin
SendMessage(hWndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_ERROR, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_STATUSA, 0, 0);
SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
SendMessage(hWndC, WM_CAP_SET_SCALE, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE, 66, 0);
SendMessage(hWndC, WM_CAP_SET_OVERLAY, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
end;
 button2.Enabled:=true;
end;procedure TForm1.Button2Click(Sender: TObject);  //保存图片
begin
 if savedialog1.Execute then
  begin
   if hWndC <> 0 then
   //SendMessage(hWndC,WM_CAP_SAVEDIB,0,longint(pchar('c:\\test.bmp')));
   SendMessage(hWndC,WM_CAP_SAVEDIB,0,longint(pchar(savedialog1.FileName
   )));
  end;
end;procedure TForm1.Button3Click(Sender: TObject);   //开始录象
begin
if hWndC <> 0 then
begin
SendMessage(hWndC,WM_CAP_FILE_SET_CAPTURE_FILEA,0, Longint(pchar('c:\\test.avi')));
SendMessage(hWndC, WM_CAP_SEQUENCE, 0, 0);
end;end;procedure TForm1.Button4Click(Sender: TObject); //停止录象
begin
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_STOP, 0, 0);
end;
end;procedure TForm1.Button5Click(Sender: TObject);   //关闭摄头
begin
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
hWndC := 0;
end;
end;procedure TForm1.FormCreate(Sender: TObject);
begin
if hwndc=0 then
 button2.Enabled:=false;
end;end.

Answer 6

摄像头:
1.目前流行的USB接口的,可直接接QQ用的
2.单个头,AC输出
这两种的操作应该是不一样的吧,第二种应该需要捕捉卡的.

Answer 7

如果你用视频卡的话，你得找支持video for window的

Answer 8

多谢 gpwyfgaopo(流年)，我先试一下。

Answer 9

买一块4路的视频监控卡，如果想录音，买带音频的，里面带SDK了想怎么录就怎么录。

Answer 10

unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;type
  TForm1 = class(TForm)
    Panel1: TPanel;
    SaveDialog1: TSaveDialog;
    Panel2: TPanel;
    OpenVideo: TButton;
    CloseVideo: TButton;
    SaveBMP: TButton;
    StartAVI: TButton;
    StopAVI: TButton;
    procedure FormCreate(Sender: TObject);
    procedure OpenVideoClick(Sender: TObject);
    procedure CloseVideoClick(Sender: TObject);
    procedure SaveBMPClick(Sender: TObject);
    procedure StartAVIClick(Sender: TObject);
    procedure StopAVIClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
   hWndC : THandle;
   CapturingAVI : bool;
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}const WM_CAP_START = WM_USER;
const WM_CAP_STOP = WM_CAP_START + 68;
const WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;
const WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;
const WM_CAP_SAVEDIB = WM_CAP_START + 25;
const WM_CAP_GRAB_FRAME = WM_CAP_START + 60;
const WM_CAP_SEQUENCE = WM_CAP_START + 62;
const WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;
const WM_CAP_SEQUENCE_NOFILE =WM_CAP_START+  63 ;
const WM_CAP_SET_OVERLAY =WM_CAP_START+  51 ;
const WM_CAP_SET_PREVIEW =WM_CAP_START+  50 ;
const WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START +6;
const WM_CAP_SET_CALLBACK_ERROR=WM_CAP_START +2;
const WM_CAP_SET_CALLBACK_STATUSA= WM_CAP_START +3;
const WM_CAP_SET_CALLBACK_FRAME= WM_CAP_START +5;
const WM_CAP_SET_SCALE=WM_CAP_START+  53 ;
const WM_CAP_SET_PREVIEWRATE=WM_CAP_START+  52 ;
function capCreateCaptureWindowA(lpszWindowName : PCHAR;
dwStyle : longint;
x : integer;
y : integer;
nWidth : integer;
nHeight : integer;
ParentWin : HWND;
nId : integer): HWND;
STDCALL EXTERNAL 'AVICAP32.DLL';procedure TForm1.FormCreate(Sender: TObject);
begin
CapturingAVI := false;
hWndC := 0;
SaveDialog1.Options :=[ofHideReadOnly, ofNoChangeDir, ofPathMustExist];
end;procedure TForm1.OpenVideoClick(Sender: TObject);
begin
hWndC := capCreateCaptureWindowA('My Own Capture Window',
WS_CHILD or WS_VISIBLE ,
Panel1.Left,
Panel1.Top,
Panel1.Width,
Panel1.Height,
Form1.Handle,0);
if hWndC <> 0 then
SendMessage(hWndC, WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_ERROR, 0, 0);
SendMessage(hWndC, WM_CAP_SET_CALLBACK_STATUSA, 0, 0);
SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
SendMessage(hWndC, WM_CAP_SET_SCALE, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE, 66, 0);
//SendMessage(hWndC, WM_CAP_SEQUENCE_NOFILE, 1, 0);
SendMessage(hWndC, WM_CAP_SET_OVERLAY, 1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
OpenVideo.Enabled :=false;
end;procedure TForm1.CloseVideoClick(Sender: TObject);
begin
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);
hWndC := 0;
OpenVideo.Enabled :=true;
end;
end;procedure TForm1.SaveBMPClick(Sender: TObject);
begin
if hWndC <> 0 then begin
SaveDialog1.DefaultExt := 'bmp';
SaveDialog1.Filter := 'Bitmap files (*.bmp)|*.bmp';
if SaveDialog1.Execute then
SendMessage(hWndC,
WM_CAP_SAVEDIB,
0,
longint(pchar(SaveDialog1.FileName)));
end;
end;procedure TForm1.StartAVIClick(Sender: TObject);
begin
if hWndC <> 0 then begin
SaveDialog1.DefaultExt := 'avi';
SaveDialog1.Filter := 'AVI files (*.avi)|*.avi';
if SaveDialog1.Execute then begin
CapturingAVI := true;
SendMessage(hWndC,
WM_CAP_FILE_SET_CAPTURE_FILEA,
0,
Longint(pchar(SaveDialog1.FileName)));
SendMessage(hWndC, WM_CAP_SEQUENCE, 0, 0);
end;
end;
end;procedure TForm1.StopAVIClick(Sender: TObject);
begin
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_STOP, 0, 0);
CapturingAVI := false;
end;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CloseVideoClick(Sender);
end;end.

Answer 11

gpwyfgaopo(流年):参考了你的代码，搞定了，谢谢。还有一个问题就是录成的AVI录像用播放器来放的时候断断续续的，不流畅。不知道是什么问题。