unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls,Buttons, Menus, xTrayIcon;
type
TForm1 = class(TForm)
SaveBmp: TButton;
Button1: TButton;
Button2: TButton;
BitBtn1: TBitBtn;
xTrayIcon1: TxTrayIcon;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure SaveBMPClick(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormPaint(Sender: TObject);
function Get_Handle: THandle;
private
{ Private declarations }
hWndC: THandle;
CapturingAVI: bool; public
{ Public declarations }
end;
var
Form1: TForm1;
Flag: byte;
err: integer;
implementation
{$R *.DFM}
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_SET_PREVIEW = WM_CAP_START + 50;
const
WM_CAP_SET_PREVIEWRATE = WM_CAP_START + 52;
const
WM_CAP_EDIT_COPY = WM_CAP_START + 30;
const
WM_CAP_SET_CALLBACK_ERROR = WM_CAP_START + 2;
const
WM_CAP_SET_SCALE = WM_CAP_START + 53;
function capCreateCaptureWindowA(lpszWindowName: PCHAR;
dwStyle: longint;
x: integer;
y: integer;
nWidth: integer;
nHeight: integer;
ParentWin: HWND;
nId: integer): HWND;
stdcall external 'AVICAP32.DLL';
function TForm1.Get_Handle: THandle;
begin
Get_Handle:=hWndC;
end;
function capErrorCallbak(HWND: THandle; nID:integer; c:PChar):Integer; stdcall;
begin
If nID<>0 then err:=1;
end;
procedure TForm1.FormCreate(Sender: TObject);
var p: pointer;
begin
CapturingAVI := false;
hWndC := 0;
hWndC := capCreateCaptureWindowA('My Own Capture Window',
WS_CHILD or WS_VISIBLE,
100,
8,
320,
240,
Form1.Handle,
0);
if hWndC <> 0 then
begin
p:= Addr(capErrorCallbak);// Установим адрес Callback процедуры;
SendMessage(hWndC,WM_CAP_SET_CALLBACK_ERROR , 0, integer(p));
SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
SendMessage(hWndC, WM_CAP_SET_SCALE,1, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEWRATE,10, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
end;
end;
procedure TForm1.SaveBMPClick(Sender: TObject);
begin
if hWndC <> 0 then
begin
SendMessage(hWndC,
WM_CAP_SAVEDIB,
0,
longint(pchar('foto.bmp')));
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if hWndC <> 0 then SendMessage(hWndC,WM_CAP_START + 41, 0, 0);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if hWndC <> 0 then SendMessage(hWndC,WM_CAP_START + 42, 0, 0);
end;
procedure TForm1.N2Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.N1Click(Sender: TObject);
begin
Form1.Visible:=true;
if hWndC <> 0 then
begin
// SendMessage(hWndC, WM_CAP_DRIVER_CONNECT, 0, 0);
SendMessage(hWndC, WM_CAP_SET_PREVIEW, 1, 0);
end;
Flag:=1;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Form1.Visible:=false;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
if flag=0 then Form1.Visible:=false;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
if flag=0 then Form1.Visible:=false;
// messagebeep($ffffffff);
end;
end.