Единственное, что я нашел, чтобы работать хорошо, это использовать стиль окна WS_EX_COMPOSITED
.Это снижение производительности, поэтому я включаю его только в цикле калибровки.По моему опыту, со встроенными элементами управления в моем приложении мерцание возникает только при изменении размеров форм.
Сначала вы должны выполнить быстрый тест, чтобы увидеть, поможет ли этот подход, просто добавив WS_EX_COMPOSITED
стиль окна для всех ваших оконных элементов управления.Если это работает, вы можете рассмотреть более продвинутый подход ниже:
Быстрый взлом
procedure EnableComposited(WinControl: TWinControl);
var
i: Integer;
NewExStyle: DWORD;
begin
NewExStyle := GetWindowLong(WinControl.Handle, GWL_EXSTYLE) or WS_EX_COMPOSITED;
SetWindowLong(WinControl.Handle, GWL_EXSTYLE, NewExStyle);
for i := 0 to WinControl.ControlCount-1 do
if WinControl.Controls[i] is TWinControl then
EnableComposited(TWinControl(WinControl.Controls[i]));
end;
Назовите это, например, в OnShow
для вашего TForm
, передавая экземпляр формы.Если это поможет, тогда вы действительно должны реализовать это более проницательно.Я даю вам соответствующие выдержки из моего кода, чтобы проиллюстрировать, как я это сделал.
Полный код
procedure TMyForm.WMEnterSizeMove(var Message: TMessage);
begin
inherited;
BeginSizing;
end;
procedure TMyForm.WMExitSizeMove(var Message: TMessage);
begin
EndSizing;
inherited;
end;
procedure SetComposited(WinControl: TWinControl; Value: Boolean);
var
ExStyle, NewExStyle: DWORD;
begin
ExStyle := GetWindowLong(WinControl.Handle, GWL_EXSTYLE);
if Value then begin
NewExStyle := ExStyle or WS_EX_COMPOSITED;
end else begin
NewExStyle := ExStyle and not WS_EX_COMPOSITED;
end;
if NewExStyle<>ExStyle then begin
SetWindowLong(WinControl.Handle, GWL_EXSTYLE, NewExStyle);
end;
end;
function TMyForm.SizingCompositionIsPerformed: Boolean;
begin
//see The Old New Thing, Taxes: Remote Desktop Connection and painting
Result := not InRemoteSession;
end;
procedure TMyForm.BeginSizing;
var
UseCompositedWindowStyleExclusively: Boolean;
Control: TControl;
WinControl: TWinControl;
begin
if SizingCompositionIsPerformed then begin
UseCompositedWindowStyleExclusively := Win32MajorVersion>=6;//XP can't handle too many windows with WS_EX_COMPOSITED
for Control in ControlEnumerator(TWinControl) do begin
WinControl := TWinControl(Control);
if UseCompositedWindowStyleExclusively then begin
SetComposited(WinControl, True);
end else begin
if WinControl is TPanel then begin
TPanel(WinControl).FullRepaint := False;
end;
if (WinControl is TCustomGroupBox) or (WinControl is TCustomRadioGroup) or (WinControl is TCustomGrid) then begin
//can't find another way to make these awkward customers stop flickering
SetComposited(WinControl, True);
end else if ControlSupportsDoubleBuffered(WinControl) then begin
WinControl.DoubleBuffered := True;
end;
end;
end;
end;
end;
procedure TMyForm.EndSizing;
var
Control: TControl;
WinControl: TWinControl;
begin
if SizingCompositionIsPerformed then begin
for Control in ControlEnumerator(TWinControl) do begin
WinControl := TWinControl(Control);
if WinControl is TPanel then begin
TPanel(WinControl).FullRepaint := True;
end;
UpdateDoubleBuffered(WinControl);
SetComposited(WinControl, False);
end;
end;
end;
function TMyForm.ControlSupportsDoubleBuffered(Control: TWinControl): Boolean;
const
NotSupportedClasses: array [0..1] of TControlClass = (
TCustomForm,//general policy is not to double buffer forms
TCustomRichEdit//simply fails to draw if double buffered
);
var
i: Integer;
begin
for i := low(NotSupportedClasses) to high(NotSupportedClasses) do begin
if Control is NotSupportedClasses[i] then begin
Result := False;
exit;
end;
end;
Result := True;
end;
procedure TMyForm.UpdateDoubleBuffered(Control: TWinControl);
function ControlIsDoubleBuffered: Boolean;
const
DoubleBufferedClasses: array [0..2] of TControlClass = (
TMyCustomGrid,//flickers when updating
TCustomListView,//flickers when updating
TCustomStatusBar//drawing infidelities , e.g. my main form status bar during file loading
);
var
i: Integer;
begin
if not InRemoteSession then begin
//see The Old New Thing, Taxes: Remote Desktop Connection and painting
for i := low(DoubleBufferedClasses) to high(DoubleBufferedClasses) do begin
if Control is DoubleBufferedClasses[i] then begin
Result := True;
exit;
end;
end;
end;
Result := False;
end;
var
DoubleBuffered: Boolean;
begin
if ControlSupportsDoubleBuffered(Control) then begin
DoubleBuffered := ControlIsDoubleBuffered;
end else begin
DoubleBuffered := False;
end;
Control.DoubleBuffered := DoubleBuffered;
end;
procedure TMyForm.UpdateDoubleBuffered;
var
Control: TControl;
begin
for Control in ControlEnumerator(TWinControl) do begin
UpdateDoubleBuffered(TWinControl(Control));
end;
end;
Это не скомпилируется для вас, но должносодержат некоторые полезные идеи.ControlEnumerator
- моя утилита для превращения рекурсивного обхода дочерних элементов управления в плоский цикл for
.Обратите внимание, что я также использую пользовательский сплиттер, который вызывает BeginSizing / EndSizing, когда он активен.
Еще один полезный трюк - это использование TStaticText
вместо TLabel
, которое иногда требуется, когда у вас есть глубокая вложенностьэлементы управления страниц и панелей.
Я использовал этот код, чтобы сделать мое приложение без мерцания на 100%, но мне потребовались годы и годы экспериментов, чтобы все это было на месте.Надеюсь, что другие могут найти что-то полезное здесь.