Come disegnare un bordo personalizzato all'interno dell'area non client di un controllo con le barre di scorrimento?

Question

Ho un controllo personalizzato con entrambe le barre di scorrimento abilitate e desidero disegnare un semplice bordo della linea rossa attorno all'area client e alle barre di scorrimento, come nell'immagine qui sotto. Come faccio questo?

Questo è il codice di controllo:

unit SuperList; 

interface 

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

type 

    TSuperList = class(TCustomControl) 
    protected 
    procedure Paint; override; 
    procedure CreateParams(var Params: TCreateParams); override; 
    public 
    constructor Create(AOwner: TComponent); override; 
    end; 

implementation 

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

constructor TSuperList.Create(AOwner: TComponent); 
begin 
inherited; 
Color:=clBlack; 
Width:=300; 
Height:=250; 
end; 

procedure TSuperList.Paint; 
begin 
Canvas.Pen.Color:=clNavy; 
Canvas.Brush.Color:=clWhite; 
Canvas.Rectangle(ClientRect); // a test rectangle te see the client area 
end; 

end. 

Answer 1

Pubblica la proprietà BorderWidth, e implementare un gestore WM_NCPAINT messaggio, come mostrato nella this answer, combinata con il codice in this answer:

type 
    TSuperList = class(TCustomControl) 
    private 
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND; 
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT; 
    protected 
    procedure CreateParams(var Params: TCreateParams); override; 
    procedure Paint; override; 
    public 
    constructor Create(AOwner: TComponent); override; 
    published 
    property BorderWidth default 10; 
    end; 

implementation 

constructor TSuperList.Create(AOwner: TComponent); 
begin 
    inherited Create(Aowner); 
    ControlStyle := ControlStyle - [csOpaque]; 
    BorderWidth := 10; 
end; 

procedure TSuperList.CreateParams(var Params: TCreateParams); 
begin 
    inherited CreateParams(Params); 
    Params.Style := Params.Style or WS_VSCROLL or WS_HSCROLL; 
    Params.WindowClass.style := 
    Params.WindowClass.style and not (CS_HREDRAW or CS_VREDRAW); 
end; 

procedure TSuperList.Paint; 
begin 
    Canvas.Brush.Color := RGB(Random(255), Random(255), Random(255)); 
    Canvas.FillRect(Canvas.ClipRect); 
end; 

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

procedure TSuperList.WMNCPaint(var Message: TWMNCPaint); 
var 
    DC: HDC; 
    R: TRect; 
    WindowStyle: Integer; 
begin 
    inherited; 
    if BorderWidth > 0 then 
    begin 
    DC := GetWindowDC(Handle); 
    try 
     R := ClientRect; 
     OffsetRect(R, BorderWidth, BorderWidth); 
     ExcludeClipRect(DC, R.Left, R.Top, R.Right, R.Bottom); 
     WindowStyle := GetWindowLong(Handle, GWL_STYLE); 
     if WindowStyle and WS_VSCROLL <> 0 then 
     ExcludeClipRect(DC, R.Right, R.Top, 
      R.Right + GetSystemMetrics(SM_CXVSCROLL), R.Bottom); 
     if WindowStyle and WS_HSCROLL <> 0 then 
     ExcludeClipRect(DC, R.Left, R.Bottom, R.Right, 
      R.Bottom + GetSystemMetrics(SM_CXHSCROLL)); 
     SetRect(R, 0, 0, Width + BorderWidth, Height + BorderWidth); 
     Brush.Color := clRed; 
     FillRect(DC, R, Brush.Handle); 
    finally 
     ReleaseDC(Handle, DC); 
    end; 
    end; 
    Message.Result := 0; 
end; 

Answer 2

Si sta cercando di dipingere (parziale) nel Nonclient Area.
È possibile aggiungere WS_DLGFRAME allo Params.Style e gestire il messaggio WM_NCPaint per dipingere sull'HDC della finestra.

TSuperList = class(TCustomControl) 
    private 
    procedure PaintBorder; 
    procedure WMNCActivate(var Msg: TWMNCActivate); message WM_NCActivate; 
    procedure WMNCPaint(var Msg: TWMNCPaint);message WM_NCPaint; 
    protected 
    procedure Paint; override; 
    procedure CreateParams(var Params: TCreateParams); override; 
    public 
    constructor Create(AOwner: TComponent); override; 
    end; 

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

procedure TSuperList.WMNCActivate(var Msg: TWMNCActivate); 
begin 
    inherited; 
    PaintBorder; 
end; 

procedure TSuperList.WMNCPaint(var Msg: TWMNCPaint); 
begin 
    inherited; 
    PaintBorder; 
end; 

procedure TSuperList.PaintBorder; 
begin 
    Canvas.Handle := GetWindowDC(Handle); 
    Canvas.Pen.Color := clNavy; 
    Canvas.Pen.Width := 2; 
    Canvas.Brush.Style := bsClear; 
    Canvas.Rectangle(Rect(1,1,Width,Height)); 
    ReleaseDC(Handle,Canvas.Handle); 
end;  

constructor TSuperList.Create(AOwner: TComponent); 
begin 
inherited; 
Color:=clBlack; 
Width:=300; 
Height:=250; 
end; 

procedure TSuperList.Paint; 
begin 
Canvas.Brush.Color:=clWhite; 
Canvas.Pen.Style := psClear; 
Canvas.Rectangle(ClientRect); 
Canvas.Pen.Style := psSolid; 
Canvas.Ellipse(0,0,20,20); 
end;