I've been experimenting to see if I can get the same effect with a custom control with no luck.
The issue is, I'm wanting to make a resizable panel like component derived from Tcustomcontrol.
I can create a single pixel border with WS_BORDER and then use WMNCHitTest to detect the edges. But if the control contains another control aligned to alclient, then the mouse messages go to that contained component rather than the containing panel. So at best, the resizing cursors only work when they are precisely over the single pixel border.
Changing to WS_THICKFRAME obviously works but makes an ugly visible border.
I noticed that WIN10 forms have an invisible thick border with just a single pixel line on the inner edges. So the resizing cursors work outside the visible frame for about 6 to 8 pixels making it much easier to select.
Any ideas on how they are achieving that effect and can it be easily duplicated in delphi vcl controls?
You don't need borders that are meant to be used with top-level windows, handle WM_NCCALCSIZE
to deflate your client area:
procedure TSomeControl.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
inherited;
InflateRect(Message.CalcSize_Params.rgrc0, -FBorderWidth, -FBorderWidth);
end;
where FBorderWidth
is the supposed padding around the control.
Handle WM_NCHITTEST
to resize with the mouse from borders.
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;
...
Of course you have to paint the borders to your liking.
Here's my full test unit:
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.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.