delphi - 如何在带有滚动条的控件的非客户区域内绘制自定义边框？

Question

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

这是控制代码:

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

发布 BorderWidth 属性，并实现 WM_NCPAINT 消息处理程序，如 this answer 中所示，结合 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;