TScrollBox with customized flat border color and width?

Question

I'm trying to create a TScrollBox with flat border instead of the ugly "Ctl3D" one.

Here is what I have tried, yet the border is not visible:

type
  TScrollBox = class(Forms.TScrollBox)
  private
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
  protected
  public
    constructor Create(AOwner: TComponent); override;
  end;

...

constructor TScrollBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  BorderStyle := bsNone;
  BorderWidth := 1; // This will handle the client area
end;

procedure TScrollBox.WMNCPaint(var Message: TWMNCPaint);
var
  DC: HDC;
  R: TRect;
  FrameBrush: HBRUSH;
begin
  inherited;
  DC := GetWindowDC(Handle);
  GetWindowRect(Handle, R);
  // InflateRect(R, -1, -1);
  FrameBrush := CreateSolidBrush(ColorToRGB(clRed)); // clRed is here for testing
  FrameRect(DC, R, FrameBrush);
  DeleteObject(FrameBrush);
  ReleaseDC(Handle, DC);
end;

What am I doing wrong?

I would like to customize the border color & width so I can't use BevelKind = bkFlat, plus bkFlat "breaks" with RTL BidiMode and looks really bad.

I actually like the classic Windows 3D style. Reminds me of simpler days. — Andreas Rejbrand, Nov 26 '12 at 12:19

score 5 · Accepted Answer · edited May 23 '17 at 12:04

Indeed, you have to draw the border in a WM_NCPAINT message handler. The device context you obtain with GetWindowDC is relative to the control, while the rectangle you obtain with GetWindowRect is relative to the screen.

The correct rectangle is gotten e.g. by SetRect(R, 0, 0, Width, Height);

Subsequently, set BorderWidth as your wish and ClientRect should follow accordingly. If not, then compensate by overriding GetClientRect. Here are a few examples.

Call the inherited chain of message handlers before your own code, so the scroll bars (when needed) will be drawn correctly. All in all, it should look like:

type
  TScrollBox = class(Forms.TScrollBox)
  private
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
  protected
    procedure Resize; override;
  public
    constructor Create(AOwner: TComponent); override;
  end;

...    

constructor TScrollBox.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  BorderWidth := 1;
end;

procedure TScrollBox.Resize;
begin
  Perform(WM_NCPAINT, 0, 0);
  inherited Resize;
end;

procedure TScrollBox.WMNCPaint(var Message: TWMNCPaint);
var
  DC: HDC;
  B: HBRUSH;
  R: TRect;
begin
  inherited;
  if BorderWidth > 0 then
  begin
    DC := GetWindowDC(Handle);
    B := CreateSolidBrush(ColorToRGB(clRed));
    try
      SetRect(R, 0, 0, Width, Height);
      FrameRect(DC, R, B);
    finally
      DeleteObject(B);
      ReleaseDC(Handle, DC);
    end;
  end;
  Message.Result := 0;
end;

+1!!! `MapWindowPoints` form `TWinControl.WMNCPaint` gave me the idea that I use the wrong coordinates. `SetRect(R, 0, 0, Width, Height)` did the trick. p.s: should I `inhrited` first or should I return `Message.Result := 0;` like you did? — ZigiZ, Nov 26 '12 at 14:25
Call the inherited message handers in front, because that's wherein the scroll bars are drawn. Return zero when processed. — NGLN, Nov 26 '12 at 14:48

TScrollBox with customized flat border color and width?

1 Answers1