程序師世界是廣大編程愛好者互助、分享、學習的平台,程序師世界有你更精彩!
首頁
編程語言
C語言|JAVA編程
Python編程
網頁編程
ASP編程|PHP編程
JSP編程
數據庫知識
MYSQL數據庫|SqlServer數據庫
Oracle數據庫|DB2數據庫
 程式師世界 >> 編程語言 >> 更多編程語言 >> Delphi >> Delphi攝像頭操作

Delphi攝像頭操作

編輯:Delphi

/*Title:Delphi攝像頭操作

*Author:Insun

*Blog:http://yxmhero1989.blog.163.com

*From:www.4safer.com

*/

*Delphi攝像頭操作 - InSun - Minghacker is Insun

 

為了筆耕不辍,為了way out,為了Dota激情的時候不內疚,偶爾發發。

各種遠控軟件都有攝像頭操作,其實編程起來沒什麼技術可言。

DELPHI一般直接使用MS的AVICAP32.DLL就可輕松的實現對攝像頭編程,一般不喜歡TVideoCap控件。

首先常量定義和函數定義:

implementation
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;
{$R *.dfm}

打開Delphi,添加Panel1到Form1上,定義一個全局變量,var hWndC : THandle;

Delphi攝像頭操作 - InSun - Minghacker is Insun


添加button1 ,caption為激活攝像頭:

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);
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);
end;

Delphi攝像頭操作 - InSun - Minghacker is Insun

 

添加button2 ,caption為關閉攝像頭:

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

Delphi攝像頭操作 - InSun - Minghacker is Insun

 

添加button3 ,caption為保存為BMP圖像:

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

添加button4 ,caption為開始錄像:

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;

Delphi攝像頭操作 - InSun - Minghacker is Insun

 

添加button5 ,caption為停止錄像:

procedure TForm1.Button5Click(Sender: TObject);
begin
if hWndC <> 0 then begin
SendMessage(hWndC, WM_CAP_STOP, 0, 0);
end;
end;

添加button6,caption為退出:

procedure TForm1.Button6Click(Sender: TObject);
begin
close;
end;

 

Delphi攝像頭操作 - InSun - Minghacker is Insun

 

可以添加MediaPlayer和opendialog控件

添加button7,caption為加載視頻:

procedure TForm1.Button7Click(Sender: TObject);
begin
openDialog1.DefaultExt := avi;
openDialog1.Filter := avi files (*.avi)|*.avi;

if OpenDialog1.Execute  then
begin
 if (MediaPlayer1.DeviceID<>0) then
  begin
    if (MediaPlayer1.Mode=mpplaying) then MediaPlayer1.Stop;
  end;

 MediaPlayer1.FileName:=openDialog1.FileName;
 //MediaPlayer1.DisplayRect.Top:=panel2.Top;
 //MediaPlayer1.DisplayRect.Left:=panel2.left;
 //MediaPlayer1.DisplayRect.Right:=panel2.Height;
 //MediaPlayer1.DeviceType   :=dtAutoSelect;
 Mediaplayer1.Open;
 MediaPlayer1.Play;
 end;
end;

 

如果電腦沒有攝像頭,panel就會黑黑的,可以嘗試安裝SoftCam虛擬攝像頭。

  1. 上一頁:
  2. 下一頁:
Copyright © 程式師世界 All Rights Reserved