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