delphi – 具有非客户区域的自定义控件 – 最初不计算

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

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

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

顶部的图像是最初创建/显示表单的时间.第二个是在我重新调整它的大小之后.注意测试按钮,它是alLeft对齐的.所以最初,它消耗了应该是非客户端的区域.

如果我注释掉检查Msg.CalcValidRects然后开始,那么它会正确计算.但我看到每个例子都在做这个检查,我很确定它是必要的.

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

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);
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+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+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);

    //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.