具有非客户区的自定义控件 - 一开始不计算

Custom control with non-client area - doesn't calculate at first

我正在编写一个自定义控件,它只是一个带有非客户区的容器。在那个非客户区内,有一个小区域是一个按钮,其余部分是透明的。该图不是一个精确的矩形。

到目前为止,我已经完成了一半的工作。问题是它不会预先计算非客户区,除非我做一些小调整,比如重新调整它的大小。

我遵循了许多描述如何完成此任务的资源。我处理 WM_NCCALCSIZE 的实现与我发现的 "working" 示例大致相同。但是当第一次创建控件时,它根本不计算这个。当我在我的消息处理程序 (WMNCCalcSize) 中放置断点时,根据我找到的示例,我应该首先检查 Msg.CalcValidRects,并且只有在 [=] 时才进行计算14=]。但是在调试运行的时候,是False,所以没有计算出来。

在设计时,如果我重新调整控件的大小,那么它会决定正确计算。它仍然不完美(这段代码仍在工作中),但在我调整它之前它似乎没有设置非客户区。此外,在 运行 时间内,如果我在代码中调整大小,它仍然无法计算。

顶部的图像是表格最初 created/shown 时的图像。第二个是在我稍微调整大小之后。注意测试按钮,它对齐 alLeft。所以最初,它消耗了应该是非客户端的区域。

如果我注释掉检查 if Msg.CalcValidRects then begin,那么它会正确计算。但是我看到每个例子都在做这个检查,我很确定这是需要的。

我做错了什么以及如何让它始终计算非客户区?

unit FloatBar;

interface

uses
  System.Classes, System.SysUtils, System.Types,
  Vcl.Controls, Vcl.Graphics, Vcl.Forms,
  Winapi.Windows, Winapi.Messages;

type
  TFloatBar = class(TCustomControl)
  private
    FCollapsed: Boolean;
    FBtnHeight: Integer;
    FBtnWidth: Integer;
    procedure RepaintBorder;
    procedure PaintBorder;
    procedure SetCollapsed(const Value: Boolean);
    function BtnRect: TRect;
    procedure SetBtnHeight(const Value: Integer);
    procedure SetBtnWidth(const Value: Integer);
    function TransRect: TRect;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMNCCalcSize(var Msg: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Repaint; override;
    procedure Invalidate; override;
  published
    property BtnWidth: Integer read FBtnWidth write SetBtnWidth;
    property BtnHeight: Integer read FBtnHeight write SetBtnHeight;
    property Collapsed: Boolean read FCollapsed write SetCollapsed;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Float Bar', [TFloatBar]);
end;

{ TFloatBar }

constructor TFloatBar.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle:= [csAcceptsControls,
    csCaptureMouse,
    csDesignInteractive,
    csClickEvents,
    csReplicatable,
    csNoStdEvents
    ];
  Width:= 400;
  Height:= 60;
  FBtnWidth:= 50;
  FBtnHeight:= 20;
  FCollapsed:= False;
end;

procedure TFloatBar.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params.WindowClass do
    Style := Style and not (CS_HREDRAW or CS_VREDRAW);
end;

destructor TFloatBar.Destroy;
begin

  inherited;
end;

procedure TFloatBar.Invalidate;
begin
  inherited;
  RepaintBorder;
end;

procedure TFloatBar.Repaint;
begin
  inherited Repaint;
  RepaintBorder;
end;

procedure TFloatBar.RepaintBorder;
begin
  if Visible and HandleAllocated then
    Perform(WM_NCPAINT, 0, 0);
end;

procedure TFloatBar.SetBtnHeight(const Value: Integer);
begin
  FBtnHeight := Value;
  Invalidate;
end;

procedure TFloatBar.SetBtnWidth(const Value: Integer);
begin
  FBtnWidth := Value;
  Invalidate;
end;

procedure TFloatBar.SetCollapsed(const Value: Boolean);
begin
  FCollapsed := Value;
  Invalidate;
end;

procedure TFloatBar.WMNCPaint(var Message: TWMNCPaint);
begin
  inherited;
  PaintBorder;
end;

procedure TFloatBar.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TFloatBar.WMNCCalcSize(var Msg: TWMNCCalcSize);
var
  lpncsp: PNCCalcSizeParams;
begin
  if Msg.CalcValidRects then begin            //<------ HERE --------
    lpncsp := Msg.CalcSize_Params;
    if lpncsp = nil then Exit;
    lpncsp.rgrc[0].Bottom:= lpncsp.rgrc[0].Bottom-FBtnHeight;
    Msg.Result := 0;
  end;
  inherited;
end;

function TFloatBar.BtnRect: TRect;
begin
  //Return a rect where the non-client collapse button is to be...
  Result:= Rect(ClientWidth-FBtnWidth, ClientHeight, ClientWidth, ClientHeight+FBtnHeight);
end;

function TFloatBar.TransRect: TRect;
begin
  //Return a rect where the non-client transparent area is to be...
  Result:= Rect(0, ClientHeight, ClientWidth, ClientHeight+FBtnHeight);
end;

procedure TFloatBar.WMNCHitTest(var Message: TWMNCHitTest);
var
  P: TPoint;
  C: TCursor;
begin
  C:= crDefault; //TODO: Find a way to change cursor elsewhere...
  P:= Point(Message.XPos, Message.YPos);
  if PtInRect(BtnRect, P) then begin
    Message.Result:= HTCLIENT;
    C:= crHandPoint;
  end else
  if PtInRect(TransRect, P) then
    Message.Result:= HTTRANSPARENT
  else
    inherited;
  Screen.Cursor:= C;
end;

procedure TFloatBar.Paint;
begin
  inherited;

  //Paint Background
  Canvas.Brush.Style:= bsSolid;
  Canvas.Pen.Style:= psClear;
  Canvas.Brush.Color:= Color;
  Canvas.FillRect(Canvas.ClipRect);

  Canvas.Pen.Style:= psSolid;
  Canvas.Pen.Width:= 3;
  Canvas.Brush.Style:= bsClear;
  Canvas.Pen.Color:= clBlue;

  Canvas.MoveTo(0, 0);
  Canvas.LineTo(ClientWidth, 0); //Top
  Canvas.LineTo(ClientWidth, ClientHeight+FBtnHeight); //Right
  Canvas.LineTo(ClientWidth-FBtnWidth, ClientHeight+FBtnHeight); //Bottom of Button
  Canvas.LineTo(ClientWidth-FBtnWidth, ClientHeight); //Left of Button
  Canvas.LineTo(0, ClientHeight); //Bottom
  Canvas.LineTo(0, 0);

end;

procedure TFloatBar.PaintBorder;
begin
  Canvas.Handle:= GetWindowDC(Handle);
  try

    //TODO: Paint "transparent" area by painting parent...


    //Paint NC button background
    Canvas.Brush.Style:= bsSolid;
    Canvas.Pen.Style:= psClear;
    Canvas.Brush.Color:= Color;
    Canvas.Rectangle(ClientWidth-FBtnWidth, ClientHeight, ClientWidth, ClientHeight+FBtnHeight);

    //Paint NC button border
    Canvas.Pen.Style:= psSolid;
    Canvas.Pen.Width:= 3;
    Canvas.Brush.Style:= bsClear;
    Canvas.Pen.Color:= clBlue;
    Canvas.MoveTo(ClientWidth, ClientHeight);
    Canvas.LineTo(ClientWidth, ClientHeight+FBtnHeight);
    Canvas.LineTo(ClientWidth-FBtnWidth, ClientHeight+FBtnHeight);
    Canvas.LineTo(ClientWidth-FBtnWidth, ClientHeight);

    //Paint NC Button Chevron      //TODO: Calculate chevron size/position
    if FCollapsed then begin
      Canvas.MoveTo(ClientWidth-30, ClientHeight+7);
      Canvas.LineTo(ClientWidth-25, ClientHeight+13);
      Canvas.LineTo(ClientWidth-20, ClientHeight+7);
    end else begin
      Canvas.MoveTo(ClientWidth-30, ClientHeight+13);
      Canvas.LineTo(ClientWidth-25, ClientHeight+7);
      Canvas.LineTo(ClientWidth-20, ClientHeight+13);
    end;
  finally
    ReleaseDC(Handle, Canvas.Handle);
  end;
end;

end.

... I'm supposed to first check Msg.CalcValidRects, and only do my calculation if it's True.

你错了。该消息有一个有点复杂的机制,documentation 可能会有点混乱,试图解释消息运行的两种不同模式(wParam true 或 false)。与您的案例相关的部分是lParam的第二段:

If wParam is FALSE, lParam points to a RECT structure. On entry, the structure contains the proposed window rectangle for the window. On exit, the structure should contain the screen coordinates of the corresponding window client area.

您会在 VCL 中找到许多这种简单形式的用法示例,其中根本没有检查 wParam,例如 TToolWindow.WMNCCalcSizeTCustomCategoryPanel.WMNCCalcSize 等。

(请注意,当 wParam 为 false 时,NCCALCSIZE_PARAMS.rgrc 甚至不是矩形数组,但由于您在假定的 first 矩形上进行操作,你很好。)