Delphi控制摄像头操作 [操作系统入门]

  • Z时代
  • 2024-01-10
  • 分类：综合

编程

DELPHI控制摄像头操作可以使用TVideoCap控件，或直接使用MS的AVICAP32.DLL就可轻松的实现对摄像头编程。

首先常量定义和函数定义：

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; 添加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;

添加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; 

添加button3 ，caption为保存为BMP图像：

procedure TForm1.Button3Click(Sender: TObject);
begin
if hWndC <> 0 then begin
SendMessage(hWndC,WM_CAP_SAVEDIB,0,longint(pchar(‘c: est.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: est.avi‘)));
SendMessage(hWndC, WM_CAP_SEQUENCE, 0, 0);
end;
end; 

添加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; 

可以添加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虚拟摄像头。

关于摄像头编程，大家也可以看看这组VCL组件：DSPack，DSPack是一套使用微软Direct Show和DirectX技术的类和组件，设计工作于DirectX 9，支持系统Win9X, ME, 2000和Windows XP。

视屏聊天 按数据压缩传输给对方，显示出来，不是那么简单。

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, MPlayer;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Panel1: TPanel;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    OpenDialog1: TOpenDialog;
    MediaPlayer1: TMediaPlayer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  private

    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
   hWndC : THandle;

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}

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;

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: est.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: est.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.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;

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

end.

//= == =====================

object Form1: TForm1
  Left = 192
  Top = 114
  Width = 658
  Height = 422
  Caption = ‘摄像头操作‘
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = ‘MS Sans Serif‘
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 536
    Top = 8
    Width = 97
    Height = 41
    Caption = ‘激活摄像头‘
    TabOrder = 0
    OnClick = Button1Click
  end
  object Panel1: TPanel
    Left = 0
    Top = 0
    Width = 521
    Height = 385
    Caption = ‘摄像头尚未激活中‘
    TabOrder = 1
    object MediaPlayer1: TMediaPlayer
      Left = 200
      Top = 16
      Width = 253
      Height = 33
      TabOrder = 0
    end
  end
  object Button2: TButton
    Left = 536
    Top = 56
    Width = 97
    Height = 41
    Caption = ‘关闭摄像头‘
    TabOrder = 2
    OnClick = Button2Click
  end
  object Button3: TButton
    Left = 536
    Top = 112
    Width = 97
    Height = 41
    Caption = ‘保存为BMP图片‘
    TabOrder = 3
    OnClick = Button3Click
  end
  object Button4: TButton
    Left = 536
    Top = 160
    Width = 97
    Height = 41
    Caption = ‘开始录像‘
    TabOrder = 4
    OnClick = Button4Click
  end
  object Button5: TButton
    Left = 536
    Top = 208
    Width = 97
    Height = 41
    Caption = ‘停止录像‘
    TabOrder = 5
    OnClick = Button5Click
  end
  object Button6: TButton
    Left = 536
    Top = 320
    Width = 97
    Height = 41
    Caption = ‘退出‘
    TabOrder = 6
    OnClick = Button6Click
  end
  object Button7: TButton
    Left = 536
    Top = 256
    Width = 97
    Height = 49
    Caption = ‘加载视频‘
    TabOrder = 7
    OnClick = Button7Click
  end
  object OpenDialog1: TOpenDialog
    Left = 464
    Top = 24
  end
end

摘录自：Delphi摄像头操作 http://yxmhero1989.blog.163.com/blog/static/112157956201102703433980/

试写的Delphi摄像头照相（抓图）小软件  http://www.codefans.net/soft/8385.shtml
Delphi 激活摄像头  http://hi.baidu.com/warrially/blog
利用Delphi编程控制摄像头 http://www.haoxiai.net/bianchengyuyan/Delphi/84272.html
http://blog.csdn.net/walkershrek/archive/2007/12/04/1915440.aspx
关与Usb摄像头问题  http://group.gimoo.net/review/142849
MTPlay V1.0 摄像头视频捕捉程序  www.hackcode.com
用Delphi开发视频捕获(摄像头拍照)程序 http://www.delphibbs.com/keylife/iblog_show.asp?xid=15554
Delphi实现摄像头拍照能 http://www.xuedelphi.cn/wenzhang/mrjq/gjyy/2008/11/200811232621.htm
用Delphi控制摄像头编程（转载）http://blog.ednchina.com/999wjc/4230/message.aspx
http://blog.csdn.net/walkershrek/archive/2007/12/04/1915429.aspx
VB编写控制摄像头程序  http://down.bbs156.cn/exef1226.html
一个用VC写的视屏聊天工具(源代码) http://www.trydone.com/posts/list/301.page
GraghDialog.rar   http://www.hackchina.com/cont/182020

Delphi 控制摄像头操作

以上是 Delphi控制摄像头操作 [操作系统入门] 的全部内容， 来源链接： utcz.com/z/519438.html

回到顶部