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.

如何获得Windows 10样式的透明边框

1 个答案: