Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Bugfix for BorderWidth > 0 in combination with a scroll bar?

During writing a custom control, while trying to implement the default BorderWidth property correctly, I seem to have stumbled upon a bug in the painting behaviour when scroll bars are shown: the spaces between the scroll bars and the control's extent are not painted.

To reproduce the bug, implement the following OnCreate handler for the main form of a new project:

procedure TForm1.FormCreate(Sender: TObject);
begin
  AutoScroll := True;
  BorderWidth := 20;
  SetBounds(10, 10, 200, 200);
  with TGroupBox.Create(Self) do
  begin
    SetBounds(300, 300, 50, 50);
    Parent := Self;
  end;
end;

The results for D7 and XE2:

enter image description here

It seems that this is fixed at last in Delphi XE2. Likely, this bug would reside in TWinControl.WMNCPaint, but looking at Controls.pas, I cannot find any significant differences in the implementation between D7 and XE2.

I would like to get answers on:

  • How to write a bugfix for this oddity,
  • From which Delphi version this bug seems to be fixed.
like image 294
NGLN Avatar asked Oct 05 '22 02:10

NGLN


1 Answers

From which Delphi version fixed?

The search results in QualityCentral on BorderWidth shows that this bug is not reported before. Bug QC 2433 (which was resolved in D2010, update 4) seems related, but from the comments I understand the bug in question does not exist in D2007.

Verification from the community here is more needed though.

How to fix for versions < D2007?

Override the WM_NCPAINT message handler:

  private
    procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;

procedure TForm1.WMNCPaint(var Message: TWMNCPaint);
{$IF CompilerVersion < 19}
var
  DC: HDC;
  WindowStyle: Longint;
  TotalBorderWidth: Integer;
{$IFEND}
begin
{$IF CompilerVersion < 19}
  DC := GetWindowDC(Handle);
  try
    WindowStyle := GetWindowLong(Handle, GWL_STYLE);
    if WindowStyle and WS_VSCROLL <> 0 then
      TotalBorderWidth := (Width - ClientWidth - GetSystemMetrics(SM_CXVSCROLL)) div 2
    else
      TotalBorderWidth := (Width - ClientWidth) div 2;
    if WindowStyle and WS_HSCROLL <> 0 then
      FillRect(DC, Rect(0, Height - TotalBorderWidth, Width, Height), Brush.Handle);
    if WindowStyle and WS_VSCROLL <> 0 then
      FillRect(DC, Rect(Width - TotalBorderWidth, 0, Width, Height), Brush.Handle);
  finally
    ReleaseDC(Handle, DC);
  end;
{$IFEND}
  inherited;
end;

The two drawn rects are intentionally too large, giving better results at resizing.

like image 136
NGLN Avatar answered Oct 10 '22 02:10

NGLN