有没有办法在不丢失原生 windows 边框的情况下舍入 Delphi VCL Form

Question

我这里有这个 repo DelphiUCL

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

我需要确切知道的是：有没有办法在不丢失原生 windows 边框的情况下创建平滑的圆角 Delphi VCL 表单？

Answer 1

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

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

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

代码如下：

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

有没有办法在不丢失原生 windows 边框的情况下舍入 Delphi VCL Form

Is there a way to round Delphi VCL Form without losing native windows borders

user-interface

delphi

user-experience

vcl