フォーラム


ゲスト  

ようこそ ゲスト さん。このフォーラムに投稿するには 登録が必要です。

ページ: [1]
トピック: CameraComponent で使われているカメラを切り替える (Windows)
DEKO
管理者
投稿数: 2690
CameraComponent で使われているカメラを切り替える (Windows)
on: 2014/07/30 22:21 Wed

モバイルの場合には TCameraComponent.Kind プロパティで前面/背面カメラを切り替えられるのですが、Windows の場合には USB 外付けカメラが使える事もあって Kind プロパティでの変更はできない事が多いです。以下のユニットを使えばカメラを任意で切り替える事ができます。

[FMX.CameraComponentEx]
unit FMX.CameraComponentEx;

interface

uses
System.Classes, FMX.Media;

type
{ TCameraComponentHelper }
TCameraComponentHelper = class helper for TCameraComponent
private
procedure SetCameraDevice(const Value: TCaptureDevice);
function GetCameraDevice: TCaptureDevice;
public
property CameraDevice: TCaptureDevice read GetCameraDevice write SetCameraDevice;
end;

{ TCameraList }
TCameraList = class
private
FCamList: TStringList;
FCount: Integer;
function GetItems(Index: Integer): TCaptureDevice;
public
constructor Create;
destructor Destroy; override;
property Count: Integer read FCount;
property Items[Index: Integer]: TCaptureDevice read GetItems;
end;

implementation

{ TCameraComponentHelper }

function TCameraComponentHelper.GetCameraDevice: TCaptureDevice;
begin
result := Self.FDevice;
end;

procedure TCameraComponentHelper.SetCameraDevice(const Value: TCaptureDevice);
begin
Self.FDevice := TVideoCaptureDevice(Value);
end;

{ TCameraList }

constructor TCameraList.Create;
var
CaptureDeviceList: TCaptureDeviceList;
i: Integer;
begin
{$IFDEF MACOS}
DefaultSystemCodePage := 65001;
{$ENDIF}
FCamList := TStringList.Create;
CaptureDeviceList := TCaptureDeviceManager.Current.GetDevicesByMediaType(TMediaType.Video);
for i:=0 to CaptureDeviceList.Count-1 do
FCamList.Add(CaptureDeviceList[i].Name);
FCount := CaptureDeviceList.Count;
end;

destructor TCameraList.Destroy;
begin
FCamList.Free;
inherited;
end;

function TCameraList.GetItems(Index: Integer): TCaptureDevice;
begin
if (Index < 0) or (Index >= FCount) then
begin
result := nil;
Exit;
end;
result := TCaptureDeviceManager.Current.GetDevicesByName(FCamList[Index]);
end;

end.

 
使い方はこんな感じです。フォームには

  • Button1 (TButton)
  • Button2 (TButton)
  • Image1 (TImage)
  • CameraComponent1 (TCameraComponent)

が貼ってあります。

unit Unit1;

interface

uses
System.SysUtils, System.Types, System.UITypes, System.Rtti, System.Classes,
System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
FMX.StdCtrls, FMX.Media, FMX.Objects, FMX.ListBox, FMX.CameraComponentEx;

type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
Button2: TButton;
CameraComponent1: TCameraComponent;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure VideoCamera_SampleBufferSync;
procedure CameraComponent1SampleBufferReady(Sender: TObject;
const ATime: Int64);
private
{ private 宣言 }
FCurrentIndex: Integer;
CameraList: TCameraList;
public
{ public 宣言 }
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.FormCreate(Sender: TObject);
// フォーム作成時
begin
FCurrentIndex := -1;
CameraList := TCameraList.Create;
// カメラがあればインデックスを 0 に
if CameraList.Count > 0 then
FCurrentIndex := 0;
end;

procedure TForm1.FormDestroy(Sender: TObject);
// フォーム破棄時
begin
if CameraComponent1.Active then
CameraComponent1.Active := False;
CameraList.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
// ボタン 1 押下処理
begin
// カメラの有効 / 無効の切り替え
if CameraList.Count = 0 then
Exit;
CameraComponent1.Active := not CameraComponent1.Active;
end;

procedure TForm1.Button2Click(Sender: TObject);
// ボタン 2 押下処理
var
IsActive: Boolean;
begin
if CameraList.Count = 0 then
Exit;
// カメラの切り替え (トグル)
IsActive := CameraComponent1.Active;
CameraComponent1.Active := False;
Inc(FCurrentIndex);
FCurrentIndex := FCurrentIndex mod CameraList.Count;
CameraComponent1.CameraDevice := CameraList.Items[FCurrentIndex];
if IsActive then
CameraComponent1.Active := True;
end;

procedure TForm1.CameraComponent1SampleBufferReady(Sender: TObject;
const ATime: Int64);
// カメラ画像の取得
begin
TThread.Synchronize(TThread.CurrentThread, VideoCamera_SampleBufferSync);
end;

procedure TForm1.VideoCamera_SampleBufferSync;
// カメラ画像の取得
begin
CameraComponent1.SampleBufferToBitmap(Image1.Bitmap, True);
end;
end.

 
理屈上は OS X でも動作するハズですが、動作確認できる環境を持っていないので Windows 用としておきます。

See Also:
[TCameraComponent (FireMonkey Tips)]
http://ht-deko.minim.ne.jp/techf001_additional.html#TCameraComponent

ページ: [1]
WP Forum Server by ForumPress | LucidCrew
バージョン: 1.7.5 ; ページロード: 0.034 sec.