有没有办法在不丢失本机窗口边框的情况下舍入 Delphi VCL 表单

Question

我在这里有这个回购DelphiUCL

这是一个非常好的 Lib，它允许 bsSisezable 表单看起来像 UWP Forms 并且引起我注意的是，当我调整此表单的大小时，它仍然调整为 bsResizable 表单而不像 bsNone 表单

我需要确切知道的内容： 有没有办法在不丢失本机窗口边框的情况下创建平滑圆角 Delphi VCL 表单？

Answer 1

我有一个解决方法，但我不知道它是否符合您的需要。解决方法包括定义一个圆角矩形区域来剪辑窗口以删除标题栏和边框。这样一来，窗口就是一个圆角矩形。

然后，要取回标题栏和边框，您必须 - 例如 - 检测鼠标是否靠近边缘之一，如果是，则删除该区域，以便标题栏和边框再次可见并且可以使用。

所有这些都涉及处理一些消息。

代码如下：

unit RegionDemoMain;

interface

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

type
    TRoundedForm = class(TForm)
        CloseButton: TButton;
        HelpLabel: TLabel;
        procedure FormCreate(Sender: TObject);
        procedure CloseButtonClick(Sender: TObject);
        procedure WMMouseMove(var Msg : TWMMouseMove); message WM_MOUSEMOVE;
        procedure WMNCMouseLeave(var Msg : TMessage); message WM_NCMOUSELEAVE;
        procedure WMNCButtonDown(var Msg : TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
        procedure WMNCButtonUp(var Msg : TWMNCLButtonUp); message WM_NCLBUTTONUP;
        procedure WMSYSCommand(var Msg : TWMSysCommand); message WM_SYSCOMMAND;
    private
        FRgnHandle       : HRGN;
        FRgnTop          : Integer;
        FRgnBottom       : Integer;
        FRgnRight        : Integer;
        FRgnLeft         : Integer;
        FRgnCorner       : Integer;
        FMouseLeaveCount : Integer;
        FNCLButtonDown   : Boolean;
        procedure DeleteRegion;
        procedure CreateRegion;
    end;

var
  RoundedForm: TRoundedForm;

implementation

{$R *.dfm}

procedure TRoundedForm.FormCreate(Sender: TObject);
begin
    FRgnTop    := GetSystemMetrics(SM_CYCAPTION) +
                  GetSystemMetrics(SM_CYFRAME) +
                  GetSystemMetrics(SM_CYFRAME); 
    FRgnBottom := GetSystemMetrics(SM_CYFRAME) +
                  GetSystemMetrics(SM_CYFRAME);
    FRgnRight  := GetSystemMetrics(SM_CXFRAME) +
                  GetSystemMetrics(SM_CXFRAME);
    FRgnLeft   := GetSystemMetrics(SM_CXFRAME) +
                  GetSystemMetrics(SM_CXFRAME);
    FRgnCorner := 15;
    CreateRegion;
end;

procedure TRoundedForm.CreateRegion;
begin
    if FRgnHandle <> 0 then
        DeleteObject(FRgnHandle);
    FRgnHandle := CreateRoundRectRgn(FRgnLeft,
                                     FRgnTop,
                                     Width  - FRgnRight,
                                     Height - FRgnBottom,
                                     FRgnCorner,
                                     FRgnCorner);
    SetWindowRGN(Handle, FRgnHandle, True);
end;

procedure TRoundedForm.CloseButtonClick(Sender: TObject);
begin
    Close;
end;

procedure TRoundedForm.DeleteRegion;
begin
    if FRgnHandle <> 0 then begin
        SetWindowRGN(Handle, 0, True);
        DeleteObject(FRgnHandle);
        FRgnHandle := 0;
    end;
end;

procedure TRoundedForm.WMMouseMove(var Msg: TWMMouseMove);
begin
    if (Msg.YPos < GetSystemMetrics(SM_CYSIZEFRAME)) or
       (Msg.YPos > (Height - 55)) or
       (Msg.XPos < 10) or
       (Msg.XPos > (Width - 25)) then
        DeleteRegion
    else if (FRgnHandle = 0) and (Msg.YPos > 10) then
        CreateRegion;
    inherited;
end;

procedure TRoundedForm.WMNCButtonDown(var Msg: TWMNCLButtonDown);
begin
    FNCLButtonDown := TRUE;
    inherited;
end;

procedure TRoundedForm.WMNCButtonUp(var Msg: TWMNCLButtonUp);
begin
    FNCLButtonDown := FALSE;
    inherited;
end;

procedure TRoundedForm.WMNCMouseLeave(var Msg : TMessage);
begin
    Inc(FMouseLeaveCount);
    if (FRgnHandle = 0) and (not FNCLButtonDown) then
        CreateRegion;
    inherited;
end;

procedure TRoundedForm.WMSYSCommand(var Msg: TWMSysCommand);
begin
    if Msg.CmdType = SC_RESTORE then
        CreateRegion;
    inherited;
end;

end.

和 DFM 文件：

object RoundedForm: TRoundedForm
  Left = 0
  Top = 0
  Caption = 'RoundedForm'
  ClientHeight = 299
  ClientWidth = 635
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object HelpLabel: TLabel
    Left = 200
    Top = 96
    Width = 222
    Height = 13
    Caption = 'Move the cursor near one edge of the window'
  end
  object CloseButton: TButton
    Left = 268
    Top = 132
    Width = 75
    Height = 25
    Caption = 'CloseButton'
    TabOrder = 0
    OnClick = CloseButtonClick
  end
end