BorderWidth> 0的错误修复与滚动条组合?

NGL*_*GLN 5 delphi scrollbar

在编写自定义控件时,在尝试BorderWidth正确实现默认属性时,我似乎偶然发现了滚动条显示时绘画行为中的错误:滚动条和控件范围之间的空格未绘制.

要重现该错误,请OnCreate为新项目的主窗体实现以下处理程序:

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;
Run Code Online (Sandbox Code Playgroud)

D7和XE2的结果:

在此输入图像描述

这似乎在Delphi XE2中得到了解决.可能,这个bug会存在TWinControl.WMNCPaint,但是看看Controls.pas,我发现D7和XE2之间的实现没有任何显着差异.

我想得到答案:

  • 如何写这个奇怪的错误修复,
  • 从哪个Delphi版本这个bug似乎得到修复.

NGL*_*GLN 4

从哪个 Delphi 版本修复?

在QualityCentral关于BorderWidth的搜索结果显示,之前没有报告过这个bug。Bug QC 2433(已在 D2010 更新 4 中解决)似乎相关,但从评论中我了解到该 Bug 在 D2007 中不存在。

不过,这里更需要来自社区的验证。

如何修复 < D2007 版本?

覆盖WM_NCPAINT消息处理程序:

  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;
Run Code Online (Sandbox Code Playgroud)

两个绘制的矩形故意太大,以便在调整大小时提供更好的效果。

  • 无法使用 D2007 进行复制。 (2认同)