在不丢失 Windows 命令的情况下创建无边界表单

Question

我已经将我的表单更改为无边框表单，我只是将 BorderStyle 属性更改为 bsNone，但现在我的应用程序丢失了 windows 锚点并且一些命令如

WIN + ↑ (Align the form Client)
WIN + ↓ (Minimize the form)
WIN + →(Align the form Right)
WIN + ←(Align the form Left)

我尝试设置 BorderStyle: bsSizeable 并在 FormCreate 中使用以下代码，但这不起作用：

procedure TfrmBase.FormCreate(Sender: TObject);
begin
  SetWindowLong(Handle
               ,GWL_STYLE
               ,GetWindowLong(Handle, GWL_STYLE)
                AND (NOT WS_CAPTION)
                AND (NOT WS_THICKFRAME)
               );


  Refresh;
  FormColor := oLauncher.oCor;
end;

结果：

上面的图片是我想要的，但是我已经提到的 Windows 命令不起作用

有什么方法可以设置 BorderStyle: bsNone 并且不丢失这些命令吗？

已编辑

如果我使用 WS_THICKFRAME 我的表单 returns 有一个小的顶部边框并且 windows 命令工作正常，但我不想要那个顶部边框。

已编辑 2

我已经非常接近预期的结果了，但是还有一点问题...

我把这个放在我的 FormCreate

SetWindowLong(Handle
             ,GWL_STYLE
             ,GetWindowLong(Handle, GWL_STYLE)
              AND (NOT WS_CAPTION)
              );

然后我创建方法

private
   procedure WmNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE;

然后

procedure TfrmBase.WmNCCalcSize(var Msg: TWMNCCalcSize);
begin
  inherited;
  if Msg.CalcValidRects then
  begin
    InflateRect(Msg.CalcSize_Params.rgrc[0], 0, 6);
    Msg.Result := 0;
  end;
end;

I got this method here

现在边框消失了，但是当我的表单失去焦点时，顶部/底部边框又出现了....

如何避免这种情况？

已解决

我把边框设为BorderStyle: bsSizeable，然后我就这样做了：

private
  procedure WmNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE;
[...]
procedure TfrmBase.WmNCCalcSize(var Msg: TWMNCCalcSize);
var
  R: TRect;
begin
  if not Msg.CalcValidRects then
    R := PRect(Msg.CalcSize_Params)^;
  inherited;
  if Msg.CalcValidRects then
    Msg.CalcSize_Params.rgrc0 := Msg.CalcSize_Params.rgrc1
  else
    PRect(Msg.CalcSize_Params)^ := R;

  Msg.Result := 0;
end;

procedure TfrmBase.FormCreate(Sender: TObject);
begin
  BorderStyle := bsNone;
  SetWindowLong(Handle
               ,GWL_STYLE
               ,WS_CLIPCHILDREN or WS_OVERLAPPEDWINDOW
               );
end;

procedure TfrmBase.FormShow(Sender: TObject);
begin
  Width := (Width - 1);
end;

Solution at GitHUB

I've create a repository here

Answer 1

您提到的一些命令是与 window 大小调整相关的系统命令。这需要粗框架，没有它“WIN + right”和“WIN + left”将不起作用。此外，您需要最小化框和最大化框才能使 WIN + up/down 命令正常工作。

最好从头开始并包含您需要的样式，否则 VCL 可能会干扰。如果有可能重新创建您的表单，请将样式放在 CreateWnd 覆盖中。

procedure TForm1.FormCreate(Sender: TObject);
begin
  BorderStyle := bsNone;
  SetWindowLong(Handle, GWL_STYLE, WS_CLIPCHILDREN or WS_OVERLAPPEDWINDOW);
end;

那就是你不想要的框架。在问题的编辑中，您膨胀客户矩形以摆脱它。不要猜帧width/height，像下面那样做。

procedure TForm1.WMNCCalcSize(var Message: TWMNCCalcSize);
var
  R: TRect;
begin
  if not Message.CalcValidRects then
    R := PRect(Message.CalcSize_Params)^;
  inherited;
  if Message.CalcValidRects then
    Message.CalcSize_Params.rgrc0 := Message.CalcSize_Params.rgrc1
  else
    PRect(Message.CalcSize_Params)^ := R;
  Message.Result := 0;
end;

此时必须读取documentation消息，参数在不同阶段有不同的含义等。

上面留下了 window，根本没有任何 non-client 区域。客户端矩形等于 window 矩形。虽然标题不可见，但您可以通过按 Alt+Space 激活系统菜单。问题是，系统坚持绘制激活状态。现在它在客户区画了一个框！！

通过拦截去掉WM_NCACTIVATE，你还需要它根据激活状态绘制你的标题：

procedure TForm1.WMNCActivate(var Message: TWMNCActivate);
begin
  if Message.Active then
    // draw active caption
  else
    // draw incactive caption

  // don't call inherited
end;

您可能不得不处理一些小问题，弄乱 window 会产生后果。例如，在我的测试中，最小化形式在 alt+tab 对话框中没有关联的图标。

下面是我的完整测试单元。

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs;

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  protected
    procedure WMNCActivate(var Message: TWMNCActivate); message WM_NCACTIVATE;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  BorderStyle := bsNone;
  SetWindowLong(Handle, GWL_STYLE, WS_CLIPCHILDREN or WS_OVERLAPPEDWINDOW);
end;

procedure TForm1.WMNCActivate(var Message: TWMNCActivate);
begin
  if Message.Active then
    // draw active caption
  else
    // draw incactive caption

  // don't call inherited
end;

procedure TForm1.WMNCCalcSize(var Message: TWMNCCalcSize);
var
  R: TRect;
begin
  if not Message.CalcValidRects then
    R := PRect(Message.CalcSize_Params)^;
  inherited;
  if Message.CalcValidRects then
    Message.CalcSize_Params.rgrc0 := Message.CalcSize_Params.rgrc1
  else
    PRect(Message.CalcSize_Params)^ := R;
  Message.Result := 0;
end;

end.

在不丢失 Windows 命令的情况下创建无边界表单

Create a borderless form without losing Windows commands

delphi

delphi-xe

rad-studio