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

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

बातें मैं कोशिश की है:

  • WM_SETREDRAW झूठी
  • DoubleBuffer करने के लिए सेट एक RedrawWindow TGroupBoxes और TLabels पर
  • ParentBackground द्वारा पीछा किया: = सच
  • LockWindowUpdate (हाँ, भले ही मुझे पता है कि यह बहुत गलत है)
  • पारदर्शी: = झूठा (भी ControlState संपादित करने के लिए)

कोई भी विचार बनाने अधिभावी?

+0

इस प्रश्न में उत्तर और टिप्पणियों में कुछ अतिरिक्त विचार हैं: http://stackoverflow.com/q uestions/4031147 – Argalatyr

उत्तर

25

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

आपको यह देखने के लिए पहले एक त्वरित परीक्षण करना चाहिए कि यह दृष्टिकोण आपके सभी विंडो किए गए नियंत्रणों में WS_EX_COMPOSITED विंडो शैली को जोड़कर आपकी सहायता करेगा या नहीं। अपने TForm के लिए

त्वरित हैक

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

पूर्ण कोड

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 को कॉल करता है।

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

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

+3

+1, TStaticText TLabel के बजाय पैनल और पृष्ठ नियंत्रण का उपयोग करते समय अपना दिन बचाता है। –

+0

ओह हाँ, मैं निश्चित रूप से यहां कुछ उपयोगी पा सकता हूं :-) धन्यवाद और +1 –

+2

बहुत अच्छी जानकारी और मेरी समस्या हल हो गई है – ThievingSix

10

Andreas Hausladen से VCL Fix Pack का उपयोग करें।

इसके अतिरिक्त: SWP_NOCOPYBITS ध्वज निर्दिष्ट नहीं करते हैं, और PageControl की 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; 
+1

मैंने वीसीएल फिक्स पैक के बारे में नहीं सुना है, मैं इसे आज़माउंगा। – ThievingSix

1

यह समाधान है कि मैं अपने प्रोजेक्ट में कई रूपों में सफलता के साथ उपयोग करता हूं। यह थोड़ा गंदा है क्योंकि यह Winapi कार्यों का उपयोग करता है। डेविड उत्तर की तुलना में इसमें प्रदर्शन जुर्माना शामिल नहीं है। बिंदु फॉर्म और उसके सभी बच्चों की खिड़कियों के लिए WM_ERASEBKGND संदेश के लिए संदेश हैंडलर को ओवरराइट करना है।

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

महत्वपूर्ण नोट: फार्म के लिए DoubleBufferd संपत्ति पर सेट किया जाना चाहिए अगर तुम न पक्षों पर काली धारियों देखना चाहते हैं!

0

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

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

संबंधित मुद्दे