具有非客户区域的自定义控制 - 最初不计算

Jer*_*dge 6 delphi winapi custom-controls nonclient-area

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

到目前为止,我已经中途工作了.问题是它不会预先计算非客户区域,除非我做一个小的调整,例如重新调整它.

我已经按照许多资源描述了如何实现这一目标.我的处理实现WM_NCCALCSIZE与我发现的"工作"示例大致相同.但是,当首次创建控件时,它根本不会计算.当我在mine(WMNCCalcSize)的消息处理程序中放置断点时,根据我发现的示例,我应该首先检查Msg.CalcValidRects,并且只进行我的计算True.但是在调试运行时,它是False,因此计算没有完成.

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

调整大小之前和之后

顶部的图像是最初创建/显示表单的时间.第二个是在我重新调整它的大小之后.注意对齐的测试按钮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.
Run Code Online (Sandbox Code Playgroud)

Ser*_*yuz 11

......我应该先检查一下Msg.CalcValidRects,如果是的话,只做我的计算True.

你错了.该消息有一些有点复杂的机制,文档可能会有点混乱,试图解释消息操作的两种不同模式(wParamtrue或false).与您的案件有关的部分是第二段lParam:

如果wParam为FALSE,则lParam指向RECT结构.在输入时,该结构包含窗口的建议窗口矩形.退出时,结构应包含相应窗口客户区的屏幕坐标.

您可以在VCL中找到这个简单表单的大量用法示例,其中wParam根本没有检查,例如TToolWindow.WMNCCalcSize,TCustomCategoryPanel.WMNCCalcSize等等.

(注意,NCCALCSIZE_PARAMS.rgrcwParam为假时,甚至不是矩形数组,但由于你在假定的第一个矩形上运行,你没事.)