unit SkinnerBox1u;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Menus, VfW, ExtCtrls;
type
TForm1 =
class(TForm)
VideoPanel1: TPanel;
Image1: TImage;
MainMenu1: TMainMenu;
Datei1: TMenuItem;
Optionen1: TMenuItem;
Info1: TMenuItem;
KameraTreiber1: TMenuItem;
N1: TMenuItem;
KameraBilder1: TMenuItem;
StatusBar1: TStatusBar;
KameraBedienung: TPanel;
KameraStart: TButton;
KameraStop: TButton;
Foto: TButton;
procedure FormCreate(Sender: TObject);
procedure KameraStartClick(Sender: TObject);
procedure KameraStopClick(Sender: TObject);
procedure VideoPanel1Resize(Sender: TObject);
private
{ Private-Deklarationen }
procedure ChangeDriver(Sender: tObject);
public
{ Public-Deklarationen }
capHandle: THandle;
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
FileCounter : Word = 0;
Path :
String = '
';
capDriverNum: Integer;
procedure TForm1.FormCreate(Sender: TObject);
var
szDeviceName:
array [0..80]
of AnsiChar;
szDeviceVersion:
array [0..80]
of AnsiChar;
wIndex: Integer;
m: tMenuItem;
begin
capDriverNum:= -1;
for wIndex := 0
to 9
do
begin
if (capGetDriverDescription (wIndex, szDeviceName,
sizeof (szDeviceName), szDeviceVersion,
sizeof (szDeviceVersion)))
then
begin
inc(capDriverNum);
m := tMenuItem.Create(Form1.KameraTreiber1);
m.Caption := szDeviceName+'
- ('+szDeviceVersion+'
)';
m.Tag := wIndex;
m.OnClick := Form1.ChangeDriver;
if capDriverNum = 0
then m.Checked := True;
// Check first Item
m.RadioItem := True;
Form1.KameraTreiber1.Add(m);
end;
end;
if capDriverNum <= -1
then
begin
m := tMenuItem.Create(Form1.KameraTreiber1);
m.Caption := '
Kein Treiber gefunden';
// m.OnClick := Call Messagebox...
m.RadioItem := True;
m.Checked := True;
Form1.KameraTreiber1.Add(m);
end else
capDriverNum := 0;
// Select first Driver
Form1.DoubleBuffered := True;
end;
procedure TForm1.ChangeDriver(Sender: TObject);
var
DriverName:
String;
Idx: Integer;
begin
if Sender
is TMenuItem
then
begin
DriverName := (Sender
as TMenuItem).Caption;
idx := (Sender
as TMenuItem).Tag;
(Sender
as TMenuItem).Checked := True;
// messagebox(handle,PAnsiChar(DriverName +#9+IntToStr(idx)),'#',0);
if idx <> capDriverNum
then
begin
KameraStop.Click;
// Close old
end;
end;
end;
procedure TForm1.KameraStartClick(Sender: TObject);
begin
if capDriverNum <= -1
then
begin
Application.MessageBox('
Kein Capture-Treiber gefunden',
'
Sorry', MB_ICONSTOP + MB_OK);
Exit;
end;
// Init & Open Video Device
StatusBar1.SimpleText := '
Open Video Device... (' +
Format('
%d x %d', [VideoPanel1.Width, VideoPanel1.Height]) + '
)';
capHandle := capCreateCaptureWindow(PAnsiChar('
CapVideo'), WS_CHILD
or WS_VISIBLE,
Form1.VideoPanel1.Left, Form1.VideoPanel1.Top, Form1.VideoPanel1.Width,
Form1.VideoPanel1.Height, Form1.VideoPanel1.Handle, 0);
// If capHandle = nil then ... Fehler beim Init?
// Init the first Capture Driver 0
capDriverConnect(capHandle, capDriverNum);
// SendMessage(capHandle, WM_CAP_DRIVER_CONNECT, 0,
// Set Preview Rate 50 msec.
capPreviewRate(capHandle,50);
// SendMessage(capHandle, WM_CAP_SET_PREVIEWRATE, 20, 0);
capOverlay(capHandle, True);
// SendMessage(capHandle, WM_CAP_SET_OVERLAY, 1, 0);
capPreview(capHandle, True);
// SendMessage(capHandle, WM_CAP_SET_PREVIEW, 1, 0);
end;
procedure TForm1.KameraStopClick(Sender: TObject);
begin
if capDriverNum <= -1
then Exit;
// Close Video Device
StatusBar1.SimpleText := '
Close Video Device...';
capCaptureStop(capHandle);
capDriverDisconnect(CapHandle);
end;
procedure TForm1.VideoPanel1Resize(Sender: TObject);
begin
VideoPanel1.Caption := Format('
Video Capture Panel ( %d x %d )',
[VideoPanel1.Width, VideoPanel1.Height]);
end;
end.