如何获得 Windows 10 风格的透明边框

Question

我一直在试验，看看我是否可以在没有运气的情况下使用自定义控件获得相同的效果。

问题是，我想要制作一个可调整大小的面板，例如从 Tcustomcontrol 派生的组件。

我可以使用 WS_BORDER 创建单个像素边框，然后使用 WMNCHitTest 检测边缘。但是如果该控件包含另一个与 alclient 对齐的控件，则鼠标消息会转到该包含的组件而不是包含面板。所以充其量，调整大小的光标仅在它们恰好位于单个像素边框上时才起作用。

更改为 WS_THICKFRAME 显然可行，但会产生丑陋的可见边框。

我注意到 WIN10 表单有一个不可见的粗边框，内部边缘只有一条像素线。因此，调整大小的光标在可见框架之外工作约 6 到 8 个像素，使其更容易选择。

关于他们如何实现这种效果的任何想法以及是否可以在 delphi vcl 控件中轻松复制？

Answer 1

您不需要与顶级窗口一起使用的边框，处理WM_NCCALCSIZE 来缩小您的客户区：

procedure TSomeControl.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  inherited;
  InflateRect(Message.CalcSize_Params.rgrc0, -FBorderWidth, -FBorderWidth);
end;

其中FBorderWidth 是控件周围的假定填充。

句柄 WM_NCHITTEST 用鼠标从边框调整大小。

procedure TSomeControl.WMNCHitTest(var Message: TWMNCHitTest);
var
  Pt: TPoint;
begin
  inherited;
  Pt := ScreenToClient(Point(Message.XPos, Message.YPos));
  if Pt.X < 0 then
    Message.Result := HTLEFT;
  ...

当然，你必须根据自己的喜好绘制边框。

这是我的完整测试单元：

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

uses
  extctrls;

type
  TSomeControl = class(TCustomControl)
  private
    FBorderWidth: Integer;
  protected
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
  public
    constructor Create(AOwner: TComponent); override;
  end;

{ TSomeControl }

constructor TSomeControl.Create(AOwner: TComponent);
begin
  inherited;
  FBorderWidth := 5;
  ControlStyle := ControlStyle + [csAcceptsControls];
end;

procedure TSomeControl.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  inherited;
  InflateRect(Message.CalcSize_Params.rgrc0, -FBorderWidth, -FBorderWidth);
end;

procedure TSomeControl.WMNCHitTest(var Message: TWMNCHitTest);
var
  Pt: TPoint;
begin
  inherited;
  Pt := ScreenToClient(Point(Message.XPos, Message.YPos));
  if Pt.X < 0 then
    Message.Result := HTLEFT;
  if Pt.Y < 0 then
    Message.Result := HTTOP;
  if Pt.X > ClientWidth then
    Message.Result := HTRIGHT;
  if Pt.Y > ClientHeight then
    Message.Result := HTBOTTOM;
end;

procedure TSomeControl.WMNCPaint(var Message: TWMNCPaint);
var
  DC: HDC;
begin
  DC := GetWindowDC(Handle);
  SelectClipRgn(DC, 0);
  SelectObject(DC, GetStockObject(BLACK_PEN));
  SelectObject(DC, GetStockObject(GRAY_BRUSH));
  Rectangle(DC, 0, 0, Width, Height);
  ReleaseDC(Handle, DC);
end;

//---------------------------------------

procedure TForm1.Button1Click(Sender: TObject);
var
  C: TSomeControl;
  P: TPanel;
begin
  C := TSomeControl.Create(Self);
  C.SetBounds(30, 30, 120, 80);
  C.Parent := Self;

  P := TPanel.Create(Self);
  P.Parent := C;
  P.Align := alClient;
end;

end.