unit Unit2;
interface
uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Ani, FMX.Layouts, FMX.Gestures,
FMX.StdCtrls, FMX.ListBox, FMX.Media, FMX.Objects;
type
TForm2 =
class(TForm)
StyleBook1: TStyleBook;
ToolbarHolder: TLayout;
ToolbarPopup: TPopup;
ToolbarPopupAnimation: TFloatAnimation;
ToolBar1: TToolBar;
ToolbarApplyButton: TButton;
ToolbarCloseButton: TButton;
ToolbarAddButton: TButton;
Layout1: TLayout;
StartButton: TButton;
ComboBox1: TComboBox;
Image1: TImage;
procedure ToolbarCloseButtonClick(Sender: TObject);
procedure FormGesture(Sender: TObject;
const EventInfo: TGestureEventInfo;
var Handled: Boolean);
procedure FormKeyDown(Sender: TObject;
var Key: Word;
var KeyChar: Char;
Shift: TShiftState);
procedure StartButtonClick(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FGestureOrigin: TPointF;
FGestureInProgress: Boolean;
{ Private-Deklarationen }
procedure ShowToolbar(AShow: Boolean);
public
{ Public-Deklarationen }
VideoCamera: TVideoCaptureDevice;
procedure SampleBufferSync;
procedure SampleBufferReady(Sender: TObject;
const ATime: TMediaTime);
end;
var
Form2: TForm2;
implementation
{$R *.fmx}
procedure TForm2.FormKeyDown(Sender: TObject;
var Key: Word;
var KeyChar: Char; Shift: TShiftState);
begin
if Key = vkEscape
then
ShowToolbar(
not ToolbarPopup.IsOpen);
end;
procedure TForm2.ToolbarCloseButtonClick(Sender: TObject);
begin
Application.Terminate;
end;
procedure TForm2.ComboBox1Change(Sender: TObject);
begin
VideoCamera := TVideoCaptureDevice(TCaptureDeviceManager.Current.GetDevicesByName(ComboBox1.Selected.Text));
if (VideoCamera <>
nil)
then begin
StartButton.Enabled := true;
end;
end;
procedure TForm2.FormCreate(Sender: TObject);
var
DeviceList: TCaptureDeviceList;
i: integer;
begin
DeviceList := TCaptureDeviceManager.Current.GetDevicesByMediaType(TMediaType.Video);
for i := 0
to DeviceList.Count - 1
do begin
ComboBox1.Items.Add(DeviceList[i].
Name);
end;
end;
procedure TForm2.FormGesture(Sender: TObject;
const
EventInfo: TGestureEventInfo;
var Handled: Boolean);
var
DX, DY : Single;
begin
if EventInfo.GestureID = igiPan
then
begin
if (TInteractiveGestureFlag.gfBegin
in EventInfo.Flags)
and ((Sender = ToolbarPopup)
or (EventInfo.Location.Y > (ClientHeight - 70)))
then
begin
FGestureOrigin := EventInfo.Location;
FGestureInProgress := True;
end;
if FGestureInProgress
and (TInteractiveGestureFlag.gfEnd
in EventInfo.Flags)
then
begin
FGestureInProgress := False;
DX := EventInfo.Location.X - FGestureOrigin.X;
DY := EventInfo.Location.Y - FGestureOrigin.Y;
if (Abs(DY) > Abs(DX))
then
ShowToolbar(DY < 0);
end;
end
end;
procedure TForm2.SampleBufferReady(Sender: TObject;
const ATime: TMediaTime);
begin
TThread.Synchronize(TThread.CurrentThread, SampleBufferSync);
//Resize the image so that the video is buffered in its original size
Image1.Width:=Image1.Bitmap.Width;
Image1.Height:=Image1.Bitmap.Height;
end;
procedure TForm2.SampleBufferSync;
begin
VideoCamera.SampleBufferToBitmap(Image1.Bitmap, true);
end;
procedure TForm2.ShowToolbar(AShow: Boolean);
begin
ToolbarPopup.Width := ClientWidth;
ToolbarPopup.PlacementRectangle.Rect := TRectF.Create(0, ClientHeight-ToolbarPopup.Height, ClientWidth-1, ClientHeight-1);
ToolbarPopupAnimation.StartValue := ToolbarPopup.Height;
ToolbarPopupAnimation.StopValue := 0;
ToolbarPopup.IsOpen := AShow;
end;
procedure TForm2.StartButtonClick(Sender: TObject);
begin
if (VideoCamera <>
nil)
then
begin
if (VideoCamera.State = TCaptureDeviceState.Stopped)
then
begin
VideoCamera.OnSampleBufferReady := SampleBufferReady;
VideoCamera.StartCapture;
StartButton.Text := '
Stop';
end
else
begin
VideoCamera.StopCapture;
StartButton.Text := '
Start';
end;
end
else
begin
Caption := '
Video capture devices not available.';
end;
end;
end.