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.