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;
最後に、今回作成したプロジェクトを公開します。