Delphi控制摄像头

文毓發表於 2020-12-18 15:59:00

Delphi对摄像头的控制很简单，在System，windows和messages三个单元内已定义了所有的底层消息函数，我们只需要合理的调用它们就行了。我把摄像头的有关操作做成一个控件，这样就可以拖动窗体上直接使用了。
<div class="cnblogs_code">
<pre>{************************************
* 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', );
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.</pre>
</div>
 

</div>
<div id="MySignature" role="contentinfo">
好的代码像粥一样，都是用时间熬出来的 
来源：https://www.cnblogs.com/jijm123/p/14155388.html

頁: [1]

琼殿技术论坛's Archiver

Delphi控制摄像头