如何获得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;

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

处理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.