フォーラム


ゲスト  

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

ページ: [1]
トピック: DSPack を使ったカメラ (静止画) クラス
DEKO
管理者
投稿数: 2644
DSPack を使ったカメラ (静止画) クラス
on: 2013/04/08 21:04 Mon

DSPack を使ったカメラ (静止画) クラスです。

// -----------------------------------------------------------------------------
// DSPack を使ったカメラ (静止画) クラス
// -----------------------------------------------------------------------------
unit StillCam;

interface

uses
SysUtils, Types, DSPack, DXSUtil, DirectShow9, Graphics, Jpeg;

type

{ TStillCamera }
TStillCamera = class(TObject)
private
FActive: Boolean;
FBaseDir: string;
FDeviceIndex: Integer;
FDevices: TStringDynArray;
FFilter: TFilter;
FFilterGraph: TFilterGraph;
FSampleGrabber: TSampleGrabber;
FSysDevEnum: TSysDevEnum;
FVideoWindow: TVideoWindow;
procedure SetActive(const Value: Boolean);
procedure SetVideoWindow(const Value: TVideoWindow);
procedure SetDeviceIndex(const Value: Integer);
public
constructor Create;
destructor Destroy; override; // 使用するカメラデバイスのインデックス
property Devices: TStringDynArray read FDevices; // カメラデバイスの一覧
procedure GetBitmap(var Bitmap: TBitmap); // キャプチャ画像を Bitmap へ取り込み
procedure Capture; overload; // キャプチャ画像を連番で Jpeg 画像として保存
procedure Capture(const FileName: TFileName); overload; // キャプチャ画像に名前を付けて Jpeg 画像で保存
property Active: Boolean read FActive write SetActive; // カメラの有効/無効
property BaseDir: string read FBaseDir write FBaseDir; // 画像保存先
property DeviceIndex: Integer read FDeviceIndex write SetDeviceIndex; // デバイス (カメラ) のインデックス
property FilterGraph: TFilterGraph read FFilterGraph; // Fileter Graph
property VideoWindow: TVideoWindow read FVideoWindow write SetVideoWindow; // プレビュー用のビデオウィンドウ
end;

implementation

{ TStillCamera }

constructor TStillCamera.Create;
// コンストラクタ
var
i: Integer;
begin
FBaseDir := '';
FVideoWindow := nil;
// FilterGraph
FFilterGraph := TFilterGraph.Create(nil);
with FFilterGraph do
begin
GraphEdit := True;
LinearVolume := True;
Mode := gmCapture;
end;
// Filter
FFilter := TFilter.Create(nil);
with FFilter do
FilterGraph := FFilterGraph;
// SampleGrabber
FSampleGrabber := TSampleGrabber.Create(nil);
with FSampleGrabber do
FilterGraph := FFilterGraph;
// Devices
FDeviceIndex := -1;
FSysDevEnum := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
if FSysDevEnum.CountFilters > 0 then
begin
SetLength(FDevices, FSysDevEnum.CountFilters);
for i:=0 to FSysDevEnum.CountFilters-1 do
Devices[i] := FSysDevEnum.Filters[i].FriendlyName;
DeviceIndex := 0;
end;
end;

destructor TStillCamera.Destroy;
// デストラクタ
begin
FFilterGraph.ClearGraph;
FFilterGraph.Active := False;
FSysDevEnum.Free;
FSampleGrabber.Free;
FFilter.Free;
FFilterGraph.Free;
inherited;
end;

procedure TStillCamera.SetActive(const Value: Boolean);
// カメラの有効/無効
begin
if FActive = Value then
Exit;
if FDeviceIndex = -1 then
Exit;
FFilterGraph.ClearGraph;
FFilterGraph.Active := False;
if Value then
begin
FFilter.BaseFilter.Moniker := FSysDevEnum.GetMoniker(FDeviceIndex);
FFilterGraph.Active := True;
with FFilterGraph as ICaptureGraphBuilder2 do
RenderStream(@PIN_CATEGORY_PREVIEW, nil, FFilter as IBaseFilter, FSampleGrabber as IBaseFilter, FVideoWindow as IBaseFilter);
FFilterGraph.Play;
end;
FActive := Value;
end;

procedure TStillCamera.SetDeviceIndex(const Value: Integer);
// デバイス (カメラ) のインデックスを設定
begin
if FDeviceIndex = Value then
Exit;
FDeviceIndex := Value;
end;

procedure TStillCamera.SetVideoWindow(const Value: TVideoWindow);
// プレビュー用のビデオウィンドウを設定
begin
FVideoWindow := Value;
if Assigned(FVideoWindow) then
FVideoWindow.FilterGraph := FFilterGraph;
end;

procedure TStillCamera.GetBitmap(var Bitmap: TBitmap);
// キャプチャ画像を Bitmap へ取り込み
begin
FSampleGrabber.GetBitmap(Bitmap);
end;

procedure TStillCamera.Capture;
// キャプチャ画像を連番で Jpeg 画像として保存
begin
Capture(FormatDateTime('"img"YYYYMMDDHHNNSS".jpg"', Now));
end;

procedure TStillCamera.Capture(const FileName: TFileName);
// キャプチャ画像に名前を付けて Jpeg 画像で保存
var
Bitmap: TBitmap;
Jpeg: TJpegImage;
dFileName: TFileName;
begin
Bitmap := TBitmap.Create;
Jpeg := TJPEGImage.Create;
try
FSampleGrabber.GetBitmap(Bitmap);
Jpeg.Assign(Bitmap);
dFileName := FileName;
if FBaseDir <> '' then
dFileName := IncludeTrailingPathDelimiter(FBaseDir) + dFileName;
Jpeg.SaveToFile(dFileName);
finally
Jpeg.Free;
Bitmap.Free;
end;
end;
end.

 
使い方は、Button ([Standard] カテゴリ) と VideoWindow ([DSPack] カテゴリ) をフォームに貼って、

uses
..., StillCam;


...

type
TForm1 = class(TForm)
VideoWindow1: TVideoWindow;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private 宣言 }
StillCamera: TStillCamera;
public
{ Public 宣言 }
end;

...

procedure TForm1.FormCreate(Sender: TObject);
begin
StillCamera := TStillCamera.Create;
StillCamera.VideoWindow := VideoWindow1;
StillCamera.Active := True;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
StillCamera.Capture;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
StillCamera.Free;
end;

 
ボタンを押すと実行ファイルのある場所に日付の連番で *.jpg を生成します。このクラスでもそこそこ実用的なのですが、もうちょっと凝ってみると面白いと思います。

See Also:
[DSPack をインストールするには? (主に Delphi XE)]
http://ht-deko.minim.ne.jp/tech062.html

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