BorderStyleがbsNoneのVCLフォームに影をつける(Delphi)

以下のようにWindows10でボーダーレスなウインドウには普通影が付きません。
![000.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/33902/f123b7ca-2178-3065-1b89-61a1fcb75be3.png)

そこでDelphiのVCLでボーダーレスなウインドウに影をつける方法を紹介します。
利用したのはDelphi 10.4.2です。

#ボーダレスなウインドウを作る
まずボーダレスなウインドウにするには，TFormのBorderStyleにbsNoneを指定します。

#影をつける その1 WindowClass.Style
WindowClass.StyleにCS_DROPSHADOWを追加しましょう。
CS_DROPSHADOWはWinapi.Windowsに記述されています。

```delphi:unit1.pas

uses
  Winapi.Windows, ････････;

type
  TForm1 = class(TForm)
  protected
    procedure CreateParams(var Params: TCreateParams); override; // フォームウィンドウ作成時にウィンドウ作成パラメータレコードを初期化
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited;
  with Params do begin
    WindowClass.Style := WindowClass.Style or CS_DROPSHADOW; // Dwmが使えない時の影を表示
  end;
end;
```

すると，以下のような影が表示されます。
![001.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/33902/cbaaa251-3613-7218-3086-4f6ebbea62c5.png)
でも，普通のフォームの影より小さい感じです。もう少し書き換えます。

#影をつける その2 DWM合成
以下のようにコードを追加します。

```delphi:unit1.pas
uses
  Winapi.Windows, Winapi.Messages, ････････;
type
  TForm1 = class(TForm)
  protected
    procedure CreateParams(var Params: TCreateParams); override; // フォームウィンドウ作成時にウィンドウ作成パラメータレコードを初期化
  private
    { Private 宣言 }
    function SetBorderlessShadow: Boolean;
    procedure CreateWindowHandle(const AParams: TCreateParams); override; // ウィンドウ作成用のパラメータセットで指定されるフォームを作成
    procedure WndProc(var AMessage: TMessage); override;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
   Winapi.Dwmapi, Winapi.UxTheme;

var
  m_aeroEnabled:boolean; // DWMが使えるか？

function CheckAeroEnabled:boolean; // DWMが利用可能かを返す関数
var
  e:bool;
  OSVersion:TOSVersion;
begin
  if (OSVersion.Major >= 6) then begin
    DwmIsCompositionEnabled(e);
    Result:=e;
  end else begin
    Result:=False;
  end;
end;

function TForm1.SetBorderlessShadow: Boolean; // 影を表示してぼかす
var
  LPolicy:DWORD;
  LMargins:TMargins;
begin
  if not m_aeroEnabled then Exit(False);
  LPolicy:=DWMNCRP_ENABLED;
  Result:=Succeeded(DwmSetWindowAttribute(Handle, DWMWA_NCRENDERING_POLICY, @LPolicy, sizeof(LPolicy)));
  if Result then begin
    LMargins.cxLeftWidth    := 1;
    LMargins.cxRightWidth   := 1;
    LMargins.cyTopHeight    := 1;
    LMargins.cyBottomHeight := 1;
    Result:=Succeeded(DwmExtendFrameIntoClientArea(Handle,LMargins));
  end;
end;

procedure TForm1.CreateParams(var Params: TCreateParams);
begin
  inherited;
  m_aeroEnabled:=CheckAeroEnabled;
  with Params do begin
    WindowClass.Style := WindowClass.Style or CS_DROPSHADOW; // Dwmが使えない時の影を表示
  end;
end;

procedure TForm1.CreateWindowHandle(const AParams: TCreateParams);
begin
  inherited;
  SetBorderlessShadow; // 影を表示してぼかす
end;

procedure TForm1.WndProc(var AMessage: TMessage);
begin
   case AMessage.Msg of
    WM_DWMCOMPOSITIONCHANGED, // DWMコンポジションが有効または無効になっていることをすべてのトップレベルウィンドウに通知
    WM_DWMNCRENDERINGCHANGED: // 非クライアント領域の表示ポリシーが変更されたときに送信
    if SetBorderlessShadow then begin
      AMessage.Result := 0;
      Exit;
    end;
  end;
  inherited;
end;
```

すると以下のようにフォームの影をぼかすことができるようになりました。
![002.png](https://qiita-image-store.s3.ap-northeast-1.amazonaws.com/0/33902/2d9dd077-d762-ff92-a212-93a67c6944f6.png)

#まとめ
BorderStyleがbsNoneのVCLフォームに影をつけるには，以下の二段階の処理が有効のようです。

1. WindowClass.Style に CS_DROPSHADOW を追加する。
2. DWMが利用可を確認したうえでDwmSetWindowAttributeとDwmExtendFrameIntoClientAreaを利用する。*DWM利用状況の変化に対応するため，WndProcに細工すること。

###謝辞
HOSOKAWA Jun(@pik )様にCS_DROPSHADOWの使い方を教えていただきました。
また，教えていただいた [it-mure.jp.net](https://www.it-mure.jp.net/ja/c%23/%e3%83%9c%e3%83%bc%e3%83%80%e3%83%bc%e3%83%ac%e3%82%b9winform%e3%81%ae%e3%83%89%e3%83%ad%e3%83%83%e3%83%97%e3%82%b7%e3%83%a3%e3%83%89%e3%82%a6/1073700266/) はとても勉強になりました。ありがとうございます。
また，[delphipraxis](https://en.delphipraxis.net/topic/2568-borderless-with-aero-shadow/)のvfbbさんの投稿から勉強させていただきました。ありがとうございます。