Vraag TLabel- en TGroupbox-onderschriften Flikker op formaat wijzigen


  • Dus ik heb een applicatie die verschillende plug-ins laadt en een maakt nieuw tabblad op een TPageControl voor elk.
  • Aan elke DLL is een TForm gekoppeld.
  • De formulieren worden gemaakt met hun bovenliggende hWnd als de nieuwe TTabSheet.
  • Aangezien de TTabSheets voor VCL geen ouder zijn van het formulier (wilde geen dynamische RTL gebruiken en plug-ins die in andere talen zijn gemaakt) Ik moet handmatig de grootte aanpassen. Ik doe dit als volgt:

    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;
    

Nu is mijn probleem dat wanneer de grootte van de toepassing wordt gewijzigd, alle TGroupBoxes en de TLabels in de TGroupBoxes flikkeren. De TLabels die zich niet binnen TGroupboxes bevinden, zijn prima en flikkeren niet.

Dingen die ik heb geprobeerd:

  • WM_SETREDRAW gevolgd door een RedrawWindow
  • ParentBackground op de TGroupBoxes en TLabels ingesteld op False
  • DoubleBuffer: = True
  • LockWindowUpdate (Ja, ook al weet ik dat het heel erg fout is)
  • Transparant: = False (zelfs overschrijven om ControlState te bewerken)

Om het even welke ideeën?


20
2017-11-08 23:59


oorsprong


antwoorden:


Het enige dat ik heb gevonden om goed te werken is om de WS_EX_COMPOSITED venster stijl. Dit is een prestatiezwijn, dus ik kan het alleen inschakelen als het in een lus is. Het is mijn ervaring dat met de ingebouwde bediening in mijn app flikkeren alleen optreedt bij het wijzigen van de grootte van formulieren.

U moet eerst een snelle test uitvoeren om te zien of deze aanpak u zal helpen door simpelweg de WS_EX_COMPOSITED vensterstijl voor al uw vensterbesturingselementen. Als dat werkt, kunt u de meer geavanceerde aanpak hieronder bekijken:

Snelle 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;

Noem dit bijvoorbeeld in de OnShow Voor jouw TForm, het formulierexemplaar doorgeven. Als dat helpt, zou je het echt meer onderscheidend moeten implementeren. Ik geef je de relevante uittreksels uit mijn code om te laten zien hoe ik dat heb gedaan.

Volledige code

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;

Dit zal niet voor u worden gecompileerd, maar het zou enkele nuttige ideeën moeten bevatten. ControlEnumerator is mijn nut om een ​​recursieve loop van de bedieningselementen voor kinderen om te zetten in een flat for lus. Merk op dat ik ook een aangepaste splitter gebruik die StartSizing / EndSizing aanroept wanneer deze actief is.

Een andere handige truc is om te gebruiken TStaticText in plaats van TLabel die je af en toe moet doen als je een diep nestwerk van paginabedieningen en -panelen hebt.

Ik heb deze code gebruikt om mijn app 100% flikkervrij te maken, maar het kostte me eeuwen en jaren om te experimenteren om alles op zijn plaats te krijgen. Hopelijk kunnen anderen hier iets nuttigs vinden.


25
2017-11-09 05:18



Gebruik de VCL Fixpack van Andreas Hausladen.

Bovendien: geef niet op de SWP_NOCOPYBITS vlag en stel in DoubleBuffered van de 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;

10
2017-11-09 03:21



Deze oplossing gebruik ik met succes in mijn project in een aantal vormen. Het is een beetje vies omdat het Winapi-functies gebruikt. In vergelijking met David antwoord omvat het niet de prestatie straf. Het punt is om de berichthandler voor het bericht WM_ERASEBKGND te overschrijven voor formulier en alle onderliggende vensters.

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);
}

Belangrijke opmerking: de eigenschap DoubleBufferd voor formulier moet worden ingeschakeld als u geen zwarte strepen op zijden wilt zien!


1
2017-08-13 14:07



Zet boven uw formulier (interface) of plaats alles in een nieuwe eenheid die het volgende omvat:

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

Zet dit erin implementatie een deel

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

herhaal deze stap voor TGroupBox


0
2017-09-17 17:23