2011-11-08 9 views
20
  • Quindi, ho un'applicazione che carica diversi plugin e crea una nuova scheda su un TPageControl per ognuno.
  • Ad ogni DLL è associato un TForm.
  • I moduli vengono creati con il genitore hWnd come nuovo TTabSheet.
  • Poiché i TTabSheets non sono un genitore del modulo per quanto riguarda VCL (non si desidera utilizzare RTL dinamico e plug-in realizzati in altre lingue) Devo gestire le ridimensionamenti manualmente. Faccio questo come di seguito:Titolo TLabel e TGroupbox Flicker su ridimensionamento

    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; 
    

Ora, il mio problema è che quando l'applicazione viene ridimensionata, tutto il TGroupBoxes ei TLabels all'interno del tremolio TGroupBoxes. I TLabels che non si trovano all'interno di TGroupbox sono perfetti e non sfarfallano.

Le cose che ho provato:

  • WM_SETREDRAW seguito da un RedrawWindow
  • ParentBackground sulla TGroupBoxes e TLabels impostato su False
  • DoubleBuffer: = True
  • LockWindowUpdate (Sì, anche se so che è molto sbagliato)
  • Trasparente: = Falso (anche sovrascrivendo creare modificare ControlState)

Tutte le idee?

+0

Questa domanda ha alcune idee aggiuntive in risposta e commenti: http://stackoverflow.com/q uestions/4031147 – Argalatyr

risposta

25

L'unica cosa che ho trovato a lavorare bene è quello di utilizzare lo stile WS_EX_COMPOSITED finestra. Questo è un maiale performante quindi lo abilito solo in un ciclo di dimensionamento. È mia esperienza che, con i controlli integrati, nella mia app, il tremolio si verifica solo durante il ridimensionamento dei moduli.

Prima di iniziare, è necessario eseguire un test rapido per verificare se questo approccio può essere d'aiuto semplicemente aggiungendo lo stile di finestra WS_EX_COMPOSITED a tutti i controlli a finestra. Se funziona si può considerare l'approccio più avanzato di seguito: mod

rapida

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; 

chiamate questo, ad esempio, nel OnShow per il vostro TForm, passando l'istanza modulo. Se questo ti aiuta, dovresti davvero implementarlo in modo più acuto. Vi do gli estratti rilevanti dal mio codice per illustrare come l'ho fatto.

codice completa

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; 

Questo non verrà compilato per voi, ma dovrebbe contenere alcune idee utili. ControlEnumerator è la mia utilità per trasformare una sequenza ricorsiva dei controlli figlio in un loop piatto for. Nota che uso anche uno splitter personalizzato che chiama BeginSizing/EndSizing quando è attivo.

Un altro trucco utile è utilizzare TStaticText anziché TLabel che occasionalmente è necessario eseguire quando si dispone di nidificazione profonda di controlli e pannelli di pagina.

Ho usato questo codice per rendere la mia applicazione al 100% senza sfarfallio, ma mi ci sono voluti secoli e secoli di sperimentare per avere tutto a posto. Speriamo che gli altri possano trovare qualcosa di utile qui.

+3

+1, TStaticText salva la tua giornata quando usi pannelli e controlli di pagina invece di TLabel. –

+0

Oh sì, certamente riesco a trovare qualcosa di utile qui :-) Grazie e uno –

+2

Molto buona informazione e ha risolto il mio problema – ThievingSix

10

Utilizzare VCL Fix Pack da Andreas Hausladen.

Inoltre: non specificano la bandiera SWP_NOCOPYBITS, e impostare 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; 
+1

Non ho sentito parlare del VCL Fix Pack, lo proverò. – ThievingSix

1

Questa è la soluzione che uso con successo nel mio progetto in un certo numero di forme. È un po 'sporco perché usa le funzioni winapi. Rispetto alla risposta di David, non include la penalità delle prestazioni. Il punto è sovrascrivere il gestore di messaggi per il messaggio WM_ERASEBKGND per il modulo e tutte le sue finestre secondarie.

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: immobili DoubleBufferd per la forma deve essere impostato su se non volete vedere strisce nere ai lati!

0

Mettere sopra il modulo (interfaccia) o mettere tutto in una nuova ultima unità per includere:

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

mettere questo in implementazione parte

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

ripetere questo passaggio per TGroupBox

Problemi correlati