Подписи TLabel и TGroupbox Flicker on Resize

  • Итак, у меня есть приложение, которое загружает разные плагины и создает новую вкладку в TPageControl для каждого из них.
  • Каждая DLL имеет связанный с ним TForm.
  • Формы создаются с их родительским hWnd как новый TTabSheet.
  • Поскольку TTabSheets не являются родителями формы в отношении VCL ( не хотят использовать динамическое RTL и плагины, созданные на других языках ), я должен обрабатывать изменения вручную. Я делаю это, как показано ниже:

    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; 

Теперь моя проблема заключается в том, что при изменении размера приложения все TGroupBoxes и TLabels внутри TGroupBoxes мерцают. TLabels, которые не находятся внутри TGroupboxes, прекрасны и не мерцают.

Вещи, которые я пробовал:

  • WM_SETREDRAW, за которым следует RedrawWindow
  • ParentBackground на TGroupBoxes и TLabels установлен в значение False
  • DoubleBuffer: = True
  • LockWindowUpdate ( Да, хотя я знаю, что это очень неправильно )
  • Transparent: = False ( даже переопределяющее создание для редактирования ControlState )

Есть идеи?

Единственное, что я нашел, чтобы работать хорошо, это использовать WS_EX_COMPOSITED windows WS_EX_COMPOSITED . Это свист производительности, поэтому я могу включить его только в цикле калибровки. По моему опыту, со встроенными элементами управления в моем приложении мерцание происходит только при изменении размеров форм.

Сначала вы должны выполнить быстрый тест, чтобы увидеть, поможет ли этот подход, просто добавив WS_EX_COMPOSITED windows WS_EX_COMPOSITED ко всем вашим оконным элементам управления. Если это работает, вы можете рассмотреть более продвинутый подход ниже:

Быстрый взлом

 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; 

Назовите это, например, в OnShow для вашего TForm , передав экземпляр формы. Если это поможет, вы действительно должны реализовать его более проницательно. Я даю вам соответствующие выдержки из моего кода, чтобы проиллюстрировать, как я это сделал.

Полный код

 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 , eg 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; 

Это не будет скомпилировано для вас, но оно должно содержать некоторые полезные идеи. ControlEnumerator – моя утилита, чтобы превратить рекурсивный ход дочерних элементов управления в плоскость for цикла. Обратите внимание, что я также использую собственный разделитель, который вызывает BeginSizing / EndSizing, когда он активен.

Еще один полезный трюк – использовать TStaticText вместо TLabel который вам иногда нужно делать, когда у вас есть глубокое вложение элементов управления и панелей страниц.

Я использовал этот код, чтобы сделать мое приложение на 100% мерцающим, но мне потребовались возраст и эксперименты, чтобы все было на месте. Надеюсь, другие могут найти здесь что-то полезное.

Используйте пакет VCL Fix Pack от Andreas Hausladen .

Дополнительно: не указывайте флаг SWP_NOCOPYBITS и установите DoubleBuffered of 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; 

Это решение, которое я использую с успехом в моем проекте в нескольких формах. Его немного грязно, потому что он использует функции winapi. По сравнению с ответом Дэвида, это не включает штраф за исполнение. Дело в том, чтобы перезаписать обработчик сообщений для сообщения WM_ERASEBKGND для формы и всех дочерних окон.

 typedef LRESULT CALLBACK(*PWndProc)(HWND, UINT, WPARAM, LPARAM); void SetNonFlickeringWndProc(TWinControl &control, std::map &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(child_control); if (child_wnd_control == NULL) { continue; } SetNonFlickeringWndProc(*child_wnd_control, list, new_proc); } } void RestoreWndProc(std::map &old_wnd_proc) { std::map::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 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); } 

Важное примечание: свойство DoubleBufferd для формы должно быть установлено, если вы не хотите видеть черные полосы по бокам!

Поместите над вашей формой ( интерфейсом ) или поместите все это в новый последний блок, чтобы включить:

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

Поместите это в часть реализации

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

повторите этот шаг для TGroupBox

Interesting Posts

Является ли IE 11 последним и доступен для Windows 8 Pro x64?

Сервер не может установить статус после отправки заголовков HTTP IIS7.5

Метод Java indexOf для нескольких совпадений в String

Почему в Windows 8 ускоряется время запуска?

R применяется с несколькими параметрами

Как использовать пространство имен для Twitter-бутстрапа, поэтому стили не конфликтуют

Установить значение для конкретной ячейки в pandas DataFrame с использованием индекса

Ошибка: Status {statusCode = DEVELOPER_ERROR, разрешение = null}

Кнопка bash home / end / delete добавляет тильду, или если ей предшествует escape-ключ, [1 ~ [3 ~

Как передать значения между действиями на Android?

Расширять примитивы без их прототипирования

Ошибка реализации Admob

Контекст веб-приложения / контекст корневого приложения и настройка менеджера транзакций

Использовать Jquery Selectors на загруженном HTML-файле? .AJAX?

Загрузка изображения iOS через AFNetworking 2.0

Давайте будем гением компьютера.