Delphi XE5のFireMonkey のオーディオ/ビデオ機能にある「ビデオ キャプチャ」を改造して、フォームのサイズに合わせて動画が表示する

Delphi XE5のFireMonkey のオーディオ/ビデオ機能にある「ビデオ キャプチャ」を改造して、フォームのサイズに合わせて動画が表示されるようにしてみました。

TVideoCaptureDeviceクラスのSampleBufferToBitmapメソッドはキャプチャした画像を第1引数のABitmapに設定します。
第2引数ASetSizeがTrueの場合、キャプチャした画像はABitmapのサイズに変更されます。

type
  TVideoCaptureDevice = class(TCaptureDevice)
  public
    procedure SampleBufferToBitmap(const ABitmap: TBitmap; const ASetSize: Boolean);

第2引数ABitmapのサイズがキャプチャした画像よりも小さいときは、ABitmapのサイズに合わせてキャプチャ画像は縮小されます。
しかし、ABitmapのサイズがキャプチャ画像よりも大きい場合は、キャプチャ画像は拡大されません。

そこで先日の記事「Delphi XE5でFireMonkeyのTBitmapの画像サイズを変更する」で書いた画像サイズを拡大する方法を使用します。

/// <summary>
/// サイズを変更した画像を取得する
/// </summary>
/// <param name="Bitmap">
/// 元画像
/// </param>
/// <param name="Height">
/// 新しい画像の高さ
/// </param>
/// <param name="Width">
/// 新しい画像の幅
/// </param>
function ResizeImage(Bitmap: TBitmap; Height, Width: Integer): TBitmap;
var
  SrcRect: TRectF;
  DstRect: TRectF;
begin
  SrcRect.Left := 0;
  SrcRect.Top := 0;
  SrcRect.Bottom := Bitmap.Height;
  SrcRect.Right := Bitmap.Width;

  DstRect.Left := 0;
  DstRect.Top := 0;
  DstRect.Bottom := Height;
  DstRect.Right := Width;

  Result := TBitmap.Create;
  Result.Height := Height;
  Result.Width := Width;
  Result.Canvas.DrawBitmap(Bitmap, SrcRect, DstRect, 1.0);
end;

SampleBufferSyncを次のように変更します。

procedure TForm1.SampleBufferSync;
var
  Bitmap1, Bitmap2: TBitmap;
begin
  Bitmap1:= TBitmap.Create;
  VideoCamera.SampleBufferToBitmap(Bitmap1, true);
  Bitmap2 := ResizeImage(Bitmap1, Trunc(Image1.Height), Trunc(Image1.Width));
  Image1.Bitmap.Assign(Bitmap2);
  Bitmap1.Free;
  Bitmap2.Free;
end;

サイズを変更した画像はなぜか真っ黒になりました。

試行錯誤の結果、次のコードをユニットの最後に追加することで、画像サイズを変更して表示できるようになりました。

initialization
  GlobalUseDirect2D := False;

最後に、今回作成したプロジェクトを公開します。

プロジェクト一式をダウンロード

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください