Napisy TLabel i TGroupbox migają przy zmianie rozmiaru
- więc mam aplikację, która ładuje różne wtyczki i tworzy Nowa karta na TPageControl dla każdego z nich.
- każda biblioteka DLL ma powiązany z nią formularz TForm.
- formularze są tworzone z ich rodzicem hWnd jako nowy arkusz TTabSheet.
-
Ponieważ arkusze TTabSheets nie są rodzicem formularza, jeśli chodzi o VCL ( nie chciałem używać dynamicznego RTL, a wtyczki wykonane w innych językach ) muszę obsługiwać zmiany rozmiaru ręcznie. Robię to jak poniżej:
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;
Mój problem polega na tym, że gdy aplikacja jest zmieniana, wszystkie pola Tgroupboxes i TLabels wewnątrz pól Tgroupboxes migają. Tlabele, których nie ma w Tgroupboxach, są w porządku i nie migotają.
Rzeczy, które próbowałem:
- WM_SETREDRAW po którym następuje przerysowanie
- ParentBackground na TGroupBoxes i TLabels ustawione na False
- DoubleBuffer : = True
- LockWindowUpdate ( tak, chociaż wiem to bardzo bardzo złe )
- Transparent : = False ( nawet przesłonięcie create do edycji ControlState )
Jakieś pomysły?
4 answers
Jedyną rzeczą, którą znalazłem, aby działać dobrze, jest użycie WS_EX_COMPOSITED
styl okna. Jest to świnia wydajności, więc włączam go tylko wtedy, gdy w pętli rozmiaru. Z mojego doświadczenia wynika, że dzięki wbudowanym kontrolkom w mojej aplikacji migotanie występuje tylko przy zmianie rozmiaru formularzy.
Powinieneś najpierw wykonać Szybki test, aby sprawdzić, czy takie podejście pomoże ci po prostu dodać styl okna WS_EX_COMPOSITED
do wszystkich kontrolek okiennych. Jeśli to zadziała, możesz rozważyć bardziej zaawansowane podejście poniżej:
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;
Wywołaj to na przykład w OnShow
dla twojego TForm
, przekazując instancję formularza. Jeśli to pomoże, to naprawdę powinniście wdrożyć to bardziej wnikliwie. Daję ci odpowiednie fragmenty 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;
To nie będzie skompilowane dla ciebie, ale powinno zawierać kilka przydatnych pomysłów. ControlEnumerator
to moje narzędzie do zamiany rekurencyjnego spaceru kontrolki dziecka w Mieszkanie for
pętla. Zauważ, że używam również niestandardowego splittera, który wywołuje BeginSizing / EndSizing, gdy jest aktywny.
Innym przydatnym trikiem jest użycie TStaticText
zamiast TLabel
, co czasami trzeba zrobić, gdy masz głębokie zagnieżdżanie kontrolek strony i paneli.
Użyłem tego kodu, aby moja aplikacja była w 100% wolna od migotania, ale zajęło mi wieki i wieki eksperymentowania, aby uzyskać to wszystko na miejscu. Mam nadzieję, że inni znajdą tu coś przydatnego.
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2013-01-29 09:09:10
Użyj VCL Fix Pack z Andreas Hausladen .
Dodatkowo: nie określaj znacznika SWP_NOCOPYBITS
i ustaw DoubleBuffered
Strony:
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;
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2011-11-09 05:19:27
Jest to rozwiązanie, które z powodzeniem stosuję w swoim projekcie w wielu formach. Jest trochę brudny, ponieważ używa funkcji winapi. W porównaniu z Davidem answer Nie zawiera kary za wydajność. Chodzi o to, aby nadpisać obsługę 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: właściwość DoubleBufferd dla formularza musi być włączona, jeśli nie chcesz widzieć czarnych pasków po bokach !
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2015-08-13 14:13:10
Umieść nad formularzem (interface ) lub umieść wszystko w nowej ostatniej jednostce, aby zawierać:
TLabel = class( stdCtrls.TLabel )
protected
procedure WMEraseBkgnd(var Message: TWmEraseBkgnd); message WM_ERASEBKGND;
end;
Wstaw to w implementacja Część
procedure TLabel.WMEraseBkgnd(var Message: TWmEraseBkgnd);
begin
Message.Result:=1; // Fake erase
end;
Powtórz ten krok dla TGroupBox
Warning: date(): Invalid date.timezone value 'Europe/Kyiv', we selected the timezone 'UTC' for now. in /var/www/agent_stack/data/www/doraprojects.net/template/agent.layouts/content.php on line 54
2015-09-17 17:23:16