Delphi控制摄像头

Delphi对摄像头的控制很简单，在System，windows和messages三个单元内已定义了所有的底层消息函数，我们只需要合理的调用它们就行了。我把摄像头的有关操作做成一个控件，这样就可以拖动窗体上直接使用了。

{************************************

* Camera Control for Delphi7 *

* Made by Rarnu *

* Credit 2006.08.27 *

* http://rarnu.ik8.com
*

************************************}

unit RaCameraEye;

interface

uses

SysUtils, Classes, Controls, Windows, Messages;

{事件声明}

type

{开始摄像事件}

TOnStart = procedure(Sender: TObject) of object;

{停止摄像事件}

TOnStop = procedure(Sender: TObject) of object;

{开始录像事件}

TOnStartRecord = procedure(Sender: TObject) of object;

{停止录像事件}

TOnStopRecord = procedure(Sender: TObject) of object;

type

TRaCameraEye = class(TComponent)

private

{图像显示容器}

fDisplay: TWinControl;

{事件关联变量}

fOnStart: TOnStart;

fOnStartRecord: TOnStartRecord;

fOnStop: TOnStop;

fOnStopRecord: TOnStopRecord;

protected

public

{构造&析构，由TComponent类覆盖而来}

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

{开始摄像}

procedure Start;

{停止摄像}

procedure Stop;

{截图并保存到bmp}

procedure SaveToBmp(FileName: string);

{录制AVI}

procedure RecordToAVI(FileName: string);

{停止录制}

procedure StopRecord;

published

property Display: TWinControl read fDisplay write fDisplay;

property OnStart: TOnStart read fOnStart write fOnStart;

property OnStop: TOnStop read fOnStop write fOnStop;

property OnStartRecord: TOnStartRecord read fOnStartRecord write fOnStartRecord;

property OnStopRecord: TOnStopRecord read fOnStopRecord write fOnStopRecord;

end;

{消息常量声明}

const

WM_CAP_START = WM_USER;

WM_CAP_STOP = WM_CAP_START + 68;

WM_CAP_DRIVER_CONNECT = WM_CAP_START + 10;

WM_CAP_DRIVER_DISCONNECT = WM_CAP_START + 11;

WM_CAP_SAVEDIB = WM_CAP_START + 25;

WM_CAP_GRAB_FRAME = WM_CAP_START + 60;

WM_CAP_SEQUENCE = WM_CAP_START + 62;

WM_CAP_FILE_SET_CAPTURE_FILEA = WM_CAP_START + 20;

WM_CAP_SEQUENCE_NOFILE = WM_CAP_START + 63;

WM_CAP_SET_OVERLAY = WM_CAP_START + 51;

WM_CAP_SET_PREVIEW = WM_CAP_START + 50;

WM_CAP_SET_CALLBACK_VIDEOSTREAM = WM_CAP_START + 6;

WM_CAP_SET_CALLBACK_ERROR = WM_CAP_START + 2;

WM_CAP_SET_CALLBACK_STATUSA = WM_CAP_START + 3;

WM_CAP_SET_CALLBACK_FRAME = WM_CAP_START + 5;

WM_CAP_SET_SCALE = WM_CAP_START + 53;

WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;

{声明动态函数，此函数从DLL中调入，动态判断是否可用}

type

TFunCap = function(

lpszWindowName: PCHAR;

dwStyle: longint;

x: integer;

y: integer;

nWidth: integer;

nHeight: integer;

ParentWin: HWND;

nId: integer): HWND; stdcall;

{全局变量声明}

var

hWndC: THandle;

FunCap: TFunCap;

DllHandle: THandle;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('Rarnu Components', [TRaCameraEye]);

end;

{ TRaCameraEye }

constructor TRaCameraEye.Create(AOwner: TComponent);

var

FPointer: Pointer;{函数指针}

begin

inherited Create(AOwner);

fDisplay := nil;

{通过DLL调入，如果DLL不存在，表示没有驱动}

DllHandle := LoadLibrary('AVICAP32.DLL');

if DllHandle <= 0 then

begin

MessageBox(TWinControl(Owner).Handle, '未安装摄像头驱动或驱动程序无效，不能使用此控件！', '出错', MB_OK or MB_ICONERROR);

Destroy;{释放控件}

Exit;

end;

{函数指针指向指定API}

FPointer := GetProcAddress(DllHandle, 'capCreateCaptureWindowA');

{恢复函数指针到实体函数}

FunCap := TFunCap(FPointer);

end;

destructor TRaCameraEye.Destroy;

begin

StopRecord;

Stop;

fDisplay := nil;

{如果已加载DLL，则释放掉}

if DllHandle > 0 then

FreeLibrary(DllHandle);

inherited Destroy;

end;

procedure TRaCameraEye.RecordToAVI(FileName: string);

begin

if hWndC <> 0 then

begin

SendMessage(hWndC, WM_CAP_FILE_SET_CAPTURE_FILEA, 0, longint(PCHAR(FileName)));

SendMessage(hWndC, WM_CAP_SEQUENCE, 0, 0);

if Assigned(OnStartRecord) then

OnStartRecord(Self);

end;

end;

procedure TRaCameraEye.SaveToBmp(FileName: string);

begin

if hWndC <> 0 then

SendMessage(hWndC, WM_CAP_SAVEDIB, 0, longint(PCHAR(FileName)));

end;

procedure TRaCameraEye.Start;

var

OHandle: THandle;

begin

if fDisplay = nil then Exit;

OHandle := TWinControl(Owner).Handle;

{动态函数控制摄像头}

hWndC := FunCap(

'My Own Capture Window',

WS_CHILD or WS_VISIBLE,

{规定显示范围}

fDisplay.Left, fDisplay.Top, fDisplay.Width, fDisplay.Height,

OHandle, 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;

if Assigned(OnStart) then

OnStart(Self);

end;

procedure TRaCameraEye.Stop;

begin

if hWndC <> 0 then

begin

SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);

hWndC := 0;

if Assigned(OnStop) then

OnStop(Self);

end;

end;

procedure TRaCameraEye.StopRecord;

begin

if hWndC <> 0 then

begin

SendMessage(hWndC, WM_CAP_STOP, 0, 0);

if Assigned(OnStopRecord) then

OnStopRecord(Self);

end;

end;

end.