代码之家 › 专栏 › 技术社区 › Andy k

如何获取Windows10样式的透明边框

delphi-10.3-rio delphi

Andy k · 技术社区 · 6 年前

我一直在尝试用一个自定义控件是否可以获得相同的效果。

问题是,我想制作一个从tcustomcontrol派生的可调整大小的类似面板的组件。

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

更改为“ws”thickframe显然有效,但会造成一个难看的可见边框。

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

关于他们是如何达到这种效果的,并且在Delphi VCL控件中可以很容易地复制它,有什么想法吗?

1 回复 | 直到 6 年前

Sertac Akyuz 6 年前

您不需要用于顶级窗口的边框,手柄 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.