国产探花免费观看_亚洲丰满少妇自慰呻吟_97日韩有码在线_资源在线日韩欧美_一区二区精品毛片,辰东完美世界有声小说,欢乐颂第一季,yy玄幻小说排行榜完本

首頁 > 編程 > Delphi > 正文

Delphi編程控制攝像頭

2019-11-18 18:04:16
字體:
來源:轉載
供稿:網友

你的電腦有沒有攝像頭?看到別人用QQ玩視屏你會不會去想怎么實現的?
這里介紹使用DELPHI使用MSAVICAP32.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這個軟件,它是一個名副其實的軟件攝像機,
能模擬成為“真實的”攝像機,提醒一下各位,大家可不要用這個東東用在QQMSN等聊天軟件上欺騙MMGG啊。


關于攝像頭編程,大家也可以看看這組VCL組件DSPackDSPack是一套使用微軟Direct ShowDirectX技術的類和組件,設計工作于DirectX 9,支持系統Win9X, ME, 2000Windows xp
好了,就介紹這些了,至于視屏聊天怎么實現,就看你的了,無非是按數據壓縮傳輸給對方,顯示出來,不過話又說回來,看似簡單,實現起來還有些難度的。


上一篇:防止全局hook入侵Delphi版,2000以上系統適用(part1)

下一篇:用Delphi創建服務程序

發表評論 共有條評論
用戶名: 密碼:
驗證碼: 匿名發表
學習交流
熱門圖片

新聞熱點

疑難解答

圖片精選

網友關注

主站蜘蛛池模板: 蚌埠市| 永善县| 肥东县| 响水县| 桃园县| 晴隆县| 永胜县| 逊克县| 甘德县| 繁峙县| 菏泽市| 喜德县| 克拉玛依市| 长治县| 广汉市| 永善县| 当阳市| 长葛市| 台山市| 克东县| 霍林郭勒市| 沂水县| 赣榆县| 皮山县| 临湘市| 东城区| 德庆县| 安平县| 应城市| 临夏市| 孟州市| 雅江县| 和林格尔县| 衡山县| 会理县| 宁蒗| 婺源县| 安福县| 上蔡县| 阿克陶县| 邵武市|