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.
|
请发表评论