Delphi11でDesktop Duplicationを使ってモニタをキャプチャする(FMX版)

# はじめに
Desktop Duplication API はWindows8から利用できるモニタ単位で画面をキャプチャするAPIです。
これをDelphiで利用したいと思います。
このAPIではマウスカーソルを取得するには手数がかかります。今回はマウスカーソルなしでのキャプチャをやります。
今回はFMXで実装します。

# 開発環境
- Delphi 11.2
インライン変数宣言を使っていますので，10.3以降で利用できると思います。
- Windows 10(21H2)

# 準備するもの
:::note info
既にVCLでの実装をされている方は，編集をしたファイルがそのまま使えます。
:::

Desktop Duplication APIを利用するためのヘッダーファイルをダウンロードしておきます。

https://github.com/CMCHTPC/DelphiDX12

より，ダウンロードします。このヘッダーファイルのライセンスは[Apache License 2.0](http://www.apache.org/licenses/LICENSE-2.0)です。

# プロジェクトを作成
## 新規プロジェクトの作成
**ファイル－新規作成ーマルチデバイス アプリケーション - Delphi** を選択し，空のアプリケーションを選択して新規プロジェクトを作成し，保存します。
ターゲットプラットフォームはWindows 32bitと64bitだけ残して，後は削除してください。
## DX12ヘッダーファイルの追加

:::note info
既にVCLでの実装をされている方は，作業する必要はありません。編集したものをFMXでそのまま利用できます。
:::

GitHubよりダウンロードしたDelphiDX12ヘッダーのZIPファイルにあるUnitフォルダから以下のファイルを新規プロジェクトと同じフォルダにコピーし，新規プロジェクトに追加します。
- DX12.D3D11.pas
- DX12.D3DCommon.pas
- DX12.DXGI.pas
- DX12.DXGI1_2.pas

## DX12ヘッダーファイルの修正

:::note info
既にVCLでの実装をされている方は，作業する必要はありません。編集したものをFMXでそのまま利用できます。
:::

IDEで追加したファイルを開くと，E2026エラーが8か所で出ますので修正します。
![Snap0011.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/33902/1c22785c-a5c7-f353-c704-c21ce7181231.png)

このエラーの詳しい回避方法については [Delphi 10.3以降: 列挙型で順序値を割り当てたときに起きるE2026エラーを回避する](https://qiita.com/p_kato/private/275c67e17c7d86f16a26) でご確認ください。
以下の3つのファイルについて以下のように修正します。
```DX12.D3D11.pas
1790:        D3D11_STANDARD_MULTISAMPLE_PATTERN = int32($ffffffff),
1791:        D3D11_CENTER_MULTISAMPLE_PATTERN = int32($fffffffe)
2339:        D3D11_VIDEO_PROCESSOR_ITELECINE_CAPS_OTHER = int32($80000000)
2703:        D3D11_BUS_IMPL_MODIFIER_NON_STANDARD = int32($80000000)
```
```DX12.DXGI.pas
260:    DXGI_FORMAT_FORCE_UINT = INT32($ffffffff));
433:    DXGI_COLOR_SPACE_CUSTOM = INT32($FFFFFFFF));
684:    DXGI_ADAPTER_FLAG_FORCE_DWORD = INT32($ffffffff)
```
```DX12.DXGI1_2.pas
109:        DXGI_ALPHA_MODE_FORCE_DWORD = INT32($ffffffff)
```
修正が済んだら，構文チェックをして修正がうまくできたか確認してください。

## ヘッダファイルを利用するクラスを作成
**ファイルー新規作成ーユニット - Delphi** でユニットを作成し，**uFMXDesktopDuplication.pas**として保存します。
以下のように編集してください。
```uFMXDesktopDuplication.pas
unit uFMXDesktopDuplication;

interface

uses
  System.Types, System.UITypes,
  Winapi.Windows,
  DX12.DXGI, DX12.DXGI1_2, DX12.D3DCommon, DX12.D3D11,
  FMX.Utils, FMX.Graphics;

type
  TFMXDesktopDuplication = class(TObject)
  private
    { Private 宣言 }
    FFeatureLevel:TD3D_FEATURE_LEVEL;
    FDuplicate:   IDXGIOutputDuplication;
    FDevice:      ID3D11Device;
    FContext:     ID3D11DeviceContext;
    FisCreated:   boolean;
    FBitmap:      TBitmap;
  public
    constructor CreateParamMonitor(AMonitorNum:integer);
    destructor Destroy; override;
    function  FrameGet: Boolean;
    property isCreated:boolean read FisCreated;
    property Bitmap:TBitmap read FBitmap;
  end;

implementation

{ TThreadDesktopDuplication }

constructor TFMXDesktopDuplication.CreateParamMonitor(AMonitorNum: integer);
var
  LDevice:  IDXGIDevice;
  LAdapter: IDXGIAdapter;
  LOutput:  IDXGIOutput;
  LOutput1: IDXGIOutput1;
begin
  FisCreated:=False;
  if Failed(D3D11CreateDevice(               // https://learn.microsoft.com/en-us/windows/win32/api/d3d11/nf-d3d11-d3d11createdevice
    nil,                                     // *pAdapter,
    D3D_DRIVER_TYPE_HARDWARE,                // DriverType,
    0,                                       // Software,
    Ord(D3D11_CREATE_DEVICE_SINGLETHREADED), // Flags,
    nil,                                     // *pFeatureLevels,
    0,                                       // FeatureLevels,
    D3D11_SDK_VERSION,                       // SDKVersion,
    FDevice,                                 // **ppDevice,
    FFeatureLevel,                           // *pFeatureLevel,
    @FContext)                               // **ppImmediateContext
  ) then Exit;
  if Failed(FDevice.QueryInterface(          // System.IInterface.QueryInterface
    IID_IDXGIDevice,                         // const IID: TGUID;
    LDevice)                                 // out Obj
  ) then Exit;
  if Failed(LDevice.GetParent(               // DX12.DXGI.IDXGIObject.GetParent
    IID_IDXGIAdapter,                        // const riid: TGUID
    Pointer(LAdapter))                       // out ppParent: Pointer
  ) then Exit;
  if Failed(LAdapter.EnumOutputs(            // DX12.DXGI.IDXGIAdapter.EnumOutputs
    AMonitorNum,                             // Output: UINT  ( Monitor )
    LOutput)                                 // out ppOutput: IDXGIOutput
  ) then Exit;
  if Failed(LOutput.QueryInterface(          // System.IInterface.QueryInterface
    IID_IDXGIOutput1,                        // const IID: TGUID;
    LOutput1)                                // out Obj
  ) then Exit;
  if Failed(LOutput1.DuplicateOutput(        // DX12.DXGI1_2.IDXGIOutput1.DuplicateOutput
    FDevice,                                 // pDevice: IUnknown
    FDuplicate)                              // out ppOutputDuplication: IDXGIOutputDuplication
  ) then Exit;
  FBitmap:=TBitmap.Create;
  FisCreated:=True;
end;

destructor TFMXDesktopDuplication.Destroy;
begin
  FBitmap.Free;
  inherited;
end;

function TFMXDesktopDuplication.FrameGet: Boolean;
var
  LResource: IDXGIResource;
  LFrameInfo:TDXGI_OUTDUPL_FRAME_INFO;
  LTx2D:     ID3D11Texture2D;
begin
  Result:=False;
  if Failed(FDuplicate.AcquireNextFrame(0, LFrameInfo, LResource)) then Exit;
  if LFrameInfo.TotalMetadataBufferSize > 0 then begin
    if Failed(LResource.QueryInterface(IID_ID3D11Texture2D, LTx2D)) then Exit;
    // FBitmapに描画
    var LDesc:     TD3D11_TEXTURE2D_DESC;
    var LTx2DTemp: ID3D11Texture2D;
    var LMappedRes:TD3D11_MAPPED_SUBRESOURCE;
    var i:         Integer;
    var LPByte:    PByte;
    var LWidth:     UInt;
    var LOffset:    UInt;
    var LBitmapData:TBitmapData;
    LTx2D.GetDesc(LDesc);
    LDesc.BindFlags := 0;
    LDesc.CPUAccessFlags := Ord(D3D11_CPU_ACCESS_READ) or Ord(D3D11_CPU_ACCESS_WRITE);
    LDesc.Usage := D3D11_USAGE_STAGING;
    LDesc.MiscFlags := 0;
    if Failed(FDevice.CreateTexture2D(LDesc, nil, LTx2DTemp)) then Exit;
    FContext.CopyResource(LTx2DTemp, LTx2D);
    FContext.Map(LTx2DTemp, 0, D3D11_MAP_READ_WRITE, 0, LMappedRes);
    LPByte := LMappedRes.pData;
    FBitmap.SetSize(LDesc.Width, LDesc.Height);
    LWidth:=4*LDesc.Width;
    FBitmap.Map(TMapAccess.Write, LBitmapData);
    LOffset:=LBitmapData.Pitch div SizeOf(TAlphaColor);
    for i:=0 to LDesc.Height-1 do begin
      Move(LPByte^, PAlphaColorArray(LBitmapData.Data)^[i*LOffset], LWidth);
      Inc(LPByte, LWidth);
    end;
    FBitmap.Unmap(LBitmapData);
    Result := True;
  end;
  FDuplicate.ReleaseFrame;
end;

end.
```

## Form1のデザイン編集
以下のように，Form1にTComboBox, TButton, TImage, TTimerを追加します。
![Snap0012.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/33902/d7e38e93-9120-9cbc-cd70-a3d994ea9a27.png)

### Image1のデザイン編集
Image1のオブジェクトインスペクタで
　AnchorsのakRightとakBotomをTrueに変更します。
　MarginWrapModeをFitに変更します。
### Timer1のデザイン編集
Timer1のオブジェクトインスペクタでEnabledをFalseに変更します。

## Form1でuFMXDesktopDupulicationを利用する
`uFMXDesktopDuplication`を`interface`の`uses`に追加し，`TForm1のprivate`に`FDuplication`を追加します。
FDuplicationを追加のコードは以下のようになります。
```Unit1.pas
type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    Button1: TButton;
    Image1: TImage;
    Timer1: TTimer;
  private
    { private 宣言 }
     DesktopDuplication: TFMXDesktopDuplication;
  public
    { public 宣言 }
  end;
```

## Form1にイベントを追加する
### Form1にOnCreateとOnDestroyを追加
Form1のオブジェクトインスペクタでOnCreateイベントを追加して以下のように編集します。
```Unit1.pas
procedure TForm1.FormCreate(Sender: TObject);
var
  i:integer;
begin
  ComboBox1.Items.Clear;
  for i:=0 to Screen.DisplayCount-1 do begin
    ComboBox1.Items.Add(
      Screen.Displays[i].Index.ToString+': '
     +Screen.Displays[i].BoundsRect.Width.ToString+'x'
     +Screen.Displays[i].BoundsRect.Height.ToString
    );
  end;
  ComboBox1.ItemIndex:=0;
  DesktopDuplication:=nil;
end;
```
Form1のオブジェクトインスペクタでOnDestroyイベントを追加して以下のように編集します。
```Unit1.pas
procedure TForm1.FormDestroy(Sender: TObject);
begin
  DesktopDuplication.Free;
end;
```
## Button1にOnClickを追加
Button1のオブジェクトインスペクタでOnClickイベントを追加して以下のように編集します。
```Unit1.pas
procedure TForm1.Button1Click(Sender: TObject);
begin
  DesktopDuplication.Free;
  DesktopDuplication := TFMXDesktopDuplication.CreateParamMonitor(ComboBox1.ItemIndex);
  Timer1.Enabled := DesktopDuplication.isCreated;
end;
```
## Timer1にOnTimerイベントを追加
Timer1のオブジェクトインスペクタでOnTimerイベントを追加して以下のように編集します。
```Unit1.pas
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if DesktopDuplication.FrameGet then begin
    Image1.Bitmap.Assign(DesktopDuplication.Bitmap);
  end;
end;
```

### ここまでのUnit1.pasの編集結果
Unit1.pasは以下のようになります。このコードだけを張り付けてもフォームのイベントとつながらないので，必ずフォームのオブジェクトインスペクタのイベントタブからイベントのメソッド書くようにしてください。
```Unit1.pas
unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.ListBox,
  uFMXDesktopDuplication;

type
  TForm1 = class(TForm)
    ComboBox1: TComboBox;
    Button1: TButton;
    Image1: TImage;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { private 宣言 }
     DesktopDuplication: TFMXDesktopDuplication;
  public
    { public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.fmx}

procedure TForm1.Button1Click(Sender: TObject);
begin
  DesktopDuplication.Free;
  DesktopDuplication := TFMXDesktopDuplication.CreateParamMonitor(ComboBox1.ItemIndex);
  Timer1.Enabled := DesktopDuplication.isCreated;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i:integer;
begin
  ComboBox1.Items.Clear;
  for i:=0 to Screen.DisplayCount-1 do begin
    ComboBox1.Items.Add(
      Screen.Displays[i].Index.ToString+': '
     +Screen.Displays[i].BoundsRect.Width.ToString+'x'
     +Screen.Displays[i].BoundsRect.Height.ToString
    );
  end;
  ComboBox1.ItemIndex:=0;
  DesktopDuplication:=nil;
end;

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

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if DesktopDuplication.FrameGet then begin
    Image1.Bitmap.Assign(DesktopDuplication.Bitmap);
  end;
end;

end.
```
実行して，**ComboBox1**でキャプチャしたいモニターを選択し，**Button1**をクリックするとキャプチャが始まります。1秒間隔で更新されます。
![Snap0014.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/33902/387f5eed-c657-8f71-58dd-4db220da6bda.png)
`Timer1`の`Interval`を短くするとより細かい動きを表示できます。
Windows8より古いOSで起動した場合動作しないので，その処理を追加したほうが良いと思います。

今回はマウスカーソルは取得しませんでしたがそれ以外についてもLearn Microsoftの記事を読めばできるのではないかと思います。

### 謝辞(引用元および参考文献)
以下のリンクが参考になりました。
- [Microsoft Learn - デスクトップ重複 API](https://learn.microsoft.com/ja-jp/windows/win32/direct3ddxgi/desktop-dup-api?redirectedfrom=MSDN) Desktop Duplication API について詳しく知ることができます。
- [GitHub - CMCHTPC / DelphiDX12](https://github.com/CMCHTPC/DelphiDX12) DX12ヘッダファイル
- [Desktop Duplication API in Delphi](https://www.codeproject.com/Articles/1114240/Desktop-Duplication-API-in-Delphi) The Code Project Open License(CPOL)です。
- [Embarcadero Rad Studop DockWiki - 複数ディスプレイのサポート FMX](https://docwiki.embarcadero.com/RADStudio/Alexandria/ja/%E8%A4%87%E6%95%B0%E3%83%87%E3%82%A3%E3%82%B9%E3%83%97%E3%83%AC%E3%82%A4%E3%81%AE%E3%82%B5%E3%83%9D%E3%83%BC%E3%83%88
) キャプチャをするモニターを取得するために利用しました。
- [Mr.XRAY - Windows のバージョンの取得](http://mrxray.on.coocan.jp/Delphi/Others/WindowsVersion.htm) バージョンチェックする際に有用な情報です。

貴重な情報を提供してくださった皆様，ありがとうございます。感謝します。