2011-11-08 15 views
20
  • Mam więc aplikację, która ładuje różne wtyczki i tworzy nową kartę TPageControl dla każdego z nich.
  • Każda biblioteka DLL ma skojarzony z nią format TForm.
  • Formularze są tworzone z rodzicem hWnd jako nowym arkuszem TTabSheet.
  • Ponieważ TTabSheets nie są rodzicem formularza w odniesieniu do VCL (nie chciał używać dynamicznego RTL, a wtyczki w innych językach) Muszę obsługiwać zmiany rozmiaru ręcznie. Robię to tak jak poniżej:Napisy TLabel i TGroupbox Miganie zmieniają rozmiar

    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; 
    

Teraz moim problemem jest to, że gdy aplikacja jest zmieniany, cały TGroupBoxes i TLabels wewnątrz migotania TGroupBoxes. TLabele, które nie są w TGroupbox, są w porządku i nie migoczą.

Czego próbowałem:

  • WM_SETREDRAW następnie RedrawWindow
  • ParentBackground na TGroupBoxes i TLabels ustawiona na false
  • DoubleBuffer: = True
  • LockWindowUpdate (Tak, mimo że wiem, że to bardzo nie tak)
  • Przezroczysty: = False (nawet nadrzędne tworzyć edytować controlState)

jakieś pomysły?

+0

To pytanie zawiera kilka dodatkowych pomysłów w odpowiedziach i komentarzach: http://stackoverflow.com/q uestions/4031147 – Argalatyr

Odpowiedz

25

Jedyne co znalazłem się działać dobrze jest używać stylu WS_EX_COMPOSITED okna. To jest świder wydajnościowy, więc włączam go tylko w pętli zmiany rozmiaru. Z mojego doświadczenia wynika, że ​​dzięki wbudowanym kontrolkom w mojej aplikacji migotanie występuje tylko podczas zmiany rozmiaru formularzy.

Najpierw należy wykonać szybki test, aby sprawdzić, czy to podejście pomoże, po prostu dodając styl okna WS_EX_COMPOSITED do wszystkich okienkowych elementów sterujących. Jeśli to działa można rozważyć bardziej zaawansowanego podejścia poniżej:

Szybki sposób

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; 

nazywają to, na przykład, w OnShow dla TForm, przekazując instancję formularza. Jeśli to pomaga, to naprawdę należy je wprowadzić w bardziej wymagający sposób. Daję ci odpowiednie fragmenty z mojego kodu, aby zilustrować, jak to zrobiłem.

Pełny kod

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; 

nie zostanie skompilowany dla ciebie, ale powinna ona zawierać kilka przydatnych pomysłów. ControlEnumerator jest moim narzędziem do przekształcenia ścieżki rekurencyjnej kontrolek podrzędnych w płaską pętlę for. Zauważ, że używam również niestandardowego splittera, który wywołuje BeginSizing/EndSizing, gdy jest aktywny.

Inną użyteczną sztuczką jest użycie TStaticText zamiast TLabel, które czasami trzeba wykonywać, gdy masz głębokie zagnieżdżanie kontrolek i paneli.

Użyłem tego kodu, aby moja aplikacja była w 100% wolna od migotania, ale zajęło mi wieki i eksperymenty, aby wszystko było w porządku. Mam nadzieję, że inni znajdą tutaj coś przydatnego.

+3

+1, TStaticText pozwala zaoszczędzić czas, korzystając z paneli i kontrolek strony zamiast TLabel. –

+0

O tak, z całą pewnością mogę znaleźć coś przydatnego tutaj :-) Dzięki i +1 –

+2

Bardzo dobra informacja i rozwiązał mój problem – ThievingSix

10

Użyj VCL Fix Pack z Andreas Hausladen.

Dodatkowo: nie określono flagę SWP_NOCOPYBITS i ustaw DoubleBuffered z 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; 
+1

Nie słyszałem o pakiecie poprawek VCL, spróbuję go. – ThievingSix

1

Jest to rozwiązanie, którego używam z powodzeniem w moim projekcie w różnych formach. Jest trochę brudny, ponieważ używa funkcji Winapi. W porównaniu do odpowiedzi Davida, nie zawiera kary za wykonanie. Chodzi o to, aby nadpisać komunikat obsługi wiadomości WM_ERASEBKGND dla formularza i wszystkich jego okien potomnych.

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

Ważna uwaga: nieruchomość DoubleBufferd na formularzu musi być ustawiona na jeśli nie chcesz, aby zobaczyć czarne pasy po bokach!

0

Put powyżej formularza (interfejsu) lub umieścić to wszystko w nowym ostatniej jednostki obejmuje:

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

umieścić to w realizacji część

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

Powtórz ten krok dla TGroupBox

Powiązane problemy