delphi - आकार बदलने पर TLabel और TGroupbox कैप्शन फ़्लिकर




delphi-xe flicker (3)

अपना फॉर्म ( इंटरफ़ेस ) ऊपर रखें या इसे सभी को एक नई अंतिम इकाई में शामिल करने के लिए रखें:

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 के लिए इस चरण को दोहराएं

  • तो, मेरे पास एक ऐसा एप्लिकेशन है जो विभिन्न प्लगइन लोड करता है और प्रत्येक के लिए एक TPageControl पर एक नया टैब बनाता है।
  • प्रत्येक डीएलएल में इसके साथ जुड़े एक TForm है।
  • फॉर्म अपने माता-पिता एचडब्ल्यूएनडी के साथ नई टीटीएबीशीट के रूप में बनाए जाते हैं।
  • चूंकि टीटीएबीशीट्स फॉर्म के माता-पिता नहीं हैं, जहां तक ​​वीसीएल का संबंध है ( गतिशील आरटीएल का उपयोग नहीं करना चाहता था, और अन्य भाषाओं में किए गए प्लगइन्स ) मुझे मैन्युअल रूप से आकार बदलना होगा। मैं इसे नीचे की तरह करता हूं:

    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 flicker के अंदर सभी TGroupBoxes और TLabels। TLroupbox जो TGroupboxes के अंदर नहीं हैं ठीक हैं और झिलमिलाहट नहीं करते हैं।

मैंने कोशिश की चीजें:

  • WM_SETREDRAW के बाद एक RedrawWindow
  • TGroupBoxes और TLabels पर अभिभावक बैकग्राउंड गलत पर सेट है
  • डबलबफर: = सही
  • LockWindowUpdate ( हाँ, भले ही मुझे पता है कि यह बहुत गलत है )
  • पारदर्शी: = झूठा ( कंट्रोलस्टेट को संपादित करने के लिए भी ओवरराइड करना )

कोई विचार?


एकमात्र चीज जो मैंने अच्छी तरह से काम करने के लिए WS_EX_COMPOSITED वह WS_EX_COMPOSITED विंडो शैली का उपयोग करना है। यह एक प्रदर्शन हॉग है इसलिए मैं इसे आकार देने के दौरान केवल इसे सक्षम करता हूं। यह मेरा अनुभव है कि, अंतर्निहित नियंत्रण के साथ, मेरे ऐप में, फ़्लिकरिंग केवल फ़ॉर्म का आकार बदलते समय होती है।

आपको सबसे पहले यह देखने के लिए एक त्वरित परीक्षण करना चाहिए कि यह दृष्टिकोण आपको अपने सभी विंडो वाले नियंत्रणों में 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 लिए OnShow , फॉर्म उदाहरण पास कर दें। यदि यह मदद करता है तो आपको वास्तव में इसे और अधिक समझदारी से लागू करना चाहिए। मैं आपको अपने कोड से प्रासंगिक निष्कर्ष बताता हूं कि मैंने यह कैसे किया।

पूरा कोड

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;

यह आपके लिए संकलित नहीं होगा, लेकिन इसमें कुछ उपयोगी विचार होना चाहिए। ControlEnumerator लूप के for एक फ्लैट में बाल नियंत्रण की एक पुनरावर्ती चलन को चालू करने के लिए मेरी उपयोगिता है। ध्यान दें कि मैं एक कस्टम स्प्लिटर का भी उपयोग करता हूं जो सक्रिय होने पर BeginSizing / EndSizing को कॉल करता है।

एक अन्य उपयोगी चाल TStaticText बजाय TStaticText का उपयोग TStaticText जिसे आपको कभी-कभी पृष्ठ नियंत्रण और पैनलों के गहरे घोंसले के दौरान करने की आवश्यकता होती है।

मैंने अपना ऐप 100% झिलमिलाहट मुक्त करने के लिए इस कोड का उपयोग किया है, लेकिन मुझे इसे सब कुछ पाने के लिए प्रयोग करने की उम्र और उम्र लग गई। उम्मीद है कि दूसरों को यहां कुछ उपयोग मिल सकता है।


एंड्रियास होउस्लाडेन से वीसीएल फिक्स पैक का प्रयोग करें।

इसके अतिरिक्त: SWP_NOCOPYBITS ध्वज निर्दिष्ट न करें, और DoubleBuffered के DoubleBuffered सेट करें:

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;






tpagecontrol