CODEWITHSUNDEEP
delphidelphi-5
ZigiZ
ZigiZ

Reputation: 2520

TScrollBox with customized flat border color and width?

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.

Upvotes: 4

Views: 2019

Answers (1)

NGLN
NGLN

Reputation: 43649

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;

Upvotes: 5

Related Questions