创建无边框表单而不会丢失Windows命令

问题描述 投票:5回答:1

我已经将我的表单更改为无边框形式,我只是将BorderStyle属性更改为bsNone,但现在我的应用程序丢失了窗口锚点和一些命令,如

WIN +↑(对齐表单客户端) WIN +↓(最小化表格) WIN +→(右对齐表格) WIN +←(左对齐表格)

我试图设置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;

结果如下:

My form

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

有什么办法设置BorderStyle: bsNone,不要失去这些命令?

EDITED

如果我使用WS_THICKFRAME我的表单返回一个小的顶部边框和Windows命令运行良好,但我不想要顶部边框。

My form2

编辑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;

我有这个方法here

现在边框已经消失,但是当我的表格失去焦点时,顶部/底部边框再次显示....

我怎么能避免这个?

enter image description 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;

GitHUB的解决方案

我创造了一个repository here

delphi delphi-xe rad-studio
1个回答
2
投票

您引用的一些命令是与窗口大小相关的系统命令。这需要厚框架,没有它“WIN +右”和“WIN +左”将不起作用。此外,您需要最小化框和最大化框以使WIN +向上/向下命令起作用。

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

procedure TForm1.FormCreate(Sender: TObject);
begin
  BorderStyle := bsNone;
  SetWindowLong(Handle, GWL_STYLE, WS_CLIPCHILDREN or WS_OVERLAPPEDWINDOW);
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;

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

上面留下了一个没有任何非客户区域的窗口。客户端矩形等于窗口矩形。虽然标题不可见,但您可以通过按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;

你可能不得不处理一些故障,弄乱窗口会产生后果。在我的测试中,最小化的表单在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.
© www.soinside.com 2019 - 2024. All rights reserved.