LoginSignup
7
3

More than 5 years have passed since last update.

DelphiAdvent Calendar 2018Day 8
@p_kato(Yuzuru Kato)

Delphi VCLでFluent Designに挑戦(その1) - Arcylic Form (アクリル フォーム)

Last updated at Posted at 2018-12-07

Delphi Advent Calender 2018の8日の記事です。

Windows10ではこれまでのFlat デザインから Fluent Design に移行していくようです。

マイクロソフトの公式ページ(IEでは見ることができません)
https://www.microsoft.com/design/fluent/
UWPアプリ向けには以下のような記事が提供されています
https://docs.microsoft.com/ja-jp/windows/uwp/design/fluent-design-system/

見た目がかっこいいですね。そこでDelphiでもこの一部での実現できないかと考えました。
この記事ではアクリル効果に挑戦したいと思います。

UWPではXAMLで指定できるようです。XAML Controls GallaryのArcylicで確認できます。
https://docs.microsoft.com/ja-jp/windows/uwp/design/style/acrylic
.netのWinFormでもぷFluentDesignForm.EnableAcrylicAccentの指定で簡単に作れるようですね。

VCLで同様のコントロールを作るのは難しそうなので，まずはフォームをアクリルにして，TWinControlから派生していないImageでボタンを実装することを考えました。
まずはフォームをアクリルにする方法について検討します。

フォームをアクリルフォームにする

アクリルフォームを実現するためにuser32.dllにあるSetWindowCompositionAttributeを使ってみたいと思います。これはWindows10にしかないのでWindows10の時だけアクリルフォームになるようにします。さらにWindows 10 April 2018 Updateより利用できるようになったACCENT_ENABLE_ACRYLICBLURBEHINDを使いたいと思います。それからFormのGrassFrameを使います。ネット上の記事を参考に下のようなコードを書いてみました。

type
  AccentPolicy = packed record
    AccentState: Integer;
    AccentFlags: Integer;
    GradientColor: Integer;
    AnimationId: Integer;
  end;

  WindowCompositionAttributeData = packed record
    Attribute: THandle;
    Data: Pointer;
    SizeOfData: ULONG;
  end;

var
  SetWindowCompositionAttribute:function (hWnd: HWND; var data: WindowCompositionAttributeData):integer; stdcall;

function AcrylicFormSet(AForm:TForm;AColor:UInt32):integer;
const
  WCA_ACCENT_POLICY = 19;
  ACCENT_ENABLE_ACRYLICBLURBEHIND = 4; // Windows 10 April 2018 Update
  DrawLeftBorder = $20;
  DrawTopBorder = $40;
  DrawRightBorder = $80;
  DrawBottomBorder = $100;

var
  dwm10: THandle;
  data: WindowCompositionAttributeData;
  accent: AccentPolicy;
begin
  Result:=-1;// Not found Windows 10 SetWindowCompositionAttribute in user32.dll

  AForm.GlassFrame.Bottom:=-1;
  AForm.GlassFrame.Top:=-1;
  AForm.GlassFrame.Left:=-1;
  AForm.GlassFrame.Right:=-1;
  AForm.GlassFrame.SheetOfGlass:=True;
  AForm.GlassFrame.Enabled:=True;
  AForm.BorderStyle := bsNone;                     //フォームのボーダーは無しにする
  AForm.BorderIcons := [biSystemMenu, biMinimize]; // ボーダーアイコンは無し
  AForm.DoubleBuffered:=True;                      // ダブルバッファにする

  dwm10 := LoadLibrary('user32.dll');
  try
    @SetWindowCompositionAttribute := GetProcAddress(dwm10, 'SetWindowCompositionAttribute');
    if @SetWindowCompositionAttribute <> nil then begin
      accent.AccentState := ACCENT_ENABLE_ACRYLICBLURBEHIND;
      accent.GradientColor := AColor;
      accent.AccentFlags := DrawLeftBorder or DrawTopBorder or DrawRightBorder or DrawBottomBorder;
      data.Attribute := WCA_ACCENT_POLICY;
      data.SizeOfData := SizeOf(accent);
      data.Data := @accent;
      SetWindowCompositionAttribute(AForm.Handle, data);
      Result:=0;
    end;
  finally
    FreeLibrary(dwm10);
  end;
end;

フォームのクリエイトイベントの先頭で

  AcrylicFormSet(Self,$11880000);

等と書くと動作します。$11880000はアルファを含む色指定で，アクリルフォームの色を指定できます。しかし，フォームのボーダーにbsNoneを設定してあるため，動かしたりリサイズすることができません。これはフォームのボーダーをbsNone以外にすると，フォームの境界線がきれいに表示されなくなるためです。

bsNoneを指定されたフォームを動かしたりリサイズできるようにする

そこで，WM_NCHITTESTメッセージを使って，フォームを動かせるようにしたいと思います。
まず，WM_NCHITTESTを処理する関数_WMNCHitTestを書きます。

var
  FAllowSize: Boolean=True; // リサイズする場合にはTrue
  FAllowMove: Boolean=True; // 移動する場合にはTrue

procedure _WMNCHitTest(AForm:TForm;var Msg: TWMNCHitTest);
const
  hCORNER: Integer=19;
  hWIDTH : Integer= 3;
  hHEIGHT: Integer=48;

var
  ScreenPt : TPoint;
  MoveArea : TRect;
begin
  Msg.Result :=HTCLIENT;
  if not (csDesigning in AForm.ComponentState) then begin
    ScreenPt := AForm.ScreenToClient(Point(Msg.Xpos, Msg.Ypos));
    if FAllowSize then begin
      if (ScreenPt.x <  hCORNER)and(ScreenPt.y <  hCORNER) then begin                             // top left corner
        Msg.Result := HTTOPLEFT
      end else if (ScreenPt.x <  hCORNER)and(ScreenPt.y >= AForm.Height-hCORNER) then begin       // bottom left corner
        Msg.Result := HTBOTTOMLEFT
      end else if (ScreenPt.x >= AForm.Width-hCORNER)and(ScreenPt.y <  hCORNER) then begin        // top right corner
        Msg.Result := HTTOPRIGHT
      end else if (ScreenPt.x >= AForm.Width-hCORNER)and(ScreenPt.y >= AForm.Height-hCORNER) then begin // bottom right corner
        Msg.Result := HTBOTTOMRIGHT
      end else if (ScreenPt.x<hWIDTH) then begin              // left side
        Msg.Result := HTLEFT
      end else if (ScreenPt.y<hWIDTH) then begin              // top side
        Msg.Result := HTTOP
      end else if (ScreenPt.x>=AForm.Width -hWIDTH) then begin // right side
        Msg.Result := HTRIGHT
      end else if (ScreenPt.y>=AForm.Height-hWIDTH) then begin // bottom side
        Msg.Result := HTBOTTOM
      end;
    end;
  end;
  if FAllowMove then begin // スクリーンをドラッグで動かしたい場合 上部hHEIGHTピクセルだけ
    MoveArea := Rect(hWIDTH, hWIDTH, AForm.Width - hWIDTH, hHEIGHT - hWIDTH);
    if PtInRect(MoveArea, ScreenPt) then begin
      Msg.Result := HTCAPTION;
    end;
  end;
end;

そして，WM_NCHITTESTメッセージを処理するメソッドをフォームに宣言します。

type
  TForm1 = class(TForm)
    ・・・
  private
    ・・・
    procedure WMNCHitTest(var Msg: TWMNCHitTest);message WM_NCHITTEST;
  public
  end;

そして，このメソッドの処理を記述します。

procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
begin
  inherited;
  _WMNCHitTest(Self,Msg);
end;

これでフォームの上部hHEIGHTをドラッグすると移動したり，フォームの境界線付近の内側をドラッグするとリサイズできるようになりました。
リサイズはフォームの内側のドラッグなので，フォームの淵まで使ってWinControlを配置すると動作しなくなります。本当はフォームの外側をドラッグできるようにしたかったのですが，やり方がわかりませんでした。アドバイスをいただけるとありがたいです。

実装にあたっての注意 - オフする機能を実装すること！

アクリルフォームを実装する場合には，ノートパソコンやタブレットの省電力のためにオフにする機能を実装することが推奨されています。今回の実装だとアプリの再起動が必要な方法しか思いつきませんでしたが，アプリの再起動なしに実現できる方法をご存知の方がいらっしゃいましたら是非教えてください！

まとめ

VCLのGlassFrameとuser32.dllのSetWindowCompositionAttributeを使ってアクリルフォームを作りました。Windows10でしか動作しませんが，VCLでもここまでできることがわかりました。
また作成したフォームがbsNoneだったためフォームの移動とリサイズする機能を自前でのせる方法を追加し Fluent Design風なアプリケーションをVCLでもかけそうな気がしています。不完全なものではありますが，皆さんのお役に立てば幸いです。

参考文献

このコードを書くにあたって，以下の記事を参考にさせていただきました。
CODIGOBIT - Enable Windows 10 Aero Glass a.k.a Blur Behind in our Delphi project
http://vhanla.codigobit.info/2015/07/enable-windows-10-aero-glass-aka-blur.html
Slashback Software - Borderless window resizing with WM_NCHITTEST
https://slashbackassociates.com/blog/Borderless-window-resizing-with-WM-NCHITTEST
ACCENT_ENABLE_ACRYLICBLURBEHIND
https://stackoverflow.com/questions/32724187/how-do-you-set-the-glass-blend-colour-on-windows-10

7
3
1

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
7
3