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

如何解决有没有办法在不丢失本机窗口边框的情况下绕过 Delphi VCL 表单

我在这里有这个仓库DelphiUCL

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

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

解决方法

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

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

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

代码如下：

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,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