利用Delphi編程式控制制網路攝影機(圖)

來源:互聯網
上載者:User

你的電腦有沒有網路攝影機?看到別人用QQ玩視屏你會不會去想怎麼實現的?這裡介紹使用DELPHI使用MS的
AVICAP32.DLL就可輕鬆的實現對網路攝影機編程,如果再加上你的網路編程水平,實現一個視屏聊天就不成什麼問題了。

  看看下面代
碼的代碼:

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';

 
 上面的代碼就是我們主要用到的一個函數和常量的定義。

  好了,開啟你的Delphi,建立一個工程,將上面的定義加上吧。

 
 建立一個視窗,放個Panel上去,添加一個按鈕,Caption設定為"開始"這裡需要定義一個全域變數,var hWndC : THandle;
開始按鈕代碼如下:

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;

  按F9運行一下,怎麼樣,是不是可以看到網路攝影機的視屏了?那怎麼停下來?再加個按鈕caption設定成"
停止" 。代碼如下:

if hWndC <> 0 then begin
SendMessage(hWndC,
WM_CAP_DRIVER_DISCONNECT, 0, 0);
hWndC := 0;
end;

 
 視屏截到了,怎麼把它給儲存下來呢?下面按兩種方式儲存,一個是BMP靜態圖,一個是AVI動畫。

  再放三個按鈕到表單上
去,caption分別設定成"儲存BMP"、"開始錄影"、"停止錄影",三個按鈕的代碼分別如下:

//儲存BMP
if hWndC <> 0 then begin
SendMessage(hWndC,WM_CAP_SAVEDIB,0,longint(pchar('c:/test.bmp')));
end;

//
開始錄影
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;

//停止錄影
if hWndC <> 0 then begin
SendMessage(hWndC,
WM_CAP_STOP, 0, 0);
end;

  再運行看看吧。。
可以儲存幾張圖看看,也可以錄成AVI以後慢慢欣賞。

  程式運行效果:

完整的程式碼如下:

unit Unit1;

interface

uses
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;
procedure Button1Click(Sender:
TObject);
procedure Button2Click(Sender: TObject);
procedure
Button3Click(Sender: TObject);
procedure Button4Click(Sender:
TObject);
procedure Button5Click(Sender: TObject);
procedure
FormClose(Sender: TObject; var Action: TCloseAction);
private
hWndC
: THandle;
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;

end;

procedure TForm1.Button2Click(Sender:
TObject);
begin
if hWndC <> 0 then begin
SendMessage(hWndC,
WM_CAP_DRIVER_DISCONNECT, 0, 0);
hWndC := 0;
end;
end;

procedure
TForm1.Button3Click(Sender: TObject);
begin
if hWndC <> 0
then begin
SendMessage(hWndC,WM_CAP_SAVEDIB,0,longint(pchar('c:/test.bmp')));
end;
end;

procedure
TForm1.Button4Click(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.Button5Click(Sender:
TObject);
begin
if hWndC <> 0 then begin
SendMessage(hWndC,
WM_CAP_STOP, 0, 0);
end;
end;

procedure
TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if
hWndC <> 0 then begin
SendMessage(hWndC,
WM_CAP_DRIVER_DISCONNECT, 0, 0);
end;
end;

end.

 
 如果電腦沒有網路攝影機,但又想看看程式的效果,可以嗎?

  當然可以,找個虛擬網路攝影機不就搞定,大家可以試試SoftCam這個軟體,它
是一個名副其實的軟體攝像機,能類比成為“真實的”攝像機,提醒一下各位,大家可不要用這個東東用在QQ,MSN等聊天軟體上欺騙MM或GG啊。

 
 關於網路攝影機編程,大家也可以看看這組VCL組件:DSPack,DSPack是一套使用微軟Direct
Show和DirectX技術的類和組件,設計工作於DirectX 9,支援系統Win9X, ME, 2000和Windows XP。

 
 好了,就介紹這些了,至於視屏聊天怎麼實現,就看你的了,無非是把資料壓縮傳輸給對方,顯示出來,不過話又說回來,看似簡單,實現起來還有些難度的。

聯繫我們

該頁面正文內容均來源於網絡整理,並不代表阿里雲官方的觀點,該頁面所提到的產品和服務也與阿里云無關,如果該頁面內容對您造成了困擾,歡迎寫郵件給我們,收到郵件我們將在5個工作日內處理。

如果您發現本社區中有涉嫌抄襲的內容,歡迎發送郵件至: info-contact@alibabacloud.com 進行舉報並提供相關證據,工作人員會在 5 個工作天內聯絡您,一經查實,本站將立刻刪除涉嫌侵權內容。

A Free Trial That Lets You Build Big!

Start building with 50+ products and up to 12 months usage for Elastic Compute Service

  • Sales Support

    1 on 1 presale consultation

  • After-Sales Support

    24/7 Technical Support 6 Free Tickets per Quarter Faster Response

  • Alibaba Cloud offers highly flexible support services tailored to meet your exact needs.