unit uMain;

interface

uses

  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

  Dialogs, ExtCtrls, StdCtrls, RzPanel, RzButton;

type

  TFrmMain = class(TForm)

    gbScreen: TRzGroupBox;

    gbOperation: TRzGroupBox;

    btnStart: TRzBitBtn;

    btnStop: TRzBitBtn;

    btnSaveBMP: TRzBitBtn;

    btnStartR: TRzBitBtn;

    btnSaveAVI: TRzBitBtn;

    pMain: TPanel;

    procedure btnStartClick(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

    procedure btnStopClick(Sender: TObject);

    procedure btnSaveBMPClick(Sender: TObject);

    procedure btnStartRClick(Sender: TObject);

    procedure btnSaveAVIClick(Sender: TObject);

  private

    { Private declarations }

    hWndC: THandle;

  public

    { Public declarations }

  end;

var

  FrmMain: TFrmMain;

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';

implementation

{$R *.dfm}

procedure TFrmMain.btnStartClick(Sender: TObject);

begin

  //开始拍摄

  hWndC := capCreateCaptureWindowA('My Own Capture Window', WS_CHILD or WS_VISIBLE, pMain.Left, pMain.Top, pMain.Width, pMain.Height, FrmMain.Handle, 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;

end;

procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  //程序退出时，自动关闭摄像头

  if hWndC <> 0 then

  begin

    SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);

  end;

end;

procedure TFrmMain.btnStopClick(Sender: TObject);

begin

  //关闭摄像头

  if hWndC <> 0 then

  begin

    SendMessage(hWndC, WM_CAP_DRIVER_DISCONNECT, 0, 0);

    hWndC := 0;

  end;

end;

procedure TFrmMain.btnSaveBMPClick(Sender: TObject);

begin

  //保存BMP

  if hWndC <> 0 then

  begin

    SendMessage(hWndC, WM_CAP_SAVEDIB, 0, longint(pchar('D:/1.bmp')));

  end;

end;

procedure TFrmMain.btnStartRClick(Sender: TObject);

begin

  //开始录制AVI视频

  if hWndC <> 0 then

  begin

    SendMessage(hWndC, WM_CAP_FILE_SET_CAPTURE_FILEA, 0, Longint(pchar('c:/test.avi')));

    SendMessage(hWndC, WM_CAP_SEQUENCE, 0, 0);

  end;

end;

procedure TFrmMain.btnSaveAVIClick(Sender: TObject);

begin

  //停止录制并保存AVI视频

  if hWndC <> 0 then

  begin

    SendMessage(hWndC, WM_CAP_STOP, 0, 0);

  end;

end;

end.