delphi - Los títulos de TLabel y TGroupbox parpadean al cambiar el tamaño

delphi-xe flicker

Question

• Entonces, tengo una aplicación que carga diferentes complementos y crea una nueva pestaña en un TPageControl para cada uno.
• Cada DLL tiene un TForm asociado.
• Los formularios se crean con su padre hWnd como el nuevo TTabSheet.

• Como las TTabSheets no son un elemento primario del formulario en lo que respecta a VCL ( no quise usar RTL dinámico y complementos hechos en otros idiomas ), tengo que manejar los cambios de tamaño manualmente. Lo hago como a continuación:

  var
  ChildHandle : DWORD;
  begin
  If Assigned(pcMain.ActivePage) Then
  begin
  ChildHandle := FindWindowEx(pcMain.ActivePage.Handle, 0, ''TfrmPluginForm'', nil);
  If ChildHandle > 0 Then
  begin
  SetWindowPos(ChildHandle, 0, 0, 0, pcMain.ActivePage.Width, pcMain.ActivePage.Height, SWP_NOZORDER + SWP_NOACTIVATE + SWP_NOCOPYBITS);
  end;
  end;

Ahora, mi problema es que cuando se cambia el tamaño de la aplicación, todos los TGroupBoxes y TLabels dentro de los TGroupBoxes parpadean. Los TLabels que no están dentro de TGroupboxes están bien y no parpadean.

Cosas que he intentado:

• WM_SETREDRAW seguido de una RedrawWindow
• ParentBackground en TGroupBoxes y TLabels establecido en False
• DoubleBuffer: = True
• LockWindowUpdate ( Sí, aunque sé que está muy muy mal )
• Transparente: = Falso ( incluso anulando crear para editar ControlState )

¿Algunas ideas?

Answer 1

Coloque encima de su formulario ( interfaz ) o póngalo todo en una nueva unidad para incluir:

TLabel = class( stdCtrls.TLabel )
protected
procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
end;

Pon esto en la parte de implementación

procedure TLabel.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
Message.Result:=1; // Fake erase
end;

repita este paso para TGroupBox

Answer 2

Esta es la solución que uso con éxito en mi proyecto en varias formas. Está un poco sucio porque usa funciones winapi. En comparación con la respuesta de David, no incluye la penalización de rendimiento. El punto es sobrescribir el manejador de mensajes para el mensaje WM_ERASEBKGND para el formulario y todas sus ventanas secundarias.

typedef LRESULT CALLBACK(*PWndProc)(HWND, UINT, WPARAM, LPARAM);
void SetNonFlickeringWndProc(TWinControl &control, std::map<HWND,PWndProc> &list, PWndProc new_proc)
{
if (control.Handle == 0)
{
return;
}
PWndProc oldWndProc = (PWndProc)SetWindowLong(control.Handle, GWL_WNDPROC, (LONG)new_proc);
list[control.Handle] = oldWndProc;
int count = control.ControlCount;
for (int i = 0; i < count; i++)
{
TControl *child_control = control.Controls[i];
TWinControl *child_wnd_control = dynamic_cast<TWinControl*>(child_control);
if (child_wnd_control == NULL)
{
continue;
}
SetNonFlickeringWndProc(*child_wnd_control, list, new_proc);
}
}
void RestoreWndProc(std::map<HWND,PWndProc> &old_wnd_proc)
{
std::map<HWND,PWndProc>::iterator it;
for (it = old_wnd_proc.begin(); it != old_wnd_proc.end(); it++)
{
LONG res = SetWindowLong(it->first, GWL_WNDPROC, (LONG)it->second);
}
old_wnd_proc.clear();
}
std::map<HWND,PWndProc> oldwndproc; // addresses for window procedures for all components in form
LRESULT CALLBACK NonFlickeringWndProc(HWND hwnd, UINT uMsg, WPARAM wParam, LPARAM lParam)
{
if (uMsg == WM_ERASEBKGND)
{
return 1;
}
return ((PWndProc)oldwndproc[hwnd])(hwnd, uMsg, wParam, lParam);
}
void __fastcall TForm1::FormShow(TObject *Sender)
{
oldwndproc.clear();
SetNonFlickeringWndProc(*this, oldwndproc, &NonFlickeringWndProc);
}
void __fastcall TForm1::FormClose(TObject* Sender, TCloseAction& Action)
{
RestoreWndProc(oldwndproc_etype);
}

Nota importante: la propiedad DoubleBufferd for form debe activarse si no desea ver rayas negras en los lados.

Answer 3

Lo único que he encontrado que funciona bien es usar el estilo de ventana WS_EX_COMPOSITED . Este es un cerdo de rendimiento, así que solo lo habilito cuando estoy en un ciclo de tamaño. Según mi experiencia, con los controles integrados, en mi aplicación, el parpadeo solo se produce al cambiar el tamaño de los formularios.

Primero debe realizar una prueba rápida para ver si este enfoque lo ayudará simplemente agregando el estilo de ventana WS_EX_COMPOSITED a todos sus controles con ventana. Si eso funciona, puede considerar el enfoque más avanzado a continuación:

Quick hack

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;

Llámalo, por ejemplo, en OnShow para tu TForm , pasando la instancia del formulario. Si eso ayuda, entonces deberías implementarlo de manera más perspicaz. Te doy los extractos relevantes de mi código para ilustrar cómo lo hice.

Código completo

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;

Esto no compilará para usted, pero debe contener algunas ideas útiles. ControlEnumerator es mi utilidad para convertir una caminata recursiva de los controles secundarios en un bucle plano. Tenga en cuenta que también utilizo un divisor personalizado que llama BeginSizing / EndSizing cuando está activo.

Otro truco útil es usar TStaticText lugar de TLabel que de vez en cuando debes hacer cuando tienes un anidamiento profundo de controles y paneles de página.

Utilicé este código para hacer que mi aplicación fuera 100% libre de parpadeo, pero me llevó siglos y años experimentar para tener todo en su lugar. Con suerte, otros pueden encontrar algo útil aquí.

Answer 4

Use el VCL Fix Pack de Andreas Hausladen .

Además: no especifique el indicador SWP_NOCOPYBITS y establezca DoubleBuffered del PageControl:

uses
VCLFixPack;
procedure TForm1.FormCreate(Sender: TObject);
begin
PageControl1.DoubleBuffered := True;
//Setup test conditions:
FForm2 := TForm2.Create(Self);
FForm2.BorderStyle := bsNone;
FForm2.BoundsRect := TabSheet1.ClientRect;
Windows.SetParent(FForm2.Handle, TabSheet1.Handle);
FForm2.Show;
PageControl1.Anchors := [akLeft, akTop, akRight, akBottom];
PageControl1.OnResize := PageControl1Resize;
end;
procedure TForm1.PageControl1Resize(Sender: TObject);
begin
SetWindowPos(FForm2.Handle, 0, 0, 0, TabSheet1.ClientWidth,
TabSheet1.ClientHeight, SWP_NOZORDER + SWP_NOACTIVATE);
end;