Исправление для BorderWidth > 0 в сочетании с полосой прокрутки?
Во время написания пользовательского элемента управления, при попытке реализовать по умолчанию 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;
Результаты для D7 и XE2:
Похоже, это исправлено в Delphi XE2. Вероятно, эта ошибка будет находиться в TWinControl.WMNCPaint
, но глядя на Controls.pas
Я не могу найти каких-либо существенных различий в реализации между D7 и XE2.
Я хотел бы получить ответы на:
- Как написать исправление для этой странности,
- В какой версии Delphi эта ошибка, кажется, исправлена.
1 ответ
С какой версии Delphi исправлена?
Результаты поиска в QualityCentral на BorderWidth показывают, что об этой ошибке ранее не сообщалось. Ошибка QC 2433 (которая была устранена в D2010, обновление 4), похоже, связана, но из комментариев я понимаю, что рассматриваемая ошибка не существует в 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;
Два нарисованных ректа намеренно слишком велики, что дает лучшие результаты при изменении размера.
Переопределить 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;
Два нарисованных ректа намеренно слишком велики, что дает лучшие результаты при изменении размера.