如何获得windows10风格的透明边框

Question

我一直在试验，看看能否通过自定义控件获得相同的效果，但运气不佳。

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

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

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

我注意到 WIN10 窗体有一个看不见的粗边框，内边缘只有一条像素线。因此，调整大小的光标在可见框架外工作约 6 到 8 个像素，从而更容易 select。

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

Answer 1

您不需要用于顶级 windows 的边框，句柄 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.

如何获得windows10风格的透明边框

How to get a windows 10 style transparent border

delphi

delphi-10.3-rio