Как получить прозрачную рамку в стиле Windows 10 - PullRequest
Новая
       9

Как получить прозрачную рамку в стиле Windows 10

0 голосов
/ 12 февраля 2019

Я экспериментировал, чтобы увидеть, смогу ли я получить тот же эффект с пользовательским элементом управления без удачи.

Проблема в том, что я хочу создать панель с изменяемым размером, подобную компоненту, полученному из Tcustomcontrol.

Я могу создать однопиксельную границу с помощью WS_BORDER, а затем использовать WMNCHitTest для определения краев.Но если элемент управления содержит другой элемент управления, выровненный по alclient, то сообщения мыши направляются в этот содержащий компонент, а не в содержащую панель.Так что в лучшем случае курсоры изменения размера работают только тогда, когда они находятся точно над границей одного пикселя.

Изменение на WS_THICKFRAME, очевидно, работает, но создает уродливую видимую границу.

Я заметил, что формы WIN10 имеютневидимая толстая граница с одной пиксельной линией по внутренним краям.Таким образом, курсоры изменения размера работают за пределами видимой рамки примерно на 6–8 пикселей, что значительно упрощает их выбор.

Любые идеи о том, как они достигают этого эффекта и могут ли они быть легко продублированы в элементах управления delphi vcl?

1 Ответ

0 голосов
/ 12 февраля 2019

Вам не нужны границы, которые предназначены для использования с окнами верхнего уровня, используйте WM_NCCALCSIZE, чтобы сдуть вашу клиентскую область: 

procedure TSomeControl.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
  inherited;
  InflateRect(Message.CalcSize_Params.rgrc0, -FBorderWidth, -FBorderWidth);
end;

, где FBorderWidth - предполагаемое заполнение вокругcontrol.

Обрабатывайте 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.
...