delphiresizenonclient-area

How to reflect the changes after I resize the non-client area?


I want to make a custom control with a selectable border size. See the code below. The border is drawn in the non-client area and his width can be 0, 1 or 2 pixels. I've successfully done the border drawings in the WM_NCPAINT. The problem is that after I change the property that control the border size I don't know how to tell the system to recalculate the new dimensions of client and non-client areas. I've noticed that when I resize the window (with the mouse) the changes are applied, but I donn't know how to do that immediately after I change the border size.

Example

SuperList.pas

unit SuperList;

interface

uses Windows, Controls, Graphics, Classes, Messages, SysUtils, StdCtrls, UxTheme;

type

  TBorderType = (btNone, btSingle, btDouble);

  TSuperList = class(TCustomControl)
  private
    HHig,HMidH,HMidL,HLow:TColor;
    BCanvas: TCanvas;
    FBorderSize: TBorderType;
    procedure SetBorderSize(const Value:TBorderType);
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
  protected
    procedure Paint; override;
    procedure CreateParams(var Params: TCreateParams); override;
  public
    constructor Create(AOwner:TComponent); override;
  published
    property BorderType:TBorderType read FBorderSize write SetBorderSize default btDouble;
  end;

implementation

constructor TSuperList.Create(AOwner:TComponent);
begin
  inherited;
  BCanvas:=TCanvas.Create;
  FBorderSize:=btDouble;
  HHig:=clWhite; HMidH:=clBtnFace; HMidL:=clGray; HLow:=cl3DDkShadow;
end;

procedure TSuperList.CreateParams(var Params: TCreateParams);
begin
  inherited;
  Params.Style := Params.Style or WS_VSCROLL or WS_HSCROLL;
end;

procedure TSuperList.SetBorderSize(const Value:TBorderType);
begin
 if Value<>FBorderSize then begin
  FBorderSize:=Value;

  // .... ??????  I think here must be done something...

  Perform(WM_NCPAINT,1,0);   // repainting the non-client area (I do not know how can I invalidate the non-client area differently)
  Invalidate;                // repainting the client area
  // I've tried even with the... RedrawWindow(Handle,nil,0,RDW_FRAME or RDW_INVALIDATE or RDW_UPDATENOW or RDW_INTERNALPAINT);
 end;
end;

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

procedure TSuperList.WMSize(var Message: TWMSize);
begin
 inherited;
 Perform(WM_NCPAINT,1,0);
end;

procedure TSuperList.WMNCCalcSize(var Message: TWMNCCalcSize);
begin
 inherited;
 if FBorderSize>btNone then
  InflateRect(Message.CalcSize_Params^.rgrc0,-Integer(FBorderSize),-Integer(FBorderSize));
end;

procedure TSuperList.Paint;
begin
 Canvas.Brush.Color:=clWhite;
 Canvas.FillRect(ClientRect);
end;

procedure TSuperList.WMNCPaint(var Message: TWMNCPaint);
var DC: HDC;
    R: TRect;
    HS_Size,VS_Size:Integer;
    HS_Vis,VS_Vis:Boolean;
begin
  inherited;
  Message.Result:=0;
  if FBorderSize>btNone then
  begin
    DC:=GetWindowDC(Handle); if DC=0 then Exit;
    BCanvas.Handle:=DC;
    BCanvas.Pen.Color:=clNone;
    BCanvas.Brush.Color:=clNone;
    try
      VS_Size:=GetSystemMetrics(SM_CXVSCROLL);
      HS_Size:=GetSystemMetrics(SM_CYHSCROLL);
      VS_Vis:=GetWindowLong(Handle,GWL_STYLE) and WS_VSCROLL <> 0;
      HS_Vis:=GetWindowLong(Handle,GWL_STYLE) and WS_HSCROLL <> 0;
      R:=ClientRect;
      OffsetRect(R,Integer(FBorderSize),Integer(FBorderSize));
      if VS_Vis and HS_Vis then begin
       ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom+HS_Size);
       ExcludeClipRect(DC, R.Left, R.Top, R.Right+VS_Size, R.Bottom);
       BCanvas.Brush.Color:=HMidH;
       R.Right:=Width-Integer(FBorderSize); R.Left:=R.Right-VS_Size;
       R.Bottom:=Height-Integer(FBorderSize); R.Top:=R.Bottom-HS_Size;
       BCanvas.FillRect(R);
      end else begin
       if VS_Vis then Inc(R.Right,VS_Size);
       if HS_Vis then Inc(R.Bottom,HS_Size);
       ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom);
      end;
      BCanvas.MoveTo(0,Height-1);
      BCanvas.Pen.Color:=HMidL; BCanvas.LineTo(0,0); BCanvas.LineTo(Width-1,0);
      if IsThemeActive then begin
       BCanvas.Pen.Color:=HMidL;
       BCanvas.LineTo(Width-1,Height-1);
       BCanvas.LineTo(-1,Height-1);
      end else begin
       if FBorderSize=btDouble then begin
        BCanvas.Pen.Color:=HHig;
        BCanvas.LineTo(Width-1,Height-1);
        BCanvas.LineTo(-1,Height-1);
       end else begin
        if VS_Vis then BCanvas.Pen.Color:=HHig else BCanvas.Pen.Color:=HMidL;
        BCanvas.LineTo(Width-1,Height-1);
        if HS_Vis then BCanvas.Pen.Color:=HHig else BCanvas.Pen.Color:=HMidL;
        BCanvas.LineTo(-1,Height-1);
       end;
      end;
      if FBorderSize=btDouble then begin
       BCanvas.MoveTo(1,Height-2);
       BCanvas.Pen.Color:=HLow; BCanvas.LineTo(1,1); BCanvas.LineTo(Width-2,1);
       BCanvas.Pen.Color:=HMidH; BCanvas.LineTo(Width-2,Height-2); BCanvas.LineTo(0,Height-2);
      end;
    finally
      ReleaseDC(Handle,DC);
    end;
  end;
end;

end.

Unit1.pas

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, SuperList, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  public
    List: TSuperList;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
 List:=TSuperList.Create(self);
 List.Parent:=Form1;
 List.Margins.Left:=20; List.Margins.Right:=20;
 List.Margins.Top:=50; List.Margins.Bottom:=20;
 List.AlignWithMargins:=true;
 List.Align:=alClient;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 List.BorderType:=btNone;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 List.BorderType:=btSingle;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
 List.BorderType:=btDouble;
end;

end.

Solution

  • Send a CM_BORDERCHANGED message:

    Perform(CM_BORDERCHANGED, 0, 0);
    

    This will fire the handler in TWinControl:

    procedure TWinControl.CMBorderChanged(var Message: TMessage);
    begin
      inherited;
      if HandleAllocated then
      begin
        SetWindowPos(Handle, 0, 0,0,0,0, SWP_NOACTIVATE or
        SWP_NOZORDER or SWP_NOMOVE or SWP_NOSIZE or SWP_FRAMECHANGED);
        if Visible then
          Invalidate;
      end;
    end;
    

    And from the documentation on SetWindowPos:

    SWP_FRAMECHANGED: Applies new frame styles set using the SetWindowLong function. Sends a WM_NCCALCSIZE message to the window, even if the window's size is not being changed. If this flag is not specified, WM_NCCALCSIZE is sent only when the window's size is being changed.