Delphi 如何使用滚动条在控件的非客户端区域内绘制自定义边框？

我有一个自定义控件，启用了两个滚动条，我想在客户端区域和滚动条周围画一个简单的红线边框，如下图所示。我是怎么做到的

这是控制代码：

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.

您正在尝试在中绘制（部分）。
您可以将

WS_DLGFRAME

添加到

Params.Style

并处理消息

WM_NCPaint

在窗口的HDC上绘制

  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;

---

发布

BorderWidth

属性，并实现

WM\u NCPAINT

消息处理程序，如中所示，与中的代码结合使用：

类型
TSuperList=class（TCustomControl）
私有的
程序WMEraseBkgnd（var消息：TWMEraseBkgnd）；消息WM_ERASEBKGND；
程序WMNCPaint（var消息：TWMNCPaint）；消息WM_NCPAINT；
受保护的
过程CreateParams（变量参数：TCreateParams）；推翻
程序漆；推翻
公众的
构造函数创建（AOwner:TComponent）；推翻
出版
属性边框宽度默认值为10；
结束；
实施
构造函数TSuperList.Create（所有者：TComponent）；
开始
继承的创建（AOOwner）；
ControlStyle:=ControlStyle-[CS不透明]；
边框宽度：=10；
结束；
过程TSuperList.CreateParams（变量参数：TCreateParams）；
开始
继承的CreateParams（Params）；
Params.Style:=Params.Style或WS_VSCROLL或WS_HSCROLL；
Params.WindowClass.style：=
参数WindowClass.style和not（CS_HREDRAW或CS_VREDRAW）；
结束；
程序清单。油漆；
开始
Canvas.Brush.Color:=RGB（随机（255）、随机（255）、随机（255））；
Canvas.FillRect（Canvas.ClipRect）；
结束；
过程TSuperList.WMEraseBkgnd（变量消息：TWMEraseBkgnd）；
开始
消息。结果：=1；
结束；
过程TSuperList.WMNCPaint（变量消息：TWMNCPaint）；
变量
DC:HDC；
R:TRect；
WindowStyle：整数；
开始
继承；
如果BorderWidth>0，则
开始
DC:=GetWindowDC（句柄）；
尝试
R:=ClientRect；
偏移量（R、BorderWidth、BorderWidth）；
不包括（直流、右左、右上、右右下）；
WindowStyle:=GetWindowLong（句柄，GWL_样式）；
如果WindowStyle和WS_VSCROLL为0，则
不包括（直流，右上，右上，
右+GetSystemMetrics（SM_CXVSCROLL），右下）；
如果WindowStyle和wshscroll为0，则
不包括CLIPRECT（直流，右左，右下，右下，
R.底部+GetSystemMetrics（SM_CXHSCROLL））；
SetRect（R，0，0，Width+BorderWidth，Height+BorderWidth）；
画笔颜色：=clRed；
FillRect（直流，右，刷柄）；
最后
释放DC（手柄，DC）；
结束；
结束；
消息。结果：=0；
结束；
 > OK，但我希望边框的宽度是可变的，而<>代码> WSZDLGFrime>代码> AlcAATE只是一个固定的2像素边界。WSX粗框会给你更多的空间，如果你需要在你的控制下完全有一个可变的空间，你可以考虑创建一个超级列表作为子组件的组件。这在Windows7家庭高级版、64位、支持Aero的Delphi2009中无法正常工作。如果您将控件的一部分移到显示器外，然后再移回来，滚动条中始终可见的部分就会被涂掉。@很抱歉，我还没有解决方案。（顺便说一句，我发现问题在于
TScrollBox
也有
BorderWidth>0
，因此可能与此代码无关。）
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;