unit WebcamMain;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Media, FMX.Objects,
FMX.Controls.Presentation, FMX.StdCtrls;
type
TForm1 =
class(TForm)
imgCamera: TImage;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private-Deklarationen }
fVideoCamera: TVideoCaptureDevice;
public
{ Public-Deklarationen }
procedure GetCamNameList(CamNames:TStrings);
function VideoCamera: TVideoCaptureDevice;
procedure SampleBufferReady(Sender: TObject;
const ATime: TMediaTime);
end;
var
Form1: TForm1;
implementation
{$R *.fmx}
//Test funktion
procedure TForm1.GetCamNameList(CamNames:TStrings);
// Listet genau eine Camera auf!! "USB CAMERA"
var
I: Integer;
D: TCaptureDevice;
begin
CamNames.Clear;
for I := 0
to TCaptureDeviceManager.Current.Count - 1
do
begin
D := TCaptureDeviceManager.Current.Devices[I];
if (D.MediaType = TMediaType.Video)
and (D
is TVideoCaptureDevice)
then
begin
CamNames.addObject(d.
Name, d);
end;
end;
End;
function TForm1.VideoCamera: TVideoCaptureDevice;
var
I: Integer;
D: TCaptureDevice;
begin
Result := FVideoCamera;
if (Result =
nil)
and (TCaptureDeviceManager.Current <>
nil)
then
begin
for I := 0
to TCaptureDeviceManager.Current.Count - 1
do
begin
D := TCaptureDeviceManager.Current.Devices[I];
if (D.MediaType = TMediaType.Video)
and
(D
is TVideoCaptureDevice)
and
D.IsDefault
then
begin
Result := TVideoCaptureDevice(D);
FVideoCamera := Result;
//hab das korrigiert...
Break;
end;
end;
{if Result = nil then
Begin
FVideoCamera := Result;
Result := TCaptureDeviceManager.Current.DefaultVideoCaptureDevice;
End;}
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if VideoCamera <>
nil then
begin
VideoCamera.OnSampleBufferReady := SampleBufferReady;
VideoCamera.StartCapture;
end
end;
procedure TForm1.SampleBufferReady(Sender: TObject;
const ATime: TMediaTime);
begin
TThread.synchronize(TThread.CurrentThread,
Procedure
Begin
VideoCamera.SampleBufferToBitmap(imgCamera.Bitmap, true);
End
);
end;
end.