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;